diff --git a/src/ecom/common/om_general_utils_c.c b/src/ecom/common/om_general_utils_c.c index 8628e4a64..ebd3f4901 100644 --- a/src/ecom/common/om_general_utils_c.c +++ b/src/ecom/common/om_general_utils_c.c @@ -6,17 +6,53 @@ #if __linux__ #include -void om_get_mem_usage(uint64_t* total_memory_of_system, uint64_t* system_usage, uint64_t* task_usage) { +typedef struct KeyBits { + + uint32_t sid: 1; + uint32_t paramId: 27; + uint32_t id: 26; + uint32_t levtype: 4; + uint32_t repres: 2; + uint32_t model: 2; + uint32_t precision: 2; + +} KeyBits_t; + +typedef union Key { + int64_t key; + KeyBits_t bits; +} Key_t; + +void to_field_hash( int32_t paramId, int32_t id, int32_t levtype, int32_t repres, int32_t model, int32_t precision, int64_t* hash) { + + Key_t k; + + k.bits.sid = id >= 0 ? 1 : 0; + k.bits.paramId = (uint32_t)paramId; + k.bits.id = id >= 0 ? id : -id; + k.bits.levtype = (uint32_t)levtype; + k.bits.repres = (uint32_t)repres; + k.bits.model = (uint32_t)model; + k.bits.precision = (uint32_t)precision; + + *hash = k.key; + + return; + +}; + + +void om_get_mem_usage( int64_t* total_memory_of_system, int64_t* system_usage, int64_t* task_usage) { // Retrieve total memory of the system struct sysinfo info; sysinfo(&info); - *total_memory_of_system = (uint64_t)info.totalram * info.mem_unit; + *total_memory_of_system = (int64_t)info.totalram * info.mem_unit; // Retrieve memory usage of the current process struct rusage usage; if (getrusage(RUSAGE_SELF, &usage) == 0) { - *system_usage = *total_memory_of_system - (uint64_t)info.freeram * info.mem_unit; - *task_usage = (uint64_t)usage.ru_maxrss * 1024; // Convert to bytes + *system_usage = *total_memory_of_system - (int64_t)info.freeram * info.mem_unit; + *task_usage = (int64_t)usage.ru_maxrss * 1024; // Convert to bytes } else { // Error handling diff --git a/src/ecom/common/om_general_utils_mod.F90 b/src/ecom/common/om_general_utils_mod.F90 index 31d3e1a49..8448b419c 100644 --- a/src/ecom/common/om_general_utils_mod.F90 +++ b/src/ecom/common/om_general_utils_mod.F90 @@ -37,9 +37,141 @@ MODULE OM_GENERAL_UTILS_MOD PUBLIC :: OM_READ_YAML_FROM_ENV PUBLIC :: OM_IS_LITTLE_ENDIAN PUBLIC :: OM_FINDLOC +PUBLIC :: OM_FIELD_HASH CONTAINS +!> +!> @brief Compute a unique hash for a field. +!> +!> This function computes a unique hash for a field based on the field's ID, level type, representation. +!> +!> @attention the folder is "../" because by default each instance of the output manager run in +!> the folder calles io_serv..d +!> +!> @param [out] OMYAML Name of the main YAML configuraiton file +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'OM_FIELD_HASH' +FUNCTION OM_FIELD_HASH( PARAM_ID, ID, LEVTYPE, REPRES, MODEL, PRECISION ) RESULT(HASH) + + ! Symbols imported from intrinsic modules + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT32_T + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT64_T + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + INTEGER(KIND=JPIB_K), INTENT(IN) :: PARAM_ID + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVTYPE + INTEGER(KIND=JPIB_K), INTENT(IN) :: REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: MODEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: PRECISION + + ! Function Result + INTEGER(KIND=JPIB_K) :: HASH + + ! Local variables + INTEGER(KIND=C_INT32_T) :: C_PARAM_ID + INTEGER(KIND=C_INT32_T) :: C_ID + INTEGER(KIND=C_INT32_T) :: C_LEVTYPE + INTEGER(KIND=C_INT32_T) :: C_REPRES + INTEGER(KIND=C_INT32_T) :: C_MODEL + INTEGER(KIND=C_INT32_T) :: C_PRECISION + INTEGER(KIND=C_INT64_T) :: C_HASH + + ! Explicit interfaces + INTERFACE + SUBROUTINE C_TO_FIELD_HASH( C_PARAM_ID, C_ID, C_LEVTYPE, C_REPRES, C_MODEL, C_PRECISION, C_HASH ) BIND(C, NAME="to_field_hash") + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT32_T + USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT64_T + IMPLICIT NONE + INTEGER(KIND=C_INT32_T), VALUE, INTENT(IN) :: C_PARAM_ID + INTEGER(KIND=C_INT32_T), VALUE, INTENT(IN) :: C_ID + INTEGER(KIND=C_INT32_T), VALUE, INTENT(IN) :: C_LEVTYPE + INTEGER(KIND=C_INT32_T), VALUE, INTENT(IN) :: C_REPRES + INTEGER(KIND=C_INT32_T), VALUE, INTENT(IN) :: C_MODEL + INTEGER(KIND=C_INT32_T), VALUE, INTENT(IN) :: C_PRECISION + INTEGER(KIND=C_INT64_T), INTENT(OUT) :: C_HASH + END SUBROUTINE C_TO_FIELD_HASH + END INTERFACE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + C_PARAM_ID = INT(PARAM_ID,KIND=C_INT32_T) + C_ID = INT(ID,KIND=C_INT32_T) + C_LEVTYPE = INT(LEVTYPE,KIND=C_INT32_T) + C_REPRES = INT(REPRES,KIND=C_INT32_T) + C_MODEL = INT(MODEL,KIND=C_INT32_T) + C_PRECISION = INT(PRECISION,KIND=C_INT32_T) + + ! Call the C function + CALL C_TO_FIELD_HASH( C_PARAM_ID, C_ID, C_LEVTYPE, C_REPRES, C_MODEL, C_PRECISION, C_HASH ) + + ! Cast to fortran datatype + HASH = INT( C_HASH, KIND=JPIB_K ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + + ! HAndle different errors + SELECT CASE(ERRIDX) + + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'OUTPUT_MANAGER_YAML env. var. too long' ) + + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'OUTPUT_MANAGER_YAML unable to find the file' ) + + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END FUNCTION OM_FIELD_HASH +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + !> !> @brief Retrieves the output manager type from the 'OUTPUT_MANAGER_YAML' environment variable. !> diff --git a/src/ecom/config_example/output-manager-config.yaml b/src/ecom/config_example/output-manager-config.yaml index 1dbce0db3..8a68625dd 100644 --- a/src/ecom/config_example/output-manager-config.yaml +++ b/src/ecom/config_example/output-manager-config.yaml @@ -43,14 +43,150 @@ encoding-rules: rules: - rule: 'grib1_surfaces_gridded' - filter: + + filter: # mandatory levtype: ['sfc'] - repres: ['gridded'] + repres: ['gridded'] paramId: [ 31, 34, 49, 78, 134, 136, 137, 142, 144, 151, 165, 166, 168, 169, 175, 176, 177, 178, 179, 180, 181, 205, 228, 228029, 228216, 228218, 228219 ] - encode: - gribEdition: 1 - packingType: 'grid_simple' + tag: 'GRIB1' # optional + + mapping-rules: # optional + - recipe: + from: + paramId: 31 + level: 0 + levtype: 'sfc' + to: + paramId: 160350 + level: 4 + levtype: 'sfc' + values-scale-factor: 0.01 + + # grib-structure: # optional + # local-definition-template-number: 2 + # grid-definition-template-number: 2 + # product-definition-template-number: 2 + # data-definition-template-number: 2 + # + # + # + edition: # mandatory + use-paramId-ecmf: false + grib-edition: 1 + + packing: # optional + packing-type: 'grid_simple' + + +encoding-rules: + + default-rules: + -rule: 'default-rule-that-should-work-almost-always' + ... + + special-rules: + - rule: 'grib1_surfaces_gridded' + + # Select messages + - type: filter + match: + levtype: ['sfc'] + repres: ['gridded'] + paramId: [ 31, 34, 49, 78, 134, 136, 137, 142, 144, 151, 165, 166, 168, 169, 175, 176, 177, 178, 179, 180, 181, 205, 228, 228029, 228216, 228218, 228219 ] + + # This can be used to convert prefix to levtype + - type: mapping + recipes: + - recipe: + from: + paramId: 31 + level: 0 + levtype: 'sfc' + to: + paramId: 160350 + level: 4 + levtype: 'sfc' + values-scale-factor: 0.01 + + # Sample to be loaded fro this rule (should be shared between the rules) + - type: load-sample + sample-path: <> + sample-name: <> + options: + strip-values: true + strip-bitmask: true + strip-section2: true + strip-section3: true + + # Everything that can be done once should be done once and then cached. + # First time a message with a specific hash arrive for the first time (not in the map), + # The sample is loaded and preset and then added to the map. + - type: lazy-preset + presets: + + - type: local-definition-section + template-number: [2, ] + options: + bla: + + - type: grid-definition-section + template-number: [40, ] + options: + bla: ... + + - type: product-definition-section + template-number: [ 1, ] + options: + bla: ... + + - type: data-definition-section + template-number: [ 2, ] + options: + bla: ... + + # When a fully preset template is in the map, the only euntime change are the values and the time configuration. + # Values may need a scaling due to the mapping (i.e. change units) + - type: runtime-configurations + runtime-cfg: + - type: time-configuration + options: + bla: ... + + - type: values-configuration + options: + bla: ... + + + - type: sink + sinks: + - type: grib-msg-to-file + options: + bla: ... + + - type: grib-msg-to-multio + option: + bla: ... + + - type: grib-msg-to-multio + option: + bla: ... + + + # grib-structure: # optional + # local-definition-template-number: 2 + # grid-definition-template-number: 2 + # product-definition-template-number: 2 + # data-definition-template-number: 2 + # + # + # + edition: # mandatory + use-paramId-ecmf: false + grib-edition: 1 + + packing: # optional + packing-type: 'grid_simple' - rule: 'grib1_height_level_gridded' diff --git a/src/ecom/containers/circular_buffer_mod.F90 b/src/ecom/containers/circular_buffer_mod.F90 index 36d18adae..413135e4a 100644 --- a/src/ecom/containers/circular_buffer_mod.F90 +++ b/src/ecom/containers/circular_buffer_mod.F90 @@ -61,7 +61,7 @@ MODULE CIRCULAR_BUFFER_MOD !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'CB_INIT' -SUBROUTINE CB_INIT(THIS, CAPACITY) +__THREAD_SAFE__ SUBROUTINE CB_INIT(THIS, CAPACITY) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -110,7 +110,7 @@ END SUBROUTINE CB_INIT !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'CB_FREE' -SUBROUTINE CB_FREE( THIS ) +__THREAD_SAFE__ SUBROUTINE CB_FREE( THIS ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -156,7 +156,7 @@ END SUBROUTINE CB_FREE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'CB_ENQUEUE' -SUBROUTINE CB_ENQUEUE(THIS, VALUE) +__THREAD_SAFE__ SUBROUTINE CB_ENQUEUE(THIS, VALUE) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -216,7 +216,7 @@ END SUBROUTINE CB_ENQUEUE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CB_DEQUEUE' -FUNCTION CB_DEQUEUE(THIS, VALUE) RESULT(EX) +__THREAD_SAFE__ FUNCTION CB_DEQUEUE(THIS, VALUE) RESULT(EX) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -280,7 +280,7 @@ END FUNCTION CB_DEQUEUE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CB_GET' -FUNCTION CB_GET(THIS, I, VALUE) RESULT(EX) +__THREAD_SAFE__ FUNCTION CB_GET(THIS, I, VALUE) RESULT(EX) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -335,7 +335,7 @@ END FUNCTION CB_GET !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CB_GET_VALUES' -FUNCTION CB_GET_ALL(THIS, SZ, VALUES) RESULT(EX) +__THREAD_SAFE__ FUNCTION CB_GET_ALL(THIS, SZ, VALUES) RESULT(EX) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -392,7 +392,7 @@ END FUNCTION CB_GET_ALL !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CB_SIZE' -FUNCTION CB_SIZE(THIS) RESULT(SIZE) +__THREAD_SAFE__ FUNCTION CB_SIZE(THIS) RESULT(SIZE) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -436,7 +436,7 @@ END FUNCTION CB_SIZE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CB_IS_EMPTY' -FUNCTION CB_IS_EMPTY(THIS) RESULT(IS_EMPTY) +__THREAD_SAFE__ FUNCTION CB_IS_EMPTY(THIS) RESULT(IS_EMPTY) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS diff --git a/src/ecom/containers/map_mod.F90 b/src/ecom/containers/map_mod.F90 index f0fe6e431..4aab5bf0b 100644 --- a/src/ecom/containers/map_mod.F90 +++ b/src/ecom/containers/map_mod.F90 @@ -19,6 +19,7 @@ #include "output_manager_preprocessor_logging_utils.h" #include "output_manager_preprocessor_errhdl_utils.h" +#define __THREAD_SAFE__ RECURSIVE ! Definition of the module #define PP_FILE_NAME 'map_mod.F90' @@ -34,6 +35,14 @@ MODULE MAP_MOD !> @brief Default visibility of the module PRIVATE +INTERFACE + SUBROUTINE VALUE_DESTRUCTOR_IF( VALUE ) + IMPLICIT NONE + CLASS(*), POINTER, INTENT(INOUT) :: VALUE + END SUBROUTINE VALUE_DESTRUCTOR_IF +END INTERFACE + + !> @brief Flag used to enable the tree balancing LOGICAL, PARAMETER :: RED_BLACK_BALANCING=.TRUE. @@ -85,6 +94,9 @@ MODULE MAP_MOD !> Payload CLASS(*), POINTER :: VALUE => NULL() + !> Destructor for the payload + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER, NOPASS :: VALUE_DESTRUCTOR => NULL() + !> Color LOGICAL :: RED = .FALSE. @@ -125,6 +137,7 @@ MODULE MAP_MOD PUBLIC :: MAP_MINIMUM PUBLIC :: MAP_MAXIMUM PUBLIC :: MAP_GET_SORTED_KEYS_INT +PUBLIC :: VALUE_DESTRUCTOR_IF CONTAINS @@ -141,7 +154,7 @@ MODULE MAP_MOD !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_EQ' -FUNCTION KEY_EQ( KEY_A, KEY_B ) RESULT( RES ) +__THREAD_SAFE__ FUNCTION KEY_EQ( KEY_A, KEY_B ) RESULT( RES ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -186,7 +199,7 @@ END FUNCTION KEY_EQ !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_NE' -FUNCTION KEY_NE( KEY_A, KEY_B ) RESULT( RES ) +__THREAD_SAFE__ FUNCTION KEY_NE( KEY_A, KEY_B ) RESULT( RES ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -231,7 +244,7 @@ END FUNCTION KEY_NE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_LT' -FUNCTION KEY_LT( KEY_A, KEY_B ) RESULT( RES ) +__THREAD_SAFE__ FUNCTION KEY_LT( KEY_A, KEY_B ) RESULT( RES ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -276,7 +289,7 @@ END FUNCTION KEY_LT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_GT' -FUNCTION KEY_GT( KEY_A, KEY_B ) RESULT( RES ) +__THREAD_SAFE__ FUNCTION KEY_GT( KEY_A, KEY_B ) RESULT( RES ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -321,7 +334,7 @@ END FUNCTION KEY_GT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_LE' -FUNCTION KEY_LE( KEY_A, KEY_B ) RESULT( RES ) +__THREAD_SAFE__ FUNCTION KEY_LE( KEY_A, KEY_B ) RESULT( RES ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -366,7 +379,7 @@ END FUNCTION KEY_LE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_GE' -FUNCTION KEY_GE( KEY_A, KEY_B ) RESULT( RES ) +__THREAD_SAFE__ FUNCTION KEY_GE( KEY_A, KEY_B ) RESULT( RES ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -411,7 +424,7 @@ END FUNCTION KEY_GE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'KEY_FREE' -SUBROUTINE KEY_FREE( KEY, ERR ) +__THREAD_SAFE__ SUBROUTINE KEY_FREE( KEY, ERR ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -457,7 +470,7 @@ END SUBROUTINE KEY_FREE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME '' -SUBROUTINE KEY_COPY( KEY1, KEY2, ERR ) +__THREAD_SAFE__ SUBROUTINE KEY_COPY( KEY1, KEY2, ERR ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -512,7 +525,7 @@ END SUBROUTINE KEY_COPY !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAP_INSERT_NODE' -FUNCTION MAP_INSERT_NODE( ROOT, KEY, VALUE, FORCE ) RESULT(EX) +__THREAD_SAFE__ FUNCTION MAP_INSERT_NODE( ROOT, KEY, VALUE, VALUE_DESTRUCTOR, FORCE ) RESULT(EX) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -523,10 +536,11 @@ FUNCTION MAP_INSERT_NODE( ROOT, KEY, VALUE, FORCE ) RESULT(EX) IMPLICIT NONE ! Dummy arguments - TYPE(MAP_NODE_T), POINTER, INTENT(INOUT) :: ROOT - TYPE(KEY_T), INTENT(IN) :: KEY - CLASS(*), POINTER, INTENT(IN) :: VALUE - LOGICAL, OPTIONAL, INTENT(IN) :: FORCE + TYPE(MAP_NODE_T), POINTER, INTENT(INOUT) :: ROOT + TYPE(KEY_T), INTENT(IN) :: KEY + CLASS(*), POINTER, INTENT(IN) :: VALUE + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER, OPTIONAL, INTENT(IN) :: VALUE_DESTRUCTOR + LOGICAL, OPTIONAL, INTENT(IN) :: FORCE ! Function result LOGICAL :: EX @@ -536,6 +550,7 @@ FUNCTION MAP_INSERT_NODE( ROOT, KEY, VALUE, FORCE ) RESULT(EX) TYPE(MAP_NODE_T), POINTER :: INSERTION_POINT INTEGER(KIND=JPIB_K) :: FOUND INTEGER(KIND=JPIB_K) :: ERR + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER :: LOC_VALUE_DESTRUCTOR ! Local variables declared by the preprocessor for tracing purposes PP_TRACE_DECL_VARS @@ -549,13 +564,20 @@ FUNCTION MAP_INSERT_NODE( ROOT, KEY, VALUE, FORCE ) RESULT(EX) LOC_FORCE = .FALSE. ENDIF + ! Handle value destructor + IF ( PRESENT(VALUE_DESTRUCTOR) ) THEN + LOC_VALUE_DESTRUCTOR => VALUE_DESTRUCTOR + ELSE + LOC_VALUE_DESTRUCTOR => DEFAULT_VALUE_DESTRUCTOR + ENDIF + ! Map is empty IF ( ASSOCIATED( ROOT, NIL ) ) THEN EX = .TRUE. CALL ALLOCATE_NODE( ROOT ) INSERTION_POINT => NIL - CALL MAP_NODE_INIT( ROOT, INSERTION_POINT, KEY, VALUE ) + CALL MAP_NODE_INIT( ROOT, INSERTION_POINT, KEY, VALUE, LOC_VALUE_DESTRUCTOR ) CALL INSERT_FIXUP( ROOT, ROOT ) INSERTION_POINT => ROOT @@ -567,11 +589,11 @@ FUNCTION MAP_INSERT_NODE( ROOT, KEY, VALUE, FORCE ) RESULT(EX) EX = .TRUE. IF ( KEY .LT. INSERTION_POINT%KEY ) THEN CALL ALLOCATE_NODE( INSERTION_POINT%LEFT ) - CALL MAP_NODE_INIT( INSERTION_POINT%LEFT, INSERTION_POINT, KEY, VALUE ) + CALL MAP_NODE_INIT( INSERTION_POINT%LEFT, INSERTION_POINT, KEY, VALUE, LOC_VALUE_DESTRUCTOR ) CALL INSERT_FIXUP( ROOT, INSERTION_POINT%LEFT ) ELSE CALL ALLOCATE_NODE( INSERTION_POINT%RIGHT ) - CALL MAP_NODE_INIT( INSERTION_POINT%RIGHT, INSERTION_POINT, KEY, VALUE ) + CALL MAP_NODE_INIT( INSERTION_POINT%RIGHT, INSERTION_POINT, KEY, VALUE, LOC_VALUE_DESTRUCTOR ) CALL INSERT_FIXUP( ROOT, INSERTION_POINT%RIGHT ) ENDIF ELSE @@ -596,6 +618,16 @@ END FUNCTION MAP_INSERT_NODE #undef PP_PROCEDURE_TYPE +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'DEFAULT_VALUE_DESTRUCTOR' +__THREAD_SAFE__ SUBROUTINE DEFAULT_VALUE_DESTRUCTOR( VALUE ) +IMPLICIT NONE + CLASS(*), POINTER, INTENT(INOUT) :: VALUE + ! Nothing to do +END SUBROUTINE DEFAULT_VALUE_DESTRUCTOR +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + !> !> @brief Removes a key-value pair from a map. !> @@ -614,7 +646,7 @@ END FUNCTION MAP_INSERT_NODE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_REMOVE_NODE' -SUBROUTINE MAP_REMOVE_NODE( ROOT, KEY ) +__THREAD_SAFE__ SUBROUTINE MAP_REMOVE_NODE( ROOT, KEY ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -746,7 +778,7 @@ END SUBROUTINE MAP_FREE_NODE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'SEARCH' -SUBROUTINE SEARCH( ROOT, CURRENT, KEY, ERR ) +__THREAD_SAFE__ SUBROUTINE SEARCH( ROOT, CURRENT, KEY, ERR ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -852,7 +884,7 @@ END SUBROUTINE SEARCH !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_NODE_INIT' -SUBROUTINE MAP_NODE_INIT( THIS, PARENT, KEY, VALUE ) +__THREAD_SAFE__ SUBROUTINE MAP_NODE_INIT( THIS, PARENT, KEY, VALUE, VALUE_DESTRUCTOR ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -860,10 +892,11 @@ SUBROUTINE MAP_NODE_INIT( THIS, PARENT, KEY, VALUE ) IMPLICIT NONE ! Dummy arguments - TYPE(MAP_NODE_T), INTENT(INOUT) :: THIS - TYPE(MAP_NODE_T), POINTER, INTENT(IN) :: PARENT - TYPE(KEY_T), INTENT(IN) :: KEY - CLASS(*), POINTER, INTENT(IN) :: VALUE + TYPE(MAP_NODE_T), INTENT(INOUT) :: THIS + TYPE(MAP_NODE_T), POINTER, INTENT(IN) :: PARENT + TYPE(KEY_T), INTENT(IN) :: KEY + CLASS(*), POINTER, INTENT(IN) :: VALUE + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER, INTENT(IN) :: VALUE_DESTRUCTOR ! Local variables declared by the preprocessor for tracing purposes PP_TRACE_DECL_VARS @@ -881,6 +914,7 @@ SUBROUTINE MAP_NODE_INIT( THIS, PARENT, KEY, VALUE ) THIS%RED = .TRUE. THIS%KEY%K = KEY%K THIS%VALUE => VALUE + THIS%VALUE_DESTRUCTOR => VALUE_DESTRUCTOR THIS%IDX = -99 ! Trace end of procedure (on success) @@ -906,7 +940,7 @@ END SUBROUTINE MAP_NODE_INIT !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'ALLOCATE_NODE' -SUBROUTINE ALLOCATE_NODE( CURRENT ) +__THREAD_SAFE__ SUBROUTINE ALLOCATE_NODE( CURRENT ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -964,7 +998,7 @@ END SUBROUTINE ALLOCATE_NODE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'DEALLOCATE_NODE' -SUBROUTINE DEALLOCATE_NODE( X, ERR ) +__THREAD_SAFE__ SUBROUTINE DEALLOCATE_NODE( X, ERR ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -991,8 +1025,13 @@ SUBROUTINE DEALLOCATE_NODE( X, ERR ) ! Check node is associated IF ( ASSOCIATED( X ) ) THEN - ! Free data. + ! Free key CALL KEY_FREE( X%KEY, ERR ) + + ! Free values + IF ( ASSOCIATED(X%VALUE_DESTRUCTOR) ) THEN + CALL X%VALUE_DESTRUCTOR( X%VALUE ) + ENDIF NULLIFY( X%VALUE ) ! Free node memory. @@ -1027,7 +1066,7 @@ END SUBROUTINE DEALLOCATE_NODE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'INSERT_FIXUP' -SUBROUTINE INSERT_FIXUP( ROOT, CUR ) +__THREAD_SAFE__ SUBROUTINE INSERT_FIXUP( ROOT, CUR ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -1153,7 +1192,7 @@ END SUBROUTINE INSERT_FIXUP !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'ROTATE_LEFT' -SUBROUTINE ROTATE_LEFT(ROOT, X_) +__THREAD_SAFE__ SUBROUTINE ROTATE_LEFT(ROOT, X_) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -1236,7 +1275,7 @@ END SUBROUTINE ROTATE_LEFT !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'ROTATE_RIGHT' -SUBROUTINE ROTATE_RIGHT(ROOT, X_) +__THREAD_SAFE__ SUBROUTINE ROTATE_RIGHT(ROOT, X_) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -1316,7 +1355,7 @@ END SUBROUTINE ROTATE_RIGHT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ISLEAF' -FUNCTION ISLEAF(X) RESULT(B) +__THREAD_SAFE__ FUNCTION ISLEAF(X) RESULT(B) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -1365,7 +1404,7 @@ END FUNCTION ISLEAF !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SUCCESSOR' -FUNCTION SUCCESSOR( X, ERR ) RESULT( Y ) +__THREAD_SAFE__ FUNCTION SUCCESSOR( X, ERR ) RESULT( Y ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -1462,7 +1501,7 @@ END FUNCTION SUCCESSOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'PREDECESSOR' -FUNCTION PREDECESSOR( X, ERR ) RESULT(Y) +__THREAD_SAFE__ FUNCTION PREDECESSOR( X, ERR ) RESULT(Y) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -1560,7 +1599,7 @@ END FUNCTION PREDECESSOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MINIMUM' -FUNCTION MINIMUM( X ) RESULT( Y ) +__THREAD_SAFE__ FUNCTION MINIMUM( X ) RESULT( Y ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -1623,7 +1662,7 @@ END FUNCTION MINIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAXIMUM' -FUNCTION MAXIMUM( X ) RESULT( Y ) +__THREAD_SAFE__ FUNCTION MAXIMUM( X ) RESULT( Y ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -1685,7 +1724,7 @@ END FUNCTION MAXIMUM !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'SWAP_DATA' -SUBROUTINE SWAP_DATA( NODE_1, NODE_2 ) +__THREAD_SAFE__ SUBROUTINE SWAP_DATA( NODE_1, NODE_2 ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -1762,7 +1801,7 @@ END SUBROUTINE SWAP_DATA !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'REMOVE_NODE' -SUBROUTINE REMOVE_NODE( ROOT, Z, ERR ) +__THREAD_SAFE__ SUBROUTINE REMOVE_NODE( ROOT, Z, ERR ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -1900,7 +1939,7 @@ END SUBROUTINE REMOVE_NODE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'REMOVE_NODE_FIXUP' -SUBROUTINE REMOVE_NODE_FIXUP( ROOT, X, ERR ) +__THREAD_SAFE__ SUBROUTINE REMOVE_NODE_FIXUP( ROOT, X, ERR ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2295,7 +2334,7 @@ END SUBROUTINE MAP_WRITE_NODE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_INIT' -SUBROUTINE MAP_INIT( MAP ) +__THREAD_SAFE__ SUBROUTINE MAP_INIT( MAP ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -2342,7 +2381,7 @@ END SUBROUTINE MAP_INIT !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_FREE' -SUBROUTINE MAP_FREE( MAP ) +__THREAD_SAFE__ SUBROUTINE MAP_FREE( MAP ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2399,7 +2438,7 @@ END SUBROUTINE MAP_FREE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_MINIMUM' -SUBROUTINE MAP_MINIMUM( MAP, KEY, VALUE ) +__THREAD_SAFE__ SUBROUTINE MAP_MINIMUM( MAP, KEY, VALUE ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2459,7 +2498,7 @@ END SUBROUTINE MAP_MINIMUM !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_MAXIMUM' -SUBROUTINE MAP_MAXIMUM( MAP, KEY, VALUE ) +__THREAD_SAFE__ SUBROUTINE MAP_MAXIMUM( MAP, KEY, VALUE ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2576,7 +2615,7 @@ END SUBROUTINE MAP_GET_SORTED_KEYS_INT_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAP_GET_SORTED_KEYS_INT' -FUNCTION MAP_GET_SORTED_KEYS_INT( MAP, SORTED_KEYS_INT ) RESULT(EX) +__THREAD_SAFE__ FUNCTION MAP_GET_SORTED_KEYS_INT( MAP, SORTED_KEYS_INT ) RESULT(EX) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2649,7 +2688,7 @@ END FUNCTION MAP_GET_SORTED_KEYS_INT !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_INSERT' -SUBROUTINE MAP_INSERT( THIS, KEY, VALUE, FORCE ) +__THREAD_SAFE__ SUBROUTINE MAP_INSERT( THIS, KEY, VALUE, VALUE_DESTRUCTOR, FORCE ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -2657,10 +2696,11 @@ SUBROUTINE MAP_INSERT( THIS, KEY, VALUE, FORCE ) IMPLICIT NONE ! Dummy arguments - TYPE(MAP_T), INTENT(INOUT) :: THIS - TYPE(KEY_T), INTENT(IN) :: KEY - CLASS(*), POINTER, INTENT(IN) :: VALUE - LOGICAL, OPTIONAL, INTENT(IN) :: FORCE + TYPE(MAP_T), INTENT(INOUT) :: THIS + TYPE(KEY_T), INTENT(IN) :: KEY + CLASS(*), POINTER, INTENT(IN) :: VALUE + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER, OPTIONAL, INTENT(IN) :: VALUE_DESTRUCTOR + LOGICAL, OPTIONAL, INTENT(IN) :: FORCE ! Local variables LOGICAL :: EX @@ -2672,9 +2712,17 @@ SUBROUTINE MAP_INSERT( THIS, KEY, VALUE, FORCE ) PP_TRACE_ENTER_PROCEDURE() IF ( PRESENT(FORCE) ) THEN - EX = MAP_INSERT_NODE( THIS%ROOT, KEY, VALUE, FORCE ) + IF ( PRESENT(VALUE_DESTRUCTOR) ) THEN + EX = MAP_INSERT_NODE( THIS%ROOT, KEY, VALUE, VALUE_DESTRUCTOR=VALUE_DESTRUCTOR, FORCE=FORCE ) + ELSE + EX = MAP_INSERT_NODE( THIS%ROOT, KEY, VALUE, FORCE=FORCE ) + ENDIF ELSE - EX = MAP_INSERT_NODE( THIS%ROOT, KEY, VALUE ) + IF ( PRESENT(VALUE_DESTRUCTOR) ) THEN + EX = MAP_INSERT_NODE( THIS%ROOT, KEY, VALUE, VALUE_DESTRUCTOR=VALUE_DESTRUCTOR ) + ELSE + EX = MAP_INSERT_NODE( THIS%ROOT, KEY, VALUE ) + ENDIF ENDIF ! Update the number of elements in the map @@ -2707,7 +2755,7 @@ END SUBROUTINE MAP_INSERT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAP_GET' -FUNCTION MAP_GET( THIS, KEY, VALUE ) RESULT(EX) +__THREAD_SAFE__ FUNCTION MAP_GET( THIS, KEY, VALUE ) RESULT(EX) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2777,7 +2825,7 @@ END FUNCTION MAP_GET !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_REMOVE' -SUBROUTINE MAP_REMOVE( THIS, KEY ) +__THREAD_SAFE__ SUBROUTINE MAP_REMOVE( THIS, KEY ) ! Symbols imported by the preprocessor for tracing purposes PP_TRACE_USE_VARS @@ -2820,7 +2868,7 @@ END SUBROUTINE MAP_REMOVE !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_LIST' -SUBROUTINE MAP_LIST( THIS, UNIT ) +__THREAD_SAFE__ SUBROUTINE MAP_LIST( THIS, UNIT ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K @@ -2867,7 +2915,7 @@ END SUBROUTINE MAP_LIST !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'MAP_PRINT' -SUBROUTINE MAP_PRINT( THIS, NAME, IDX ) +__THREAD_SAFE__ SUBROUTINE MAP_PRINT( THIS, NAME, IDX ) ! Symbols imported from other modules within the project. USE :: OM_CORE_MOD, ONLY: JPIB_K diff --git a/src/ecom/flavours/gribx2multio_raw_output_manager_mod.F90 b/src/ecom/flavours/gribx2multio_raw_output_manager_mod.F90 index f8caae451..8054d0967 100644 --- a/src/ecom/flavours/gribx2multio_raw_output_manager_mod.F90 +++ b/src/ecom/flavours/gribx2multio_raw_output_manager_mod.F90 @@ -26,6 +26,8 @@ MODULE GRIBX2MULTIO_RAW_MOD USE :: GRIB_METADATA_MOD, ONLY: GRIB_METADATA_T USE :: MULTIO_METADATA_MOD, ONLY: MULTIO_METADATA_T USE :: OM_PROFILE_MOD, ONLY: PROFILE_T + USE :: MAP_MOD, ONLY: MAP_T + USE :: GRIB_ENCODER_MANAGER_MOD, ONLY: GRIB_ENCODER_CONTAINER_T ! Symbols imported from other libraries USE :: FCKIT_CONFIGURATION_MODULE, ONLY: FCKIT_CONFIGURATION @@ -90,6 +92,11 @@ MODULE GRIBX2MULTIO_RAW_MOD !> Multio Handle used to interact with multio TYPE(MULTIO_HANDLE) :: MIO_ + !> Container for all the encoding information + TYPE(MAP_T) :: ENCODING_INFO_ + + !> Container for all the encoders + TYPE(GRIB_ENCODER_CONTAINER_T), DIMENSION(:), ALLOCATABLE :: ENCODERS_ CONTAINS @@ -310,6 +317,7 @@ SUBROUTINE GRIBX2MULTIO_RAW_SETUP( THIS, YAMLFNAME, PROCESSOR_TOPO, MODEL_PARAMS USE :: OM_GENERAL_UTILS_MOD, ONLY: OM_GET_HOSTNAME USE :: OM_PROFILE_MOD, ONLY: PROFILE_START_SIMULATION USE :: OM_GENERAL_UTILS_MOD, ONLY: TOLOWER + USE :: MAP_MOD, ONLY: MAP_INIT ! Symbols imported from other libraries @@ -375,10 +383,10 @@ SUBROUTINE GRIBX2MULTIO_RAW_SETUP( THIS, YAMLFNAME, PROCESSOR_TOPO, MODEL_PARAMS CALL THIS%READ_CFG_FROM_YAML( CFG ) ! Initialize enconding informations - CALL SUENCODING_INFO( CFG, PROCESSOR_TOPO, MODEL_PARAMS, THIS%VERBOSE_ ) + CALL SUENCODING_INFO( CFG, PROCESSOR_TOPO, MODEL_PARAMS, THIS%VERBOSE_, THIS%ENCODING_INFO_ ) ! Initialise all the encoders - CALL MAKE_ENCODERS( CFG, MODEL_PARAMS, 'GRIB', THIS%VERBOSE_ ) + CALL MAKE_ENCODERS( CFG, MODEL_PARAMS, 'GRIB', THIS%VERBOSE_, THIS%ENCODERS_ ) ! Destroy the fckit configuration object CALL CFG%FINAL() @@ -504,9 +512,10 @@ SUBROUTINE GRIBX2MULTIO_RAW_WRITE_ATM_DP( THIS, YDMSG, VALUES_DP ) ! Local variables TYPE(TIME_HISTORY_T) :: TIME_HIST - TYPE(ENCODING_INFO_T), POINTER :: ENCODING_INFO + TYPE(ENCODING_INFO_T), DIMENSION(:), POINTER :: ENCODING_INFO CLASS(METADATA_BASE_A), POINTER :: PGMD TYPE(MULTIO_METADATA), POINTER :: MMD + INTEGER(KIND=JPIB_K) :: FIELD_HASH ! Local variables declared by the preprocessor for debugging purposes PP_LOG_DECL_VARS @@ -531,73 +540,122 @@ SUBROUTINE GRIBX2MULTIO_RAW_WRITE_ATM_DP( THIS, YDMSG, VALUES_DP ) ! Error handling PP_DEBUG_CRITICAL_COND_THROW( SIZE(VALUES_DP).LT.YDMSG%NVALUES_, 1 ) - ! Get encoding info - PP_LOG_DEVELOP_STR( 'Collect grib info of the current field' ) - CALL ENCODING_INFO_ACCESS_OR_CREATE( THIS%MODEL_PAR_, YDMSG%PARAM_ID_, YDMSG%IPREF_, & -& YDMSG%IREPRES_, YDMSG%IUID_, ENCODING_INFO ) - - ! Associate the pointers to the metadata - PGMD => THIS%GMD_ - PP_METADATA_INIT_LOGGING( PGMD, YDMSG%ISTEP_, YDMSG%PARAM_ID_, YDMSG%IUID_, YDMSG%IPREF_, YDMSG%IREPRES_ ) - - ! - ! Encode throws an error if an error happens, and return false if the field does not need to be emitted - IF ( ENCODE_ATM( THIS%MODEL_PAR_, ENCODING_INFO, YDMSG, TIME_HIST, PGMD ) ) THEN - - ! If needed log message - IF ( THIS%VERBOSE_ ) THEN - CALL LOG_CURR_TIME( THIS%LOG_UNIT_, 'WRITE ATMOSPHERE MESSAGE USING DOUBLE PRECISION VALUES' ) - CALL MSG_PRINT_ATM( YDMSG, THIS%LOG_UNIT_ ) - CALL GRIB_INFO_PRINT( ENCODING_INFO%GRIB_INFO, THIS%LOG_UNIT_ ) - CALL TRACK_TIME_PRINT( TIME_HIST, THIS%LOG_UNIT_ ) - ENDIF - - IF ( ENCODING_INFO%GRIB_INFO%DIRECT_TO_FDB ) THEN - - ! Set values into the grib handle - CALL THIS%GMD_%SET( 'values', VALUES_DP(1:YDMSG%NVALUES_) ) - - ! Write the encoded grib file to FDB using multIO - CALL MULTIO_WRITE_BINARY_GRIB( THIS%MIO_, THIS%MESSAGE_DATA_, THIS%GMD_%GET_HANDLE() ) - - ELSE + ! Mapping from prefix to levtype + LEV_TYPE = IPREFIX2ILEVTYPE( PREFIX, PARAM_ID, LEVEL, REPRES ) - ! Initialize loggin for multio metadata - PP_METADATA_INIT_LOGGING( THIS%MMD_, YDMSG%ISTEP_, YDMSG%PARAM_ID_, YDMSG%IUID_, YDMSG%IPREF_, YDMSG%IREPRES_ ) - - ! Create multio metadata from a grib metadata - CALL THIS%MMD_%INIT_FROM_METADATA( PGMD ) - - ! Get the multio Metadata - MMD => THIS%MMD_%GET_MULTIO_METADATA() - - ! Inject parameters in the metadata - CALL MULTIO_INJECT_PARAMETERS( THIS%MODEL_PAR_, MMD ) + ! Get encoding info + IF( .NOT. ACCESS_OR_CREATE_ATM( THIS%LOCAL_MAP_, THIS%MODEL_PAR_, YDMSG%PARAM_ID_, YDMSG%IPREF_, & +& YDMSG%IREPRES_, LEV_TYPE, ENCODING_INFO ) ) THEN - ! Write to multio plans - CALL MULTIO_WRITE_VALUES_DP( THIS%MIO_, MMD, VALUES_DP ) - ENDIF + CALL ENCODING_INFO_POPULATE_ATM( THIS%MODEL_PAR_, THIS%MODEL_PAR_, ENCODING_INFO, YDMS ) ENDIF + ! All the possible ways to encode the same field (Different units, different editions) + ! This is related to the rules configuration file with more than 1 encoding rule for the same field. + LoopOverMultipleChices: DO I = 1, SIZE( ENCODING_INFO ) + + ! Check if the message needs to be encoded. Needs to be done here because some fields don't need + ! encoding just because the step is not supposed to be emitted + IF ( TO_BE_ENCODED( THIS%ENCODERS_, THIS%MODEL_PAR_, ENCODING_INFO(I), YDMSG ) ) THEN + + ! Push encoding info to the debug module + CALL OM_SET_CURRENT_GRIB_INFO( ENCODING_INFO(I)%GRIB_INFO, GRIB_INFO_PRINT ) + + ! Associate the pointers to the metadata + PGMD => THIS%GMD_ + + ! Logging + PP_METADATA_INIT_LOGGING( PGMD, YDMSG%ISTEP_, YDMSG%PARAM_ID_, YDMSG%IUID_, YDMSG%IPREF_, YDMSG%IREPRES_ ) + + ! + ! Encode throws an error if an error happens, and return false if the field does not need to be emitted + IF ( ENCODE_ATM( THIS%ENCODERS_, THIS%MODEL_PAR_, ENCODING_INFO(I), YDMSG, PGMD ) ) THEN + + ! If needed log message + IF ( THIS%VERBOSE_ ) THEN + CALL LOG_CURR_TIME( THIS%LOG_UNIT_, 'WRITE ATMOSPHERE MESSAGE USING DOUBLE PRECISION VALUES' ) + CALL MSG_PRINT_ATM( YDMSG, THIS%LOG_UNIT_ ) + CALL GRIB_INFO_PRINT( ENCODING_INFO(I)%GRIB_INFO, THIS%LOG_UNIT_ ) + CALL TRACK_TIME_PRINT( ENCODING_INFO(I)%TIME_HIST, THIS%LOG_UNIT_ ) + ENDIF + + IF ( ENCODING_INFO%GRIB_INFO%DIRECT_TO_FDB ) THEN + + ! Set values into the grib handle + IF ( ENCODING_INFO(I)%GRIB_INFO%NEED_SCALE ) THEN + IF (ALLOCATED(THIS%TMP_VALUES_DP)) THEN + IF ( SIZE(THIS%TMP_VALUES_DP) .LT. YDMSG%NVALUES_ ) THEN + DEALLOCATE(THIS%TMP_VALUES_DP) + ALLOCATE(THIS%TMP_VALUES_DP(YDMSG%NVALUES_)) + ENDIF + ELSE + ALLOCATE(THIS%TMP_VALUES_DP(YDMSG%NVALUES_)) + ENDIF + THIS%TMP_VALUES_DP(1:YDMSG%NVALUES_) = VALUES_DP(1:YDMSG%NVALUES_)*ENCODING_INFO(I)%GRIB_INFO%SCALE_FACTOR + CALL THIS%GMD_%SET( 'values', THIS%TMP_VALUES_DP(1:YDMSG%NVALUES_) ) + ELSE + CALL THIS%GMD_%SET( 'values', VALUES_DP(1:YDMSG%NVALUES_) ) + ENDIF + + ! Write the encoded grib file to FDB using multIO + CALL MULTIO_WRITE_BINARY_GRIB( THIS%MIO_, GRIB_INFO(I)%TAG, THIS%MESSAGE_DATA_, THIS%GMD_%GET_HANDLE() ) + + ELSE + + ! Initialize loggin for multio metadata + PP_METADATA_INIT_LOGGING( THIS%MMD_, YDMSG%ISTEP_, YDMSG%PARAM_ID_, YDMSG%IUID_, YDMSG%IPREF_, YDMSG%IREPRES_ ) + + ! Create multio metadata from a grib metadata + CALL THIS%MMD_%INIT_FROM_METADATA( PGMD ) + + ! Get the multio Metadata + MMD => THIS%MMD_%GET_MULTIO_METADATA() + + ! Inject parameters in the metadata + CALL MULTIO_INJECT_PARAMETERS( THIS%MODEL_PAR_, GRIB_INFO(I)%TAG, MMD ) + + ! Write to multio plans + IF ( ENCODING_INFO(I)%GRIB_INFO%NEED_SCALE ) THEN + IF (ALLOCATED(THIS%TMP_VALUES_DP)) THEN + IF ( SIZE(THIS%TMP_VALUES_DP) .LT. YDMSG%NVALUES_ ) THEN + DEALLOCATE(THIS%TMP_VALUES_DP) + ALLOCATE(THIS%TMP_VALUES_DP(YDMSG%NVALUES_)) + ENDIF + ELSE + ALLOCATE(THIS%TMP_VALUES_DP(YDMSG%NVALUES_)) + ENDIF + THIS%TMP_VALUES_DP(1:YDMSG%NVALUES_) = VALUES_DP(1:YDMSG%NVALUES_)*ENCODING_INFO(I)%GRIB_INFO%SCALE_FACTOR + CALL MULTIO_WRITE_VALUES_DP( THIS%MIO_, MMD, THIS%TMP_VALUES_DP(1:YDMSG%NVALUES_) ) + ELSE + CALL MULTIO_WRITE_VALUES_DP( THIS%MIO_, MMD, VALUES_DP(1:YDMSG%NVALUES_) ) + ENDIF + + ENDIF + + ENDIF + + + ! Destroy the metadata objects + IF ( THIS%GMD_%INITIALIZED() ) THEN + IF ( THIS%SAVE_REPORT_ .AND. ENCODING_INFO%GRIB_INFO%DIRECT_TO_FDB ) THEN + PP_METADATA_FINALISE_LOGGING( PGMD ) + ENDIF + CALL THIS%GMD_%DESTROY() + ENDIF + + IF ( THIS%MMD_%INITIALIZED() ) THEN + IF ( THIS%SAVE_REPORT_ .AND. .NOT.ENCODING_INFO%GRIB_INFO%DIRECT_TO_FDB ) THEN + PP_METADATA_FINALISE_LOGGING( THIS%MMD_ ) + ENDIF + CALL THIS%MMD_%DESTROY() + ENDIF + + ! Reset encdoing info (Debug purposes) + CALL OM_RESET_ENCODING_INFO() - ! Destroy the metadata objects - IF ( THIS%GMD_%INITIALIZED() ) THEN - IF ( THIS%SAVE_REPORT_ .AND. ENCODING_INFO%GRIB_INFO%DIRECT_TO_FDB ) THEN - PP_METADATA_FINALISE_LOGGING( PGMD ) - ENDIF - CALL THIS%GMD_%DESTROY() - ENDIF - - IF ( THIS%MMD_%INITIALIZED() ) THEN - IF ( THIS%SAVE_REPORT_ .AND. .NOT.ENCODING_INFO%GRIB_INFO%DIRECT_TO_FDB ) THEN - PP_METADATA_FINALISE_LOGGING( THIS%MMD_ ) ENDIF - CALL THIS%MMD_%DESTROY() - ENDIF - - ! Reset encdoing info - CALL OM_RESET_ENCODING_INFO() + ENDDO LoopOverMultipleChices ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -1228,6 +1286,9 @@ SUBROUTINE GRIBX2MULTIO_RAW_FLUSH_STEP( THIS, KSTEP ) CALL PROFILE_FLUSH( THIS%PROFILE_DATA_, KSTEP ) ENDIF + ! Commit encoding info to the global map + CALL ENCODING_INFO_COMMIT( THIS%LOCAL_MAP_ ) + ! If needed log step IF ( THIS%VERBOSE_ ) THEN CLTMP = REPEAT(' ',128) @@ -1254,7 +1315,7 @@ END SUBROUTINE GRIBX2MULTIO_RAW_FLUSH_STEP !> As a `NOOP` output manager, this routine is intentionally left empty. !> !> @param [inout] this The object to be initialized. -!> @param [in] kstep Step at which teh function has been called +!> @param [in] kstep Step at which the function has been called !> #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'GRIBX2MULTIO_RAW_FLUSH_LAST_STEP' @@ -1289,6 +1350,9 @@ SUBROUTINE GRIBX2MULTIO_RAW_FLUSH_LAST_STEP( THIS, KSTEP ) CALL PROFILE_FLUSH_LAST_STEP( THIS%PROFILE_DATA_, KSTEP ) ENDIF + ! Commit encoding info to the global map + CALL ENCODING_INFO_COMMIT( THIS%LOCAL_MAP_ ) + ! If needed log step IF ( THIS%VERBOSE_ ) THEN CLTMP = REPEAT(' ',128) @@ -1351,6 +1415,8 @@ SUBROUTINE GRIBX2MULTIO_RAW_FLUSH_STEP_AND_TRIGGER_RESTART( THIS, KSTEP ) CALL PROFILE_FLUSH_AND_RESTART( THIS%PROFILE_DATA_, KSTEP ) ENDIF + ! Commit encoding info to the global map + CALL ENCODING_INFO_COMMIT( THIS%LOCAL_MAP_ ) ! If needed log step and restart IF ( THIS%VERBOSE_ ) THEN diff --git a/src/ecom/grib_info/encoding_info_manager_mod.F90 b/src/ecom/grib_info/encoding_info_manager_mod.F90 new file mode 100644 index 000000000..340cd20f2 --- /dev/null +++ b/src/ecom/grib_info/encoding_info_manager_mod.F90 @@ -0,0 +1,2092 @@ +!> @file encoding_info_manager.F90 +!> +!> @brief High-level management and organization of encoding information. +!> +!> This module provides a suite of procedures for managing and organizing encoding information +!> within the output manager. It includes functions and subroutines for creating, extracting, and manipulating +!> bitmasks used in encoding schemes, as well as handling linked lists of encoding data. +!> +!> The procedures within this module handle tasks such as generating bitmasks, extracting specific +!> fields from bitmasks, and maintaining linked lists of encoding information. The module is designed +!> for thread-safe operations to support concurrent execution. +!> +!> @author Mirco Valentini +!> @date January 31, 2024 +!> + +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + +#define __THREAD_SAFE__ RECURSIVE + +#define PP_FILE_NAME 'encoding_info_manager_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'ENCODING_INFO_MANAGER_MOD' +MODULE ENCODING_INFO_MANAGER_MOD + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: MAP_MOD, ONLY: MAP_T + +IMPLICIT NONE + +PRIVATE + + !> @brief Local parameters + INTEGER(KIND=INT64), PARAMETER :: MAX_PARAMID = (2_INT64**27_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_LEVEL = (2_INT64**26_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_DIRECTION = (2_INT64**13_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_FREQUENCY = (2_INT64**13_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_LEVTYPE = (2_INT64**4_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_REPRES = (2_INT64**4_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_MODEL = (2_INT64**2_INT64) - 1_INT64 + INTEGER(KIND=INT64), PARAMETER :: MAX_PRECISION = (2_INT64**2_INT64) - 1_INT64 + + !> @brief Encoding info structure, used to fastly recover the encdoing configuration + TYPE :: ENCODING_INFO_T + + !> @brief A tag used to differentiate between different encoding information + CHARACTER(LEN=32) :: TAG + + !> @brief In some cases the original param ID can be mapped to a different one to allow for different encodings + INTEGER(KIND=JPIB_K) :: MAPPED_PARAM_ID + + !> @brief In some cases the original level can be mapped to a different one to allow for different encodings + INTEGER(KIND=JPIB_K), DIMENSION(2) :: MAPPED_LEVEL + + !> @brief In some cases the original level type can be mapped to a different one to allow for different encodings + INTEGER(KIND=JPIB_K) :: MAPPED_LEVTYPE + + !> @brief Some definitions still don't have a proper definition in eccodes, `paramIDECMF` is an hack to allow them to be encoded anyway + LOGICAL :: USE_PARAMID_ECMF + + !> @brief Relevant information used for selecting the kind of encoding + TYPE(GRIB_STRUCTURE_T) :: GRIB_STRUCTURE + + !> @brief Relevant information used for selecting the kind of encoding + TYPE(GRIB_INFO_T) :: GRIB_INFO + + !> @brief Relevant information used to encode time inforamtion + TYPE(TIME_ASSUMPTIONS_T) :: TIME_ASSUMPTIONS + + !> @brief Relevant information used to encode level inforamtion + TYPE(LEVEL_ASSUMPTIONS_T) :: LEVEL_ASSUMPTIONS + + !> @brief Relevant information used to encode packing inforamtion + TYPE(LEVEL_ASSUMPTIONS_T) :: PACKING_ASSUMPTIONS + + !> @brief Circular buffer to store the time history of the field + TYPE(CIRCULARBUFFER_T) :: TIME_HISTORY + END TYPE + + !> @brief Datatype used to contain a collection of encoding information + TYPE :: ENCODING_INFO_COLLECTION_T + !> @brief Array of encoding information + TYPE(ENCODING_INFO_T), DIMENSION(:), POINTER :: EI_ => NULL() + END TYPE + + !> @brief node in a list that contains pointer to circular buffers. + TYPE :: EI_LIST_NODE_T + + !> @brief Hash used to as key in the map when the information will + !> be pushed the encoding information + INTEGER(KIND=INT64) :: HASH + + !> @brief Pointer to the encoding information collection + TYPE(ENCODING_INFO_COLLECTION_T), POINTER :: EIC_ => NULL() + + !> @brief Pointer to the next node in the list + TYPE(EI_LIST_NODE_T), POINTER :: NEXT_ => NULL() + + !> @brief Pointer to the previous node in the list + TYPE(EI_LIST_NODE_T), POINTER :: PREV_ => NULL() + END TYPE + + !> @brief List of circular buffers + TYPE :: EI_LIST_T + !> @brief Pointer to the head of the list + TYPE(EI_LIST_NODE_T), POINTER :: HEAD_ => NULL() + + !> @brief Pointer to the tail of the list + TYPE(EI_LIST_NODE_T), POINTER :: TAIL_ => NULL() + + !> @brief Number of nodes in the list + INTEGER(KIND=JPIB_K) :: SIZE = 0_JPIB_K + END TYPE + + !> @brief Shared map between OMP threads that contains all the atmosphere encoding information + TYPE(MAP_T), SAVE :: OMP_SHARED_ENCODING_INFO_ATM + + !> @brief Shared map between OMP threads that contains all the wave encoding information + TYPE(MAP_T), SAVE :: OMP_SHARED_ENCODING_INFO_WAM + + + !> Whitelist of public symbols + ! PUBLIC :: ENCODING_INFO_INIT + PUBLIC :: ENCODING_INFO_ACCESS_OR_CREATE_ATM + PUBLIC :: ENCODING_INFO_ACCESS_OR_CREATE_WAM + PUBLIC :: ENCODING_INFO_COMMIT_QTM + PUBLIC :: ENCODING_INFO_COMMIT_WAM + ! PUBLIC :: ENCODING_INFO_FREE + +CONTAINS + +!> +!> @brief Initializes the data structures and configurations needed for managing encoding information. +!> +!> This subroutine sets up the initial environment required for managing encoding information +!> within the system. It configures various components, initializes maps and rules, and prepares +!> the necessary data structures based on the provided configuration and processor topology. +!> +!> @param [in] CFG The configuration object containing settings and parameters needed for initialization. +!> It provides a centralized configuration interface for setting up the encoding management system. +!> +!> @param [in] PROCESSOR_TOPO The processor topology structure that describes the mapping of computational tasks +!> to the processor grid. This information is crucial for optimizing the setup according +!> to the available hardware. +!> +!> @param [in] MODEL_PARAMS A structure containing model parameters that influence how encoding information is managed. +!> These parameters include model-specific settings that tailor the initialization process +!> to the particular needs of the model in use. +!> +!> @param [in] VERBOSE A logical flag indicating whether the subroutine should provide detailed output during execution. +!> If `TRUE`, the subroutine will print additional information useful for debugging and monitoring +!> the initialization process. +!> +!> @see ENCODING_INFO_FREE +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'SUENCODING_INFO' +SUBROUTINE SUENCODING_INFO( CFG, PROCESSOR_TOPO, MODEL_PARAMS, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: OM_CORE_MOD, ONLY: PROC_TOPO_T + USE :: OM_CORE_MOD, ONLY: MODEL_PAR_T + USE :: OM_CORE_MOD, ONLY: N_LEVTYPE_E + USE :: OM_CORE_MOD, ONLY: N_REPRES_E + USE :: MAP_MOD, ONLY: MAP_INIT + USE :: YAML_RULES_MOD, ONLY: INIT_RULES + USE :: YAML_RULES_MOD, ONLY: RULES_DIMS + USE :: YAML_TIME_ASSUMPTIONS_MOD, ONLY: INIT_TIME_ASSUMPTION_RULES + + ! Symbols imported from other libraries + USE :: FCKIT_CONFIGURATION_MODULE, ONLY: FCKIT_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(FCKIT_CONFIGURATION), INTENT(IN) :: CFG + TYPE(PROC_TOPO_T), INTENT(IN) :: PROCESSOR_TOPO + TYPE(MODEL_PAR_T), INTENT(IN) :: MODEL_PARAMS + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + INTEGER(KIND=JPIB_K) :: NUM_PARAM_ID + INTEGER(KIND=JPIB_K) :: MAX_PARAM_ID + INTEGER(KIND=JPIB_K) :: MIN_PARAM_ID + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: J + INTEGER(KIND=JPIB_K) :: K + INTEGER(KIND=JPIB_K) :: STAT + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Read and initialise rules from YAML + CALL INIT_RULES( CFG, VERBOSE ) + + ! Read and initialise time encoding rules from YAML + CALL INIT_TIME_ASSUMPTIONS_RULES( CFG, VERBOSE ) + CALL INIT_LEVEL_ASSUMPTIONS_RULES( CFG, VERBOSE ) + CALL INIT_PACKING_ASSUMPTIONS_RULES( CFG, VERBOSE ) + + + ! Initialize all the maps + CALL MAP_INIT( OMP_SHARED_ENCODING_INFO_ATM ) + CALL MAP_INIT( OMP_SHARED_ENCODING_INFO_WAM ) + + ! Initialise encoding tables + CALL TIME_ENCODING_TABLE_HEADER( ) + CALL PACKING_ENCODING_TABLE_HEADER() + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! HAndle different errors + SELECT CASE(ERRIDX) + CASE (1) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate encoding_info: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate encoding_info' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE SUENCODING_INFO +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + +!> +!> @brief Access or create an encoding information node in a thread-local list for atmosphere. +!> +!> This function attempts to find an existing node in the sharem map `OMP_SHARED_ENCODING_INFO_ATM` +!> that matches an hash costructed from parameter ID (`PARAMID`), +!> level (`LEVEL`), level type (`LEVTYPE`), representation type (`REPRES`), model (`MODEL`), +!> and precision (`PRECISION`). If such a node is found, a pointer to its encoding information +!> array is returned via `EI`. If no matching node exists, a new node is created and added +!> to the list, and a pointer to the new node's encoding information array is returned. +!> +!> @param [inout] LOCAL_LIST The thread-local list (`EI_LIST_T` type) where the function +!> searches for or adds a node. This list is passed by reference +!> and may be modified if a new node is created. +!> +!> @param [in] MODEL_PARAMS The model parameters (`MODEL_PAR_T` type) used as part of the +!> search criteria to identify or create a node. +!> +!> @param [in] PARAMID The parameter ID (`JPIB_K` type) used as part of the search criteria. +!> +!> @param [in] LEVEL The level (`JPIB_K` type) associated with the node, used as part of +!> the search criteria. +!> +!> @param [in] LEVTYPE The level type (`JPIB_K` type) associated with the node, used as +!> part of the search criteria. +!> +!> @param [in] REPRES The representation type (`JPIB_K` type) used as part of the search criteria. +!> +!> @param [in] MODEL The model identifier (`JPIB_K` type) associated with the node, +!> used as part of the search criteria. +!> +!> @param [in] PRECISION The precision (`JPIB_K` type) used as part of the search criteria. +!> +!> @param [out] EI A pointer to the encoding information array (`ENCODING_INFO_T` type, +!> dimensioned as `(:)`) of the found or newly created node. This allows +!> for direct access and manipulation of the encoding information. +!> +!> @return The function returns a flag indicating if the encoding info was found or created. +!> +!> The operation is thread-safe (only read operations happens on shared data structures), +!> allowing it to be used in parallel regions without data corruption. +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_ACCESS_OR_CREATE_ATM' +__THREAD_SAFE__ FUNCTION ENCODING_INFO_ACCESS_OR_CREATE_ATM( LOCAL_LIST, MODEL_PARAMS, PARAMID, & +& LEVEL, LEVTYPE, REPRES, MODEL, PRECISION, EI ) RESULT(FOUND) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: LOCAL_LIST + TYPE(MODEL_PAR_T), INTENT(IN) :: MODEL_PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: PARAM_ID + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVTYPE + INTEGER(KIND=JPIB_K), INTENT(IN) :: REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: MODEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: PRECISION + TYPE(ENCODING_INFO_T), POINTER, DIMENSION(:), INTENT(OUT) :: EI + + ! Function Result + LOGICAL :: FOUND + + ! Local variables + INTEGER(KIND=JPIB_K), DIMENSION(2) :: TMP_LEVEL + INTEGER(KIND=INT64) :: HASH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of function result + NULLIFY(EI) + + ! Construct hash + HASH = CREATE_FIELD_HASH_ATM(PARAMID, LEVEL, LEVTYPE, REPRES, MODEL, PRECISION ) + + ! Get encoding info + FOUND = MAP_GET( OMP_SHARED_ENCODING_INFO_ATM, HASH, VALUE ) + + ! Check if the encoding info is already available + IF ( FOUND ) THEN + + SELECT TYPE ( A => VALUE ) + + CLASS IS ( ENCODING_INFO_T ) + + ! Set output variables + EI => A + + CLASS DEFAULT + + ! Error handling + PP_DEBUG_DEVELOP_THROW( 4 ) + + END SELECT + + ELSE + + ! Extract definitions from encding rules + CALL GET_RULES_SIZE( PARAM_ID, LEV_TYPE, REPRES, LEVEL, NRULES ) + + ! Create new encoding info locally + CALL ENCODING_INFO_NEW( LOCAL_LIST, HASH, NRULES, EI ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END FUNCTION ENCODING_INFO_ACCESS_OR_CREATE_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Access or create an encoding information node in a thread-local list for wave model. +!> +!> This function attempts to find an existing node in the sharem map `OMP_SHARED_ENCODING_INFO_WAM` +!> that matches an hash costructed from parameter ID (`PARAMID`), +!> level (`LEVEL`), level type (`LEVTYPE`), representation type (`REPRES`), model (`MODEL`), +!> and precision (`PRECISION`). If such a node is found, a pointer to its encoding information +!> array is returned via `EI`. If no matching node exists, a new node is created and added +!> to the list, and a pointer to the new node's encoding information array is returned. +!> +!> @param [inout] LOCAL_LIST The thread-local list (`EI_LIST_T` type) where the function +!> searches for or adds a node. This list is passed by reference +!> and may be modified if a new node is created. +!> +!> @param [in] MODEL_PARAMS The model parameters (`MODEL_PAR_T` type) used as part of the +!> search criteria to identify or create a node. +!> +!> @param [in] PARAMID The parameter ID (`JPIB_K` type) used as part of the search criteria. +!> +!> @param [in] LEVEL The level (`JPIB_K` type) associated with the node, used as part of +!> the search criteria. +!> +!> @param [in] LEVTYPE The level type (`JPIB_K` type) associated with the node, used as +!> part of the search criteria. +!> +!> @param [in] REPRES The representation type (`JPIB_K` type) used as part of the search criteria. +!> +!> @param [in] MODEL The model identifier (`JPIB_K` type) associated with the node, +!> used as part of the search criteria. +!> +!> @param [in] PRECISION The precision (`JPIB_K` type) used as part of the search criteria. +!> +!> @param [out] EI A pointer to the encoding information array (`ENCODING_INFO_T` type, +!> dimensioned as `(:)`) of the found or newly created node. This allows +!> for direct access and manipulation of the encoding information. +!> +!> @return The function returns a flag indicating if the encoding info was found or created. +!> +!> The operation is thread-safe (only read operations happens on shared data structures), +!> allowing it to be used in parallel regions without data corruption. +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_ACCESS_OR_CREATE_WAM' +__THREAD_SAFE__ FUNCTION ENCODING_INFO_ACCESS_OR_CREATE_WAM( LOCAL_LIST, MODEL_PARAMS, PARAMID, & +& DIRECTION, FREQUENCY, LEVTYPE, REPRES, MODEL, PRECISION, EI ) RESULT(FOUND) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: LOCAL_LIST + TYPE(MODEL_PAR_T), INTENT(IN) :: MODEL_PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: PARAM_ID + INTEGER(KIND=JPIB_K), INTENT(IN) :: DIRECTION + INTEGER(KIND=JPIB_K), INTENT(IN) :: FREQUENCY + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVTYPE + INTEGER(KIND=JPIB_K), INTENT(IN) :: REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: MODEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: PRECISION + TYPE(ENCODING_INFO_T), POINTER, DIMENSION(:), INTENT(OUT) :: EI + + ! Function Result + LOGICAL :: FOUND + + ! Local variables + INTEGER(KIND=JPIB_K), DIMENSION(2) :: TMP_LEVEL + INTEGER(KIND=INT64) :: HASH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of function result + NULLIFY(EI) + + ! Construct hash + HASH = CREATE_FIELD_HASH_ATM(PARAMID, DIRECTION, FREQUENCY, LEVTYPE, REPRES, MODEL, PRECISION ) + + ! Get encoding info + FOUND = MAP_GET( OMP_SHARED_ENCODING_INFO_WAM, HASH, VALUE ) + + ! Check if the encoding info is already available + IF ( FOUND ) THEN + + SELECT TYPE ( A => VALUE ) + + CLASS IS ( ENCODING_INFO_T ) + + ! Set output variables + EI => A + + CLASS DEFAULT + + ! Error handling + PP_DEBUG_DEVELOP_THROW( 4 ) + + END SELECT + + ELSE + + ! Extract definitions from encding rules + CALL GET_RULES_SIZE( PARAM_ID, LEV_TYPE, REPRES, LEVEL, NRULES ) + + ! Create new encoding info locally + CALL ENCODING_INFO_NEW( LOCAL_LIST, NRULES, EI ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END FUNCTION ENCODING_INFO_ACCESS_OR_CREATE_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_POPULATE_ATM' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_POPULATE_ATM( LOCAL_LIST, MODEL_PARAMS, PARAMID, & +& LEVEL, LEVTYPE, REPRES, MODEL, PRECISION, EI ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: LOCAL_LIST + TYPE(MODEL_PAR_T), INTENT(IN) :: MODEL_PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: PARAM_ID + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVTYPE + INTEGER(KIND=JPIB_K), INTENT(IN) :: REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: MODEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: PRECISION + TYPE(ENCODING_INFO_T), DIMENSION(:), INTENT(OUT) :: EI + + ! Local variables + INTEGER(KIND=JPIB_K), DIMENSION(2) :: TMP_LEVEL + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of local variables + TMP_LEVEL(1) = LEVEL + TMP_LEVEL(2) = 0_JPIB_K + + ! Get all the definitions we need to encode + SearchTheEncodingRules: DO RULE_ID = 1, SIZE(EI) + + ! Extract definitions from encding rules + CALL MATCH_RULES( RULE_ID, PARAM_ID, LEV_TYPE, REPRES, TMP_LEVEL, EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEVEL, EI(RULE_ID)%MAPPED_LEV_TYPE, EI(RULE_ID)%GRIB_INFO ) + + ! Time assumptions for the specified field + CALL MATCH_TIME_ASSUMPTIONS_RULES( EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEV_TYPE, REPRES, EI(RULE_ID)%MAPPED_LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), EI(I)%TIME_ASSUMPTIONS ) + + ! Time assumptions for the specified field + CALL MATCH_LEVEL_ASSUMPTIONS_RULES( EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEV_TYPE, REPRES, EI(RULE_ID)%MAPPED_LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), EI(I)%LEVEL_ASSUMPTIONS ) + + ! Time assumptions for the specified field + CALL MATCH_PACKING_ASSUMPTIONS_RULES( EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEV_TYPE, REPRES, EI(RULE_ID)%MAPPED_LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), EI(I)%PACKING_ASSUMPTIONS ) + + ! Initialize circular buffer + EI(RULE_ID)%TIME_HISTORY%INIT( CAPACITY ) + + ENDDO SearchTheEncodingRules + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE ENCODING_INFO_POPULATE_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_POPULATE_WAM' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_POPULATE_WAM( LOCAL_LIST, MODEL_PARAMS, PARAMID, & +& DIRECTION, FREQUENCY, LEVTYPE, REPRES, MODEL, PRECISION, EI ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: LOCAL_LIST + TYPE(MODEL_PAR_T), INTENT(IN) :: MODEL_PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: PARAM_ID + INTEGER(KIND=JPIB_K), INTENT(IN) :: DIRECTION + INTEGER(KIND=JPIB_K), INTENT(IN) :: FREQUENCY + INTEGER(KIND=JPIB_K), INTENT(IN) :: LEVTYPE + INTEGER(KIND=JPIB_K), INTENT(IN) :: REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: MODEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: PRECISION + TYPE(ENCODING_INFO_T), DIMENSION(:), INTENT(OUT) :: EI + + ! Local variables + INTEGER(KIND=JPIB_K), DIMENSION(2) :: TMP_LEVEL + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of local variables + TMP_LEVEL(1) = DIRECTION + TMP_LEVEL(2) = FREQUENCY + + ! Get all the definitions we need to encode + SearchTheEncodingRules: DO RULE_ID = 1, SIZE(EI) + + ! Extract definitions from encding rules + CALL MATCH_RULES( RULE_ID, PARAM_ID, LEV_TYPE, REPRES, TMP_LEVEL, EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEVEL, EI(RULE_ID)%MAPPED_LEV_TYPE, EI(RULE_ID)%GRIB_INFO ) + + ! Time assumptions for the specified field + CALL MATCH_TIME_ASSUMPTIONS_RULES( EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEV_TYPE, REPRES, EI(RULE_ID)%MAPPED_LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), EI(I)%TIME_ASSUMPTIONS ) + + ! Time assumptions for the specified field + CALL MATCH_LEVEL_ASSUMPTIONS_RULES( EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEV_TYPE, REPRES, EI(RULE_ID)%MAPPED_LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), EI(I)%LEVEL_ASSUMPTIONS ) + + ! Time assumptions for the specified field + CALL MATCH_PACKING_ASSUMPTIONS_RULES( EI(RULE_ID)%MAPPED_PARAM_ID, EI(RULE_ID)%MAPPED_LEV_TYPE, REPRES, EI(RULE_ID)%MAPPED_LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), EI(I)%PACKING_ASSUMPTIONS ) + + ! Initialize circular buffer + EI(RULE_ID)%TIME_HISTORY%INIT( CAPACITY ) + + ENDDO SearchTheEncodingRules + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE ENCODING_INFO_POPULATE_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Generate a unique bitmask (hash) for atmospheric field parameters. +!> +!> This function generates a unique 64-bit bitmask (hash) based on the provided atmospheric +!> field parameters. The parameters include `PARAMID`, `LEVEL`, `LEVTYPE`, `REPRES`, +!> `MODEL`, and `PRECISION`. The bitmask is constructed using the following bit allocation: +!> +!> - **1 bit** for the sign bit (`sid`), derived from the sign of the `LEVEL` parameter. +!> - **27 bits** for the parameter ID (`PARAMID`), which uniquely identifies the field. +!> - **26 bits** for the level (`LEVEL`), allowing for a wide range of level values. +!> - **4 bits** for the level type (`LEVTYPE`), specifying the type of level. +!> - **2 bits** for the representation type (`REPRES`), indicating how the data is represented. +!> - **2 bits** for the model identifier (`MODEL`), distinguishing between different models. +!> - **2 bits** for the precision (`PRECISION`), defining the precision of the data. +!> +!> The resulting 64-bit bitmask uniquely identifies a specific combination of these parameters, +!> allowing for efficient storage and retrieval of associated data within the system. The +!> function is thread-safe, ensuring consistent results in a concurrent environment. +!> +!> @param [in] PARAMID The parameter ID (`INT64` type) that forms part of the hash, using 27 bits. +!> +!> @param [in] LEVEL The level (`INT64` type) associated with the atmospheric field, +!> using 26 bits and 1 sign bit. +!> +!> @param [in] LEVTYPE The level type (`INT64` type) used as part of the hash generation, using 4 bits. +!> +!> @param [in] REPRES The representation type (`INT64` type) used as part of the hash generation, using 2 bits. +!> +!> @param [in] MODEL The model identifier (`INT64` type) associated with the atmospheric +!> field, used in the hash generation, using 2 bits. +!> +!> @param [in] PRECISION The precision (`INT64` type) used as part of the hash generation, using 2 bits. +!> +!> @return BITMASK The resulting 64-bit bitmask (`INT64` type) that uniquely identifies +!> the combination of input parameters, structured as described above. +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'CREATE_FIELD_HASH_ATM' +__THREAD_SAFE__ FUNCTION CREATE_FIELD_HASH_ATM(PARAMID, LEVEL, LEVTYPE, REPRES, MODEL, PRECISION ) RESULT(BITMASK) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + INTEGER(KIND=INT64), INTENT(IN) :: PARAMID + INTEGER(KIND=INT64), INTENT(IN) :: LEVEL + INTEGER(KIND=INT64), INTENT(IN) :: LEVTYPE + INTEGER(KIND=INT64), INTENT(IN) :: REPRES + INTEGER(KIND=INT64), INTENT(IN) :: MODEL + INTEGER(KIND=INT64), INTENT(IN) :: PRECISION + + ! Function Result + INTEGER(KIND=INT64) :: BITMASK + + ! Local variables + INTEGER(KIND=INT64) :: SID + INTEGER(KIND=INT64) :: LID + INTEGER(KIND=INT64) :: TMP + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of the output variable + BITMASK = 0_INT64 + + ! Initialization of other local variables + IF ( LEVEL .LT. 0 ) THEN + SID = 0 + LID = -LEVEL + ELSE + SID = 1 + LID = LEVEL + END IF + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( PARAMID.LT.0, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( PARAMID.GT.MAX_PARAMID, 2 ) + + PP_DEBUG_CRITICAL_COND_THROW( LID.LT.0, 3 ) + PP_DEBUG_CRITICAL_COND_THROW( LID.GT.MAX_LEVEL, 4 ) + + PP_DEBUG_CRITICAL_COND_THROW( LEVTYPE.LT.0, 5 ) + PP_DEBUG_CRITICAL_COND_THROW( LEVTYPE.GT.MAX_LEVTYPE, 6 ) + + PP_DEBUG_CRITICAL_COND_THROW( REPRES.LT.0, 7 ) + PP_DEBUG_CRITICAL_COND_THROW( REPRES.GT.MAX_REPRES, 8 ) + + PP_DEBUG_CRITICAL_COND_THROW( MODEL.LT.0, 9 ) + PP_DEBUG_CRITICAL_COND_THROW( MODEL.GT.MAX_MODEL, 10 ) + + PP_DEBUG_CRITICAL_COND_THROW( PRECISION.LT.0, 11 ) + PP_DEBUG_CRITICAL_COND_THROW( PRECISION.GT.MAX_PRECISION, 12 ) + + ! Compose the bitmask + BITMASK = IOR(BITMASK, ISHFT(SID, INT(0 ,KIND=INT64))) + BITMASK = IOR(BITMASK, ISHFT(PARAMID, INT(1 ,KIND=INT64))) + BITMASK = IOR(BITMASK, ISHFT(LID, INT(28,KIND=INT64))) + BITMASK = IOR(BITMASK, ISHFT(LEVTYPE, INT(54,KIND=INT64))) + BITMASK = IOR(BITMASK, ISHFT(REPRES, INT(58,KIND=INT64))) + BITMASK = IOR(BITMASK, ISHFT(MODEL, INT(60,KIND=INT64))) + BITMASK = IOR(BITMASK, ISHFT(PRECISION, INT(62,KIND=INT64))) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=4096) :: STR + CHARACTER(LEN=32) :: TMP1 + CHARACTER(LEN=32) :: TMP2 + + ! Handle different errors + SELECT CASE(ERRIDX) + + CASE (1) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PARAMID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (paramId:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PARAMID.LT.0'//TRIM(ADJUSTL(STR)) ) + CASE (2) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PARAMID + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_PARAMID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (paramId:=', TRIM(ADJUSTL(TMP1)), ' - max_paramId:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PARAMID.GT.MAX_PARAMID'//TRIM(ADJUSTL(STR)) ) + + CASE (3) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (level:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: LEVEL.LT.0' ) + CASE (4) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LID + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_LEVEL + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (level:=', TRIM(ADJUSTL(TMP1)), ' - max_level:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: LEVEL.GT.MAX_LID' ) + + CASE (5) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LEVTYPE + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (levtype:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: LEVTYPE.LT.0' ) + CASE (6) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LEVTYPE + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_LEVTYPE + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (levtype:=', TRIM(ADJUSTL(TMP1)), ' - max_levtype:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: LEVTYPE.GT.MAX_LEVTYPE' ) + + CASE (7) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') REPRES + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (repres:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: REPRES.LT.0' ) + CASE (8) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') REPRES + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_REPRES + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (repres:=', TRIM(ADJUSTL(TMP1)), ' - max_repres:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: REPRES.GT.MAX_REPRES' ) + + CASE (9) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') MODEL + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (model:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: MODEL.LT.0' ) + CASE (10) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') MODEL + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_MODEL + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (model:=', TRIM(ADJUSTL(TMP1)), ' - max_model:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: MODEL.GT.MAX_MODEL' ) + + CASE (11) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PRECISION + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (precision:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PRECISION.LT.0' ) + CASE (12) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PRECISION + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_PRECISION + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (precision:=', TRIM(ADJUSTL(TMP1)), ' - max_precision:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PRECISION.GT.MAX_PRECISION' ) + + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END FUNCTION CREATE_FIELD_HASH_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Generate a unique bitmask (hash) for WAM field parameters. +!> +!> This function generates a unique 64-bit bitmask (hash) based on the provided WAM (Wave +!> and Atmosphere Model) field parameters. The parameters include `PARAMID`, `DIRECTION`, +!> `FREQUENCY`, `LEVTYPE`, `REPRES`, `MODEL`, and `PRECISION`. The bitmask is constructed +!> using the following bit allocation: +!> +!> - **1 bit** for the sign bit (`sid`), typically used to indicate the sign of the `DIRECTION`. +!> - **27 bits** for the parameter ID (`PARAMID`), which uniquely identifies the field. +!> - **13 bits** for the direction (`DIRECTION`), specifying the wave or wind direction. +!> - **13 bits** for the frequency (`FREQUENCY`), representing the wave or signal frequency. +!> - **4 bits** for the level type (`LEVTYPE`), specifying the type of level. +!> - **2 bits** for the representation type (`REPRES`), indicating how the data is represented. +!> - **2 bits** for the model identifier (`MODEL`), distinguishing between different models. +!> - **2 bits** for the precision (`PRECISION`), defining the precision of the data. +!> +!> The resulting 64-bit bitmask uniquely identifies a specific combination of these parameters, +!> allowing for efficient storage and retrieval of associated data within the system. The +!> function is thread-safe, ensuring consistent results in a concurrent environment. +!> +!> @param [in] PARAMID The parameter ID (`INT64` type) that forms part of the hash, using 27 bits. +!> +!> @param [in] DIRECTION The direction (`INT64` type) associated with the WAM field, +!> using 13 bits. +!> +!> @param [in] FREQUENCY The frequency (`INT64` type) associated with the WAM field, +!> using 13 bits. +!> +!> @param [in] LEVTYPE The level type (`INT64` type) used as part of the hash generation, using 4 bits. +!> +!> @param [in] REPRES The representation type (`INT64` type) used as part of the hash generation, using 2 bits. +!> +!> @param [in] MODEL The model identifier (`INT64` type) associated with the WAM field, +!> used in the hash generation, using 2 bits. +!> +!> @param [in] PRECISION The precision (`INT64` type) used as part of the hash generation, using 2 bits. +!> +!> @return BITMASK The resulting 64-bit bitmask (`INT64` type) that uniquely identifies +!> the combination of input parameters, structured as described above. +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'CREATE_FIELD_HASH_WAM' +__THREAD_SAFE__ FUNCTION CREATE_FIELD_HASH_WAM(PARAMID, DIRECTION, FREQUENCY, LEVTYPE, REPRES, MODEL, PRECISION ) RESULT(BITMASK) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + INTEGER(KIND=INT64), INTENT(IN) :: PARAMID + INTEGER(KIND=INT64), INTENT(IN) :: DIRECTION + INTEGER(KIND=INT64), INTENT(IN) :: FREQUENCY + INTEGER(KIND=INT64), INTENT(IN) :: LEVTYPE + INTEGER(KIND=INT64), INTENT(IN) :: REPRES + INTEGER(KIND=INT64), INTENT(IN) :: MODEL + INTEGER(KIND=INT64), INTENT(IN) :: PRECISION + + ! Function Result + INTEGER(KIND=INT64) :: BITMASK + + ! Local variables + INTEGER(KIND=INT64) :: SID + INTEGER(KIND=INT64) :: LID + INTEGER(KIND=INT64) :: TMP + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of the output variable + BITMASK = 0_INT64 + + ! Initialization of other local variables + IF ( DIRECTION .LT. 0 ) THEN + SID = 0 + LID = -DIRECTION + ELSE + SID = 1 + LID = DIRECTION + END IF + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( PARAMID.LT.0, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( PARAMID.GT.MAX_PARAMID, 2 ) + + PP_DEBUG_CRITICAL_COND_THROW( LID.LT.0, 3 ) + PP_DEBUG_CRITICAL_COND_THROW( LID.GT.MAX_DIRECTION, 4 ) + + PP_DEBUG_CRITICAL_COND_THROW( FREQUENCY.LT.0, 5 ) + PP_DEBUG_CRITICAL_COND_THROW( FREQUENCY.GT.MAX_FREQUENCY, 6 ) + + PP_DEBUG_CRITICAL_COND_THROW( LEVTYPE.LT.0, 7 ) + PP_DEBUG_CRITICAL_COND_THROW( LEVTYPE.GT.MAX_LEVTYPE, 8 ) + + PP_DEBUG_CRITICAL_COND_THROW( REPRES.LT.0, 9 ) + PP_DEBUG_CRITICAL_COND_THROW( REPRES.GT.MAX_REPRES, 10 ) + + PP_DEBUG_CRITICAL_COND_THROW( MODEL.LT.0, 11 ) + PP_DEBUG_CRITICAL_COND_THROW( MODEL.GT.MAX_MODEL, 12 ) + + PP_DEBUG_CRITICAL_COND_THROW( PRECISION.LT.0, 13 ) + PP_DEBUG_CRITICAL_COND_THROW( PRECISION.GT.MAX_PRECISION, 14 ) + + ! Compose the bitmask + BITMASK = IOR(BITMASK, ISHFT(SID, INT(0, KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(PARAMID, INT(1, KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(LID, INT(28,KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(FREQUENCY, INT(41,KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(LEVTYPE, INT(54,KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(REPRES, INT(58,KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(MODEL, INT(60,KIND=INT64) ) ) + BITMASK = IOR(BITMASK, ISHFT(PRECISION, INT(62,KIND=INT64) ) ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=4096) :: STR + CHARACTER(LEN=32) :: TMP1 + CHARACTER(LEN=32) :: TMP2 + + ! Handle different errors + SELECT CASE(ERRIDX) + + CASE (1) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PARAMID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (paramId:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PARAMID.LT.0'//TRIM(ADJUSTL(STR)) ) + CASE (2) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PARAMID + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_PARAMID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (paramId:=', TRIM(ADJUSTL(TMP1)), ' - max_paramId:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PARAMID.GT.MAX_PARAMID'//TRIM(ADJUSTL(STR)) ) + + CASE (3) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (direction:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: DIRECTION.LT.0' ) + CASE (4) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LID + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_LID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (direction:=', TRIM(ADJUSTL(TMP1)), ' - max_direction:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: DIRECTION.GT.MAX_LID' ) + + CASE (5) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (frequency:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: FREQUENCY.LT.0' ) + CASE (6) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LID + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_LID + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (frequency:=', TRIM(ADJUSTL(TMP1)), ' - max_frequency:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: FREQUENCY.GT.MAX_LID' ) + + + + + + + + CASE (7) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LEVTYPE + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (levtype:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: LEVTYPE.LT.0' ) + CASE (8) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') LEVTYPE + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_LEVTYPE + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (levtype:=', TRIM(ADJUSTL(TMP1)), ' - max_levtype:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: LEVTYPE.GT.MAX_LEVTYPE' ) + + CASE (9) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') REPRES + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (repres:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: REPRES.LT.0' ) + CASE (10) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') REPRES + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_REPRES + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (repres:=', TRIM(ADJUSTL(TMP1)), ' - max_repres:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: REPRES.GT.MAX_REPRES' ) + + CASE (11) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') MODEL + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (model:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: MODEL.LT.0' ) + CASE (12) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') MODEL + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_MODEL + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (model:=', TRIM(ADJUSTL(TMP1)), ' - max_model:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: MODEL.GT.MAX_MODEL' ) + + CASE (13) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PRECISION + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A)') ' -> (precision:=', TRIM(ADJUSTL(TMP1)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PRECISION.LT.0' ) + CASE (14) + TMP1 = REPEAT(' ',32) + WRITE(TMP1,'(I32)') PRECISION + TMP2 = REPEAT(' ',32) + WRITE(TMP2,'(I32)') MAX_PRECISION + STR = REPEAT(' ',4096) + WRITE(STR, '(A,A,A,A,A)') ' -> (precision:=', TRIM(ADJUSTL(TMP1)), ' - max_precision:=', TRIM(ADJUSTL(TMP2)), ')' + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Input out of bounds: PRECISION.GT.MAX_PRECISION' ) + + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END FUNCTION CREATE_FIELD_HASH_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Extracts individual field parameters from a 64-bit bitmask. +!> +!> This subroutine extracts the individual field parameters from a given 64-bit bitmask +!> (`BITMASK`) generated by the `CREATE_FIELD_HASH_ATM` function. The bitmask contains encoded +!> values for the `PARAMID`, `ID`, `LEVTYPE`, `REPRES`, `MODEL`, and `PRECISION` parameters. +!> The extraction is based on the following bit allocation within the bitmask: +!> +!> - **1 bit** for the sign bit (`sid`), extracted as part of `ID`. +!> - **27 bits** for the parameter ID (`PARAMID`), which uniquely identifies the field. +!> - **26 bits** for the ID (`ID`), representing a potentially signed identifier (including `sid`). +!> - **4 bits** for the level type (`LEVTYPE`), specifying the type of level. +!> - **2 bits** for the representation type (`REPRES`), indicating how the data is represented. +!> - **2 bits** for the model identifier (`MODEL`), distinguishing between different models. +!> - **2 bits** for the precision (`PRECISION`), defining the precision of the data. +!> +!> The subroutine is thread-safe, ensuring that multiple threads can extract parameters +!> from bitmasks concurrently without data races or inconsistencies. +!> +!> @param [in] BITMASK The 64-bit bitmask (`INT64` type) from which the parameters will be extracted. +!> +!> @param [out] PARAMID The extracted parameter ID (`INT64` type) using 27 bits. +!> +!> @param [out] ID The extracted identifier (`INT64` type) using 26 bits, including the sign bit. +!> +!> @param [out] LEVTYPE The extracted level type (`INT64` type) using 4 bits. +!> +!> @param [out] REPRES The extracted representation type (`INT64` type) using 2 bits. +!> +!> @param [out] MODEL The extracted model identifier (`INT64` type) using 2 bits. +!> +!> @param [out] PRECISION The extracted precision (`INT64` type) using 2 bits. +!> +!> The subroutine interprets the bitmask according to the predefined structure and extracts +!> each of these components, returning them via the corresponding output parameters. +!> +!> @see CREATE_FIELD_HASH_ATM +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'EXTRACT_BITMASK_ATM' +__THREAD_SAFE__ SUBROUTINE EXTRACT_BITMASK_ATM( BITMASK, PARAMID, ID, LEVTYPE, REPRES, MODEL, PRECISION ) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + INTEGER(INT64), INTENT(IN) :: BITMASK + INTEGER(INT64), INTENT(OUT) :: PARAMID + INTEGER(INT64), INTENT(OUT) :: ID + INTEGER(INT64), INTENT(OUT) :: LEVTYPE + INTEGER(INT64), INTENT(OUT) :: REPRES + INTEGER(INT64), INTENT(OUT) :: MODEL + INTEGER(INT64), INTENT(OUT) :: PRECISION + + ! Local variables + INTEGER(INT64) :: SIGN + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Extract the values bit by bit + SIGN = (2*EXTRACT_FIELD(BITMASK, 0, 1)-1) + PARAMID = EXTRACT_FIELD(BITMASK, 1, 27) + ID = SIGN*EXTRACT_FIELD(BITMASK, 28, 26) + LEVTYPE = EXTRACT_FIELD(BITMASK, 54, 4) + REPRES = EXTRACT_FIELD(BITMASK, 58, 2) + MODEL = EXTRACT_FIELD(BITMASK, 60, 2) + PRECISION = EXTRACT_FIELD(BITMASK, 62, 2) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE EXTRACT_BITMASK_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Extracts individual field parameters from a 64-bit bitmask specific to WAM (Wave Model). +!> +!> This subroutine extracts the individual field parameters from a given 64-bit bitmask +!> (`BITMASK`) generated by the `CREATE_FIELD_HASH_WAM` function. The bitmask contains encoded +!> values for the `PARAMID`, `DIRECTION`, `FREQUENCY`, `LEVTYPE`, `REPRES`, `MODEL`, and +!> `PRECISION` parameters. The extraction is based on the following bit allocation within the bitmask: +!> +!> - **27 bits** for the parameter ID (`PARAMID`), which uniquely identifies the field. +!> - **13 bits** for the direction (`DIRECTION`), representing wave direction data. +!> - **13 bits** for the frequency (`FREQUENCY`), representing wave frequency data. +!> - **4 bits** for the level type (`LEVTYPE`), specifying the type of level. +!> - **2 bits** for the representation type (`REPRES`), indicating how the data is represented. +!> - **2 bits** for the model identifier (`MODEL`), distinguishing between different models. +!> - **2 bits** for the precision (`PRECISION`), defining the precision of the data. +!> +!> The subroutine is thread-safe, ensuring that multiple threads can extract parameters +!> from bitmasks concurrently without data races or inconsistencies. +!> +!> @param [in] BITMASK The 64-bit bitmask (`INT64` type) from which the parameters will be extracted. +!> +!> @param [out] PARAMID The extracted parameter ID (`INT64` type) using 27 bits. +!> +!> @param [out] DIRECTION The extracted direction (`INT64` type) using 13 bits. +!> +!> @param [out] FREQUENCY The extracted frequency (`INT64` type) using 13 bits. +!> +!> @param [out] LEVTYPE The extracted level type (`INT64` type) using 4 bits. +!> +!> @param [out] REPRES The extracted representation type (`INT64` type) using 2 bits. +!> +!> @param [out] MODEL The extracted model identifier (`INT64` type) using 2 bits. +!> +!> @param [out] PRECISION The extracted precision (`INT64` type) using 2 bits. +!> +!> The subroutine interprets the bitmask according to the predefined structure and extracts +!> each of these components, returning them via the corresponding output parameters. +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'EXTRACT_BITMASK_ATM' +__THREAD_SAFE__ SUBROUTINE EXTRACT_BITMASK_WAM( BITMASK, PARAMID, DIRECTION, FREQUENCY, LEVTYPE, REPRES, MODEL, PRECISION ) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + INTEGER(INT64), INTENT(IN) :: BITMASK + INTEGER(INT64), INTENT(OUT) :: PARAMID + INTEGER(INT64), INTENT(OUT) :: DIRECTION + INTEGER(INT64), INTENT(OUT) :: FREQUENCY + INTEGER(INT64), INTENT(OUT) :: LEVTYPE + INTEGER(INT64), INTENT(OUT) :: REPRES + INTEGER(INT64), INTENT(OUT) :: MODEL + INTEGER(INT64), INTENT(OUT) :: PRECISION + + ! Local variables + INTEGER(INT64) :: SIGN + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Extract the values bit by bit + SIGN = (2*EXTRACT_FIELD(BITMASK, 0, 1)-1) + PARAMID = EXTRACT_FIELD(BITMASK, 1, 27) + DIRECTION = SIGN*EXTRACT_FIELD(BITMASK, 28, 13) + FREQUENCY = SIGN*EXTRACT_FIELD(BITMASK, 41, 13) + LEVTYPE = EXTRACT_FIELD(BITMASK, 54, 4) + REPRES = EXTRACT_FIELD(BITMASK, 58, 2) + MODEL = EXTRACT_FIELD(BITMASK, 60, 2) + PRECISION = EXTRACT_FIELD(BITMASK, 62, 2) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE EXTRACT_BITMASK_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Extracts a specific field from a 64-bit bitmask based on bit position and length. +!> +!> This function extracts a contiguous field of bits from a given 64-bit bitmask (`BITMASK`). +!> The extraction is performed according to the specified bit position (`POS_`) and length (`LENGTH_`). +!> The extracted field is returned as an integer value. +!> +!> @param [in] BITMASK The 64-bit bitmask (`INT64` type) from which the field will be extracted. +!> +!> @param [in] POS_ The starting bit position (0-based) in the bitmask where the extraction begins. +!> +!> @param [in] LENGTH_ The number of bits to be extracted starting from `POS_`. +!> +!> @return FIELD The extracted field (`INTEGER` type) from the bitmask. The field value is +!> represented as an integer and is extracted based on the specified `POS_` and `LENGTH_`. +!> +!> The function is thread-safe, ensuring that multiple threads can perform field extraction concurrently +!> without data races or inconsistencies. +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'EXTRACT_FIELD' +__THREAD_SAFE__ FUNCTION EXTRACT_FIELD( BITMASK, POS_, LENGTH_ ) RESULT(FIELD) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + INTEGER(INT64), INTENT(IN) :: BITMASK + INTEGER, INTENT(IN) :: POS_ + INTEGER, INTENT(IN) :: LENGTH_ + + ! Function Result + INTEGER(INT64) :: FIELD + + ! Local variables + INTEGER(INT64) :: MASK + INTEGER(INT64) :: POS + INTEGER(INT64) :: LENGTH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( POS_.LT.0, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( LENGTH_.LE.0, 2 ) + PP_DEBUG_CRITICAL_COND_THROW( LENGTH_+LENGTH.GT.63, 3 ) + + POS = INT(POS_,KIND=INT64) + LENGTH = INT(LENGTH_,KIND=INT64) + MASK = ISHFT(2_INT64**LENGTH - 1, POS) + FIELD = IAND(BITMASK, MASK) + FIELD = ISHFT(FIELD, -POS) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (on success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Pos is supposed to be greater or equal to 0' ) + + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Length is supposed to be greater than 0' ) + + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Pos+Length is supposed to be lower than 64 (legnth of the bitmask)' ) + + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END FUNCTION EXTRACT_FIELD +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Allocate and add a new node to a doubly linked list. +!> +!> This subroutine allocates a new node and adds it to the specified doubly linked list (`EI_LIST`). +!> The node's payload consists of a hash value (`HASH`) and an array of encoding information +!> with length `N`. After the node is successfully added to the list, a pointer to the payload +!> is returned via the `PEI` argument. This allows for further manipulation of the node's data +!> after it has been inserted into the list. +!> +!> @param [inout] EI_LIST The doubly linked list (`EI_LIST_T` type) to which the new node +!> will be added. This list is passed by reference and will be modified +!> to include the newly allocated node. +!> +!> @param [in] HASH The hash value (`INT64` type) that forms part of the payload for the +!> new node. This value is used to identify or categorize the encoding +!> information within the node. +!> +!> @param [in] N The length (`JPIB_K` type) of the encoding information array that will +!> be stored in the node's payload. This array is allocated as part of the +!> node creation process. +!> +!> @param [out] PEI(N) A pointer (`ENCODING_INFO_T` type) to the newly created payload +!> within the node. This pointer allows the caller to directly access +!> and manipulate the encoding information after the node has been added +!> to the list. +!> +!> @note This operation is not thread-safe since the list is supposed to be thread private +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_NEW' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_NEW( EI_LIST, HASH, N, PEI ) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: EI_LIST + INTEGER(KIND=INT64), INTENT(IN) :: HASH + INTEGER(KIND=JPIB_K), INTENT(IN) :: N + TYPE(ENCODING_INFO_T), POINTER, DIMENSION(:), INTENT(OUT) :: PEI + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialisation + NULLIFY( PEI ) + + ! Allocation + IF ( .NOT. ASSOCIATED(EI_LIST%HEAD_) ) THEN + ALLOCATE( EI_LIST%HEAD_ ) + EI_LIST%TAIL_ => EI_LIST%HEAD_ + ALLOCATE( EI_LIST%HEAD_%EIC_ ) + ALLOCATE( EI_LIST%HEAD_%EIC_%EI_(N) ) + PEI => EI_LIST%TAIL_%EIC_%EI_ + EI_LIST%TAIL_%HASH = HASH + EI_LIST%SIZE = 1 + NULLIFY(EI_LIST%HEAD_%PREV_) + NULLIFY(EI_LIST%HEAD_%NEXT_) + ELSE + ALLOCATE( EI_LIST%TAIL_%NEXT_ ) + EI_LIST%TAIL_%NEXT_%PREV_ => EI_LIST%TAIL_ + EI_LIST%TAIL_ => EI_LIST%TAIL_%NEXT_ + NULLIFY(EI_LIST%TAIL_%NEXT_) + ALLOCATE( EI_LIST%TAIL_%EIC_ ) + ALLOCATE( EI_LIST%TAIL_%EIC_%EI_(N) ) + EI_LIST%TAIL_%HASH = HASH + PEI => EI_LIST%TAIL_%EIC_%EI_ + EI_LIST%SIZE = EI_LIST%SIZE + 1 + ENDIF + + ! Allocate the payload + ALLOCATE( PEI%GRIB_INFO(N) ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END SUBROUTINE ENCODING_INFO_NEW +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Remove a node from a doubly linked list. +!> +!> This subroutine is responsible for safely removing a node, referenced by `CURR`, from a +!> doubly linked list (`EI_LIST`). The list is updated to maintain its integrity after the +!> node's removal, ensuring that both the previous and next nodes in the list are correctly +!> linked. +!> +!> @param [inout] EI_LIST The doubly linked list (`EI_LIST_T` type) from which the node +!> will be removed. The list is passed by reference and will be +!> modified to reflect the removal of the node. +!> +!> @param [inout] CURR The node (`EI_LIST_NODE_T` type) to be removed from the list. +!> This pointer is passed by reference and will be invalidated upon +!> successful removal. The memory associated with `CURR` may need to +!> be deallocated separately, depending on the implementation. +!> +!> +!> @note This operation is not thread-safe since the list is supposed to be thread private +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_DELETE' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_DELETE( EI_LIST, CURR ) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: EI_LIST + TYPE(EI_LIST_NODE_T), POINTER, INTENT(INOUT) :: CURR + + ! Local variables + TYPE(EI_LIST_NODE_T), POINTER :: TMP + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! ASSERT( EI_LIST%SIZE .GT. 0 ) + + IF ( ASSOCIATED(CURR%PREV_) ) THEN + CURR%PREV_%NEXT_ => CURR%NEXT_ + ENDIF + + IF ( ASSOCIATED(CURR%NEXT_) ) THEN + CURR%NEXT_%PREV_ => CURR%PREV_ + ENDIF + + IF ( ASSOCIATED(CURR,EI_LIST%HEAD_) ) THEN + EI_LIST%HEAD_ => CURR%NEXT_ + ENDIF + IF ( ASSOCIATED(CURR,EI_LIST%TAIL_) ) THEN + EI_LIST%TAIL_ => CURR%PREV_ + ENDIF + + EI_LIST%SIZE = EI_LIST%SIZE - 1 + + IF ( EI_LIST%SIZE .EQ. 0 ) THEN + NULLIFY( EI_LIST%HEAD_ ) + NULLIFY( EI_LIST%TAIL_ ) + ENDIF + + DEALLOCATE(CURR) + NULLIFY(CURR) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END SUBROUTINE ENCODING_INFO_DELETE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Commit local thread-specific nodes to a shared map. +!> +!> This subroutine is used to synchronize and commit nodes stored in a thread-local list (`EI_LIST`) +!> to a shared map. The thread-local lists are used to accumulate nodes when the code is busy, +!> minimizing the need for critical sections and reducing contention among threads. +!> When the code is less busy, this subroutine is called to push all nodes from the local lists +!> into the shared map in a thread-safe manner. +!> +!> This routine is used in case of the ATM encoding info. +!> +!> @param [inout] EI_LIST The thread-local list (`EI_LIST_T` type) containing the nodes +!> to be committed to the shared map. This list is passed by reference +!> and will be emptied upon successful completion of the commit operation. +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_COMMIT_ATM' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_COMMIT_ATM( EI_LIST ) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: MAP_MOD, ONLY: MAP_INSERT + USE :: MAP_MOD, ONLY: VALUE_DESTRUCTOR_IF + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: EI_LIST + + ! Local variables + INTEGER(KIND=INT64) :: KEY + CLASS(*), POINTER :: VALUE + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER :: DESTRUCTOR + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Push local encoding info to the shared map + DESTRUCTOR => DEALLOCATE_ENCODING_INFO + CURR => EI_LIST%HEAD_ + DO WHILE( ASSOCIATED(CURR) ) + KEY = CURR%EI_%HASH + VALUE => CURR%EI_ +!$OMP CRITICAL (ENCODING_INFO_COMMIT_ATM) + CALL MAP_INSERT( OMP_SHARED_ENCODING_INFO_ATM, KEY, VALUE, VALUE_DESTRUCTOR=DESTRUCTOR ) +!$OMP END CRITICAL (ENCODING_INFO_COMMIT_ATM) + KEY=0_INT64 + NULLIFY(VALUE) + NULLIFY(CURR%EI_) + CALL ENCODING_INFO_DELETE( EI_LIST, CURR ) + CURR => CURR%NEXT_ + ENDDO + + ! Reset the entry list + NULLIFY( EI_LIST%HEAD_ ) + NULLIFY( EI_LIST%TAIL_ ) + EI_LIST%SIZE = 0 + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END SUBROUTINE ENCODING_INFO_COMMIT_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Commit local thread-specific nodes to a shared map. +!> +!> This subroutine is used to synchronize and commit nodes stored in a thread-local list (`EI_LIST`) +!> to a shared map. The thread-local lists are used to accumulate nodes when the code is busy, +!> minimizing the need for critical sections and reducing contention among threads. +!> When the code is less busy, this subroutine is called to push all nodes from the local lists +!> into the shared map in a thread-safe manner. +!> +!> This routine is used in case of the WAM encoding info. +!> +!> @param [inout] EI_LIST The thread-local list (`EI_LIST_T` type) containing the nodes +!> to be committed to the shared map. This list is passed by reference +!> and will be emptied upon successful completion of the commit operation. +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_COMMIT_WAM' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_COMMIT_WAM( EI_LIST ) + + ! Symbolds imported from intrinsic modules + USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64 + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: MAP_MOD, ONLY: MAP_INSERT + USE :: MAP_MOD, ONLY: VALUE_DESTRUCTOR_IF + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: EI_LIST + + ! Local variables + INTEGER(KIND=INT64) :: KEY + CLASS(*), POINTER :: VALUE + PROCEDURE(VALUE_DESTRUCTOR_IF), POINTER :: DESTRUCTOR + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Push local encoding info to the shared map + DESTRUCTOR => DEALLOCATE_ENCODING_INFO + CURR => EI_LIST%HEAD_ + DO WHILE( ASSOCIATED(CURR) ) + KEY = CURR%EI_%HASH + VALUE => CURR%EI_ +!$OMP CRITICAL (ENCODING_INFO_COMMIT_WAM) + CALL MAP_INSERT( OMP_SHARED_ENCODING_INFO_WAM, KEY, VALUE, VALUE_DESTRUCTOR=DESTRUCTOR ) +!$OMP END CRITICAL (ENCODING_INFO_COMMIT_WAM) + KEY=0_INT64 + NULLIFY(VALUE) + NULLIFY(CURR%EI_) + CALL ENCODING_INFO_DELETE( EI_LIST, CURR ) + CURR => CURR%NEXT_ + ENDDO + + ! Reset the entry list + NULLIFY( EI_LIST%HEAD_ ) + NULLIFY( EI_LIST%TAIL_ ) + EI_LIST%SIZE = 0 + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END SUBROUTINE ENCODING_INFO_COMMIT_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Deallocate an `encoding_info_collection_t` object. +!> +!> This subroutine is intended to be called as a destructor for `encoding_info_collection_t` +!> objects when they are removed from a map or when the map itself is deallocated. +!> It ensures that the resources associated with the object are properly freed, preventing memory leaks. +!> +!> @param [inout] VALUE The opaque value representing the `encoding_info_collection_t` object +!> that needs to be deallocated. The value is passed by reference and will +!> be invalidated upon successful deallocation. +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_COMMIT_WAM' +SUBROUTINE DEALLOCATE_ENCODING_INFO( VALUE ) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(*), POINTER, INTENT(INOUT) :: VALUE + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + IF ( ASSOCIATED(VALUE) ) THEN + SELECT TYPE( A => VALUE) + TYPE IS (ENCODING_INFO_COLLECTION_T) + IF ( ASSOCIATED(A%EI_) ) THEN + DO I = 1, SIZE(A%EI_) + CALL A%EI_(I)%TIME_HISTORY%FREE() + ENDDO + DEALLOCATE(A%EI_) + ENDIF + DEALLOCATE(A) + CLASS DEFAULT + PP_DEBUG_CRITICAL_THROW( 1 ) + END SELECT + ENDIF + NULLIFY(VALUE) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Wrong type of the value. Unable to deallocate') + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE DEALLOCATE_ENCODING_INFO +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Deallocates all nodes in a linked list of encoding information. +!> +!> This subroutine is responsible for freeing all memory associated with a linked list +!> of encoding information nodes. It traverses the list, deallocates each node, and +!> ensures that the list is properly cleared. +!> +!> @param [inout] EI_LIST The linked list of encoding information nodes to be deallocated. +!> Upon completion, this list will be empty and all associated memory +!> will have been freed. +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_FREE_LIST' +__THREAD_SAFE__ SUBROUTINE ENCODING_INFO_FREE_LIST( EI_LIST ) + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(EI_LIST_T), INTENT(INOUT) :: EI_LIST + + ! Local variables + TYPE(EI_LIST_NODE_T), POINTER :: CURR + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + IF ( ASSOCIATED(EI_LIST%HEAD_) ) THEN + + DO + + IF ( .NOT.ASSOCIATED(EI_LIST%TAIL_) ) THEN + EXIT + ENDIF + + CURR => EI_LIST%TAIL_ + EI_LIST%TAIL_ => EI_LIST%TAIL_%PREV_ + IF ( ASSOCIATED(EI_LIST%TAIL_) ) THEN + NULLIFY(EI_LIST%TAIL_%NEXT_) + ENDIF + + ! Deallocate the payload + CALL ENCODING_INFO_DELETE( EI_LIST, CURR ) + + ! Deallocate the node itself + DEALLOCATE( CURR ) + NULLIFY(CURR) + + EI_LIST%SIZE = EI_LIST%SIZE - 1 + + ENDDO + + NULLIFY(EI_LIST%TAIL_) + NULLIFY(EI_LIST%HEAD_) + EI_LIST%SIZE = 0 + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + +END SUBROUTINE ENCODING_INFO_FREE_ALL +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Frees all allocated memory associated with encoding information at the end of the simulation. +!> +!> This subroutine is responsible for releasing all resources and deallocating memory used for managing +!> encoding information. It should be called at the end of the simulation or data processing workflow to +!> ensure that no memory leaks occur and all dynamically allocated structures are properly freed. +!> +!> @see SUENCODING_INFO +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_FREE' +SUBROUTINE ENCODING_INFO_FREE( ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: MAP_MOD, ONLY: MAP_FREE + USE :: YAML_RULES_MOD, ONLY: FREE_RULES + USE :: YAML_TIME_ASSUMPTIONS_MOD, ONLY: FREE_TIME_ASSUMPTION_RULES + ! USE :: TIME_ASSUMPTIONS_MOD, ONLY: TIME_ASSUMPTIONS_FREE + USE :: PACKAGING_ASSUMPTIONS_MOD, ONLY: PACKAGING_ASSUMPTIONS_FREE + USE :: LEVEL_ASSUMPTIONS_MOD, ONLY: LEVEL_ASSUMPTIONS_FREE + USE :: GENERAL_ASSUMPTIONS_MOD, ONLY: GENERAL_ASSUMPTIONS_FREE + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Closing encoding tables + CALL TIME_ENCODING_TABLE_FOOTER() + CALL PACKING_ENCODING_TABLE_FOOTER() + + ! Free the maps that contain the encoding info + CALL MAP_FREE( OMP_SHARED_ENCODING_INFO_ATM ) + CALL MAP_FREE( OMP_SHARED_ENCODING_INFO_WAM ) + + ! Free assumptions configuration + CALL FREE_RULES() + CALL TIME_ASSUMPTIONS_FREE() + CALL LEVEL_ASSUMPTIONS_FREE() + CALL PACKAGING_ASSUMPTIONS_FREE() + CALL GENERAL_ASSUMPTIONS_FREE() + + ! Exit point on error + RETURN + +END SUBROUTINE ENCODING_INFO_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE ENCODING_INFO_MANAGER_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/encoding_info_mod.F90 b/src/ecom/grib_info/encoding_info_mod.F90 index 1624717c1..6ad854ade 100644 --- a/src/ecom/grib_info/encoding_info_mod.F90 +++ b/src/ecom/grib_info/encoding_info_mod.F90 @@ -405,6 +405,204 @@ END SUBROUTINE ENCODING_INFO_ACCESS_OR_CREATE #undef PP_PROCEDURE_TYPE +!> +!> @brief function used to get the grib informations given the grib +!> index +!> +!> @param [in] grib index of the field +!> +!> @result pointer to the grib informations +!> +!> @see SUGRIB_INFO +!> @see ENCODING_INFO_FREE +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'ENCODING_INFO_ACCESS_OR_CREATE_02' +SUBROUTINE ENCODING_INFO_ACCESS_OR_CREATE_02( MAP, HASH, MODEL_PARAMS, EI ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: OM_CORE_MOD, ONLY: MODEL_PAR_T + USE :: OM_CORE_MOD, ONLY: LOOKUP_TABLE + USE :: OM_CORE_MOD, ONLY: OM_SET_CURRENT_GRIB_INFO + USE :: OM_CORE_MOD, ONLY: CAPACITY + USE :: OM_CORE_MOD, ONLY: GRIB_INFO_T + USE :: MAP_MOD, ONLY: MAP_GET + USE :: MAP_MOD, ONLY: MAP_INSERT + USE :: MAP_MOD, ONLY: KEY_T + USE :: YAML_RULES_MOD, ONLY: MATCH_RULES + USE :: YAML_RULES_MOD, ONLY: DEFINITIONS_T + USE :: MSG_UTILS_MOD, ONLY: IPREFIX2ILEVTYPE + USE :: YAML_TIME_ASSUMPTIONS_MOD, ONLY: MATCH_ASSUMPTIONS_RULES + USE :: YAML_TIME_ASSUMPTIONS_MOD, ONLY: TIME_ASSUMPTIONS_T + USE :: YAML_TIME_ASSUMPTIONS_MOD, ONLY: LEVEL_ASSUMPTIONS_T + USE :: GENERAL_ASSUMPTIONS_MOD, ONLY: IS_ENSAMBLE_SIMULATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAP_T), INTENT(INOUT) :: MAP + INTEGER(KIND=INT64), INTENT(IN) :: HASH + TYPE(MODEL_PAR_T), INTENT(IN) :: MODEL_PARAMS + TYPE(ENCODING_INFO_T), POINTER, INTENT(OUT) :: EI + + ! Local variables + TYPE(TIME_ASSUMPTIONS_T) :: TIME_ASSUMPTIONS + TYPE(LEVEL_ASSUMPTIONS_T) :: LEVEL_ASSUMPTIONS + TYPE(GRIB_INFO_T), POINTER :: GRIB_INFO + INTEGER(KIND=JPIB_K) :: IDX + INTEGER(KIND=JPIB_K) :: LEV_TYPE + TYPE(DEFINITIONS_T), DIMENSION(:), ALLOCATABLE :: DEFINITIONS + TYPE(KEY_T) :: KEY + CLASS(*), POINTER :: VALUE + LOGICAL :: EX + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Get encoding info + EX = MAP_GET( MAP, HASH, VALUE ) + + IF ( EX ) THEN + + SELECT TYPE ( A => VALUE ) + + CLASS IS ( ENCODING_INFO_T ) + + ! Set output variables + EI => A + + CLASS DEFAULT + + ! Error handling + PP_DEBUG_DEVELOP_THROW( 4 ) + + END SELECT + + ELSE + + ! Allocate new encoding info + EI => ENCODING_INFO_NEW( ) + + IF ( ALLOCATED(DEFINITIONS) ) THEN + + ! Extract definitions from encding rules + CALL MATCH_RULES( PARAM_ID, LEV_TYPE, REPRES, LEVEL, DEFINITIONS ) + + ALLOCATE(EI%GRIB_INFO(SIZE(DEFINITIONS))) + + ! Get all the definitions we need to encode + DO I = 1, SIZE(DEFINITIONS) + + ! Current grib info + GRIB_INFO => EI%GRIB_INFO(I) + + ! Time assumptions for the specified field + CALL MATCH_ASSUMPTIONS_RULES( PARAM_ID, LEV_TYPE, REPRES, LEVEL, IS_ENSAMBLE_SIMULATION( MODEL_PARAMS ), TIME_ASSUMPTIONS, LEVEL_ASSUMPTIONS ) + + ! Fill grib info + GRIB_INFO%PRODUCT_DEFINITION_TEMPLATE_NUMBER_ = TIME_ASSUMPTIONS%PRODUCT_DEFINITION_TEMPLATE_NUMBER + GRIB_INFO%TYPE_OF_STATISTICAL_PROCESS_ = TIME_ASSUMPTIONS%TYPE_OF_STATISTICAL_PROCESSING + GRIB_INFO%TYPE_OF_TIME_RANGE_ = TIME_ASSUMPTIONS%TYPE_OF_TIME_RANGE + GRIB_INFO%OVERALL_LENGTH_OF_TIME_RANGE_ = TIME_ASSUMPTIONS%LENGTH_OF_TIME_RANGE_IN_SECONDS + GRIB_INFO%IS_STEP0_VALID_ = TIME_ASSUMPTIONS%EMIT_STEP_ZERO + + IF ( LEVEL_ASSUMPTIONS%CUSTOM_LEVELS_ENCODING ) THEN + GRIB_INFO%CUSTOM_LEVELS_ENCODING = .TRUE. + GRIB_INFO%TYPE_OF_FIRST_FIXED_SURFACE = LEVEL_ASSUMPTIONS%TYPE_OF_FIRST_FIXED_SURFACE + GRIB_INFO%SCALE_FACTOR_OF_FIRST_FIXED_SURFACE = LEVEL_ASSUMPTIONS%SCALE_FACTOR_OF_FIRST_FIXED_SURFACE + GRIB_INFO%SCALE_VALUE_OF_FIRST_FIXED_SURFACE = LEVEL_ASSUMPTIONS%SCALE_VALUE_OF_FIRST_FIXED_SURFACE + GRIB_INFO%TYPE_OF_SECOND_FIXED_SURFACE = LEVEL_ASSUMPTIONS%TYPE_OF_SECOND_FIXED_SURFACE + GRIB_INFO%SCALE_FACTOR_OF_SECOND_FIXED_SURFACE = LEVEL_ASSUMPTIONS%SCALE_FACTOR_OF_SECOND_FIXED_SURFACE + GRIB_INFO%SCALE_VALUE_OF_SECOND_FIXED_SURFACE = LEVEL_ASSUMPTIONS%SCALE_VALUE_OF_SECOND_FIXED_SURFACE + ENDIF + + ! Initialize and create grib info (Grib info is created using the definitions extracted from the rules and assumptions) + CALL INITIALIZE_GRIB_INFO( MODEL_PARAMS, PARAM_ID, PREFIX, LEV_TYPE, & +& REPRES, LEVEL, DEFINITIONS(I), EI%GRIB_INFO ) + + CALL PACKING_ENCODING_TABLE_ENTRY( PARAM_ID, REPRES, LEV_TYPE, LEVEL, & +& PREFIX, GRIB_INFO%BITS_PER_VALUE, GRIB_INFO%PACKING_TYPE ) + + CALL TIME_ENCODING_TABLE_ENTRY( PARAM_ID, REPRES, LEV_TYPE, LEVEL, PREFIX, EI%GRIB_INFO ) + + END DO + + ! Initialize and update time history + CALL EI%TIME_HISTORY%INIT( CAPACITY ) + + ! Match rules and assumptions + VALUE => EI + + CALL MAP_INSERT( ENCODING_INFO(IDX,LEV_TYPE,REPRES), KEY, VALUE ) + + ENDIF + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success + RETURN + + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=128) :: CGRIB_ID + + ! HAndle different errors + SELECT CASE(ERRIDX) + CASE (1) + CGRIB_ID = REPEAT( ' ', 128 ) + WRITE(CGRIB_ID,'(I12)') PARAM_ID + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Grib_ID out of bounds. Greater than upper bound: '//TRIM(ADJUSTL(CGRIB_ID)) ) + CASE (2) + CGRIB_ID = REPEAT( ' ', 128 ) + WRITE(CGRIB_ID,'(I12)') PARAM_ID + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Grib_ID out of bounds. Lower than lower bound: '//TRIM(ADJUSTL(CGRIB_ID)) ) + CASE (3) + CGRIB_ID = REPEAT( ' ', 128 ) + WRITE(CGRIB_ID,'(I12)') PARAM_ID + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Grib info not associated to the grib_ID: '//TRIM(ADJUSTL(CGRIB_ID)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE ENCODING_INFO_ACCESS_OR_CREATE_02 +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + #define PP_PROCEDURE_TYPE 'SUBROUTINE' #define PP_PROCEDURE_NAME 'INITIALIZE_GRIB_INFO' SUBROUTINE INITIALIZE_GRIB_INFO( MODEL_PARAMS, PARAM_ID, PREFIX, LEV_TYPE, REPRES, LEVEL, DEFINITIONS, GRIB_INFO ) diff --git a/src/ecom/grib_info/general_rules_mod.F90 b/src/ecom/grib_info/general_rules_mod.F90 new file mode 100644 index 000000000..b6145d63b --- /dev/null +++ b/src/ecom/grib_info/general_rules_mod.F90 @@ -0,0 +1,2751 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + +#define __THREAD_SAFE__ RECURSIVE + +#define PP_FILE_NAME 'general_rules_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GENERAL_RULES_MOD' +MODULE GENERAL_RULES_MOD + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_FILTERS_UTILS_MOD, ONLY: FILTER_RULES_T + USE :: YAML_FILTERS_UTILS_MOD, ONLY: TAG_LEN + +IMPLICIT NONE + +! Default visibility of the module +PRIVATE + + +! Parameters +LOGICAL, PARAMETER :: DEFAULT_USEPARAMIDECMF = .FALSE. +LOGICAL, PARAMETER :: DEFAULT_DIRECT_TO_FDB = .FALSE. + +INTEGER(KIND=JPIM_K), PARAMETER :: UNDEF_PARAM_E = -9999_JPIM_K +INTEGER(KIND=JPIM_K), PARAMETER :: BITS_PER_VALUE_MIN = 1_JPIB_K +INTEGER(KIND=JPIM_K), PARAMETER :: BITS_PER_VALUE_MAX = 64_JPIB_K +INTEGER(KIND=JPIM_K), PARAMETER :: BITS_PER_VALUE_DEFAULT_TABLE = -10_JPIB_K +INTEGER(KIND=JPIM_K), PARAMETER :: BITS_PER_VALUE_COMPRESSED_TABLE = -20_JPIB_K + + +! Data types +TYPE :: MAPPING_RULE_T + + INTEGER(KIND=JPIB_K) :: FROM_PARAM_ID + INTEGER(KIND=JPIB_K) :: FROM_LEVEL + INTEGER(KIND=JPIB_K) :: FROM_DIRECTION + INTEGER(KIND=JPIB_K) :: FROM_FREQUENCY + INTEGER(KIND=JPIB_K) :: FROM_LEVTYPE + + INTEGER(KIND=JPIB_K) :: TO_PARAM_ID + INTEGER(KIND=JPIB_K) :: TO_LEVEL + INTEGER(KIND=JPIB_K) :: TO_DIRECTION + INTEGER(KIND=JPIB_K) :: TO_FREQUENCY + INTEGER(KIND=JPIB_K) :: TO_LEVTYPE + REAL(KIND_JPRD_K) :: SCALE_FACTOR +END TYPE + +TYPE :: GRIB_STRUCTURE_T + INTEGER(KIND=JPIB_K) :: LOCAL_DEFINITION_TEMPLATE_NUMBER + INTEGER(KIND=JPIB_K) :: GRID_DEFINITION_TEMPLATE_NUMBER + INTEGER(KIND=JPIB_K) :: PRODUCT_DEFINITION_TEMPLATE_NUMBER + INTEGER(KIND=JPIB_K) :: DATA_DEFINITION_TEMPLATE_NUMBER +END TYPE + + +TYPE :: MAPPING_RULES_T + TYPE(MAPPING_RULE_T), DIMENSION(:), ALLOCATABLE :: MAPS +END TYPE + +TYPE :: ENCODING_RULES_T + LOGICAL :: USE_PARAMID_ECMF = DEFAULT_USEPARAMIDECMF + INTEGER(KIND=JPIB_K) :: EDITION = UNDEF_PARAM_E +END TYPE + +TYPE :: PACKING_RULES_T + INTEGER(KIND=JPIB_K) :: PACKING_TYPE = UNDEF_PARAM_E + INTEGER(KIND=JPIB_K) :: BITS_PER_VALUE = UNDEF_PARAM_E +END TYPE + +TYPE :: SINK_RULES_T + LOGICAL :: DIRECT_TO_FDB = DEFAULT_DIRECT_TO_FDB +END TYPE + + +TYPE :: GENERAL_RULE_T + CHARACTER(LEN=128) :: NAME + CHARACTER(LEN=TAG_LEN) :: TAG + TYPE(FILTER_RULES_T) :: FILTER + TYPE(MAPPING_RULES_T) :: MAPPING + TYPE(ENCODING_RULES_T) :: ENCODING + TYPE(PACKING_RULES_T) :: PACKING + TYPE(SINK_RULES_T) :: SINK +END TYPE + + +TYPE :: GENERAL_RULES_T + TYPE(GENERAL_RULE_T), DIMENSION(:), ALLOCATABLE :: DEFAULT_RULES + TYPE(GENERAL_RULE_T), DIMENSION(:), ALLOCATABLE :: SPECIAL_RULES +END TYPE + + +!> Whitelist of public variables (datatypes) +PUBLIC :: GENERAL_RULES_T +PUBLIC :: GENERAL_RULE_T + +!> Whitelist of public variables (procedures) +PUBLIC :: SUGENERAL_RULES +PUBLIC :: FREE_RULES + +CONTAINS + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_COUNT_ATM' +__THREAD_SAFE__ SUBROUTINE MATCH_COUNT_ATM( IN_RULES, & +& IN_PARAMID, N_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, & +& COUNT_RULES_DEFAULT, COUNT_RULES_SPECIAL ) + +IMPLICIT NONE + + ! Dummy arguments + TYPE(GENERAL_RULES_T), INTENT(IN) :: IN_RULES + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_LEVTYPE + CHARACTER(LEN=TAG_LEN), INTENT(IN) :: IN_TAG + LOGICAL, INTENT(IN) :: IN_ISANSAMBLE + LOGICAL, INTENT(IN) :: IN_ISCHEMICAL + INTEGER(KIND=JPIM_K), INTENT(OUT) :: COUNT_RULES_DEFAULT + INTEGER(KIND=JPIM_K), INTENT(OUT) :: COUNT_RULES_SPECIAL + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: CNT + LOGICAL :: MATCH + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Special rules + COUNT_RULES_SPECIAL = 0 + IF ( ALLOCATED(IN_RULES%SPECIAL_RULES) ) THEN + DO I = 1, SIZE(IN_RULES%SPECIAL_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%SPECIAL_RULES(I)%FILTER, & +& IN_PARAMID, IN_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + COUNT_RULES_SPECIAL = COUNT_RULES_SPECIAL + 1 + ENDIF + ENDDO + ENDIF + + ! Default rules + COUNT_RULES_DEFAULT = 0 + IF ( ALLOCATED(IN_RULES%DEFAULT_RULES) ) THEN + DO I = 1, SIZE(IN_RULES%DEFAULT_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%DEFAULT_RULES(I)%FILTER, & +& IN_PARAMID, IN_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + COUNT_RULES_DEFAULT = COUNT_RULES_DEFAULT + 1 + ENDIF + ENDDO + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE MATCH_COUNT_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_ATM' +__THREAD_SAFE__ SUBROUTINE MATCH_ATM( IN_RULES, & +& IN_PARAMID, N_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, & +& OUT_RULES_DEFAULT, OUT_RULES_SPECIAL ) + +IMPLICIT NONE + + ! Dummy arguments + TYPE(GENERAL_RULES_T), INTENT(IN) :: IN_RULES + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_LEVTYPE + CHARACTER(LEN=TAG_LEN), INTENT(IN) :: IN_TAG + LOGICAL, INTENT(IN) :: IN_ISANSAMBLE + LOGICAL, INTENT(IN) :: IN_ISCHEMICAL + INTEGER(KIND=JPIM_K), DIMENSION(:), INTENT(OUT) :: OUT_RULES_DEFAULT + INTEGER(KIND=JPIM_K), DIMENSION(:), INTENT(OUT) :: OUT_RULES_SPECIAL + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: N + INTEGER(KIND=JPIB_K) :: M + INTEGER(KIND=JPIB_K) :: CNT + LOGICAL :: MATCH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Local variables + N = SIZE(OUT_RULES_DEFAULT) + M = SIZE(OUT_RULES_SPECIAL) + + ! Special rules + IF ( M .GT. 0 ) THEN + CNT = 0 + DO I = 1, SIZE(IN_RULES%SPECIAL_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%SPECIAL_RULES(I)%FILTER, & +& IN_PARAMID, IN_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + CNT = CNT + 1 + PP_DEBUG_CRITICAL_COND_THROW( CNT .GT. M, 1 ) + OUT_RULES_SPECIAL(CNT) = I + ENDIF + ENDDO + + ENDIF + + ! Default rules + IF ( N .GT. 0 ) THEN + CNT = 0 + DO I = 1, SIZE(IN_RULES%DEFAULT_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%DEFAULT_RULES(I)%FILTER, & +& IN_PARAMID, IN_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + CNT = CNT + 1 + PP_DEBUG_CRITICAL_COND_THROW( CNT .GT. M, 2 ) + OUT_RULES_DEFAULT(CNT) = I + ENDIF + ENDDO + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error out of bounds OUT_RULES_SPECIAL' ) + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error out of bounds OUT_RULES_DEFAULT' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE MATCH_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_WAM' +__THREAD_SAFE__ SUBROUTINE MATCH_WAM( IN_RULES, & +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, & +& OUT_RULES_DEFAULT, OUT_RULES_SPECIAL ) + +IMPLICIT NONE + + ! Dummy arguments + TYPE(GENERAL_RULES_T), INTENT(IN) :: IN_RULES + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_DIRECTION + INTEGER(KIND=JPIB), INTENT(IN) :: IN_FREQUENCY + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_REPRES + INTEGER(KIND=JPIB_K), INTENT(IN) :: IN_LEVTYPE + CHARACTER(LEN=TAG_LEN), INTENT(IN) :: IN_TAG + LOGICAL, INTENT(IN) :: IN_ISANSAMBLE + LOGICAL, INTENT(IN) :: IN_ISCHEMICAL + INTEGER(KIND=JPIM_K), ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: OUT_RULES_DEFAULT + INTEGER(KIND=JPIM_K), ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: OUT_RULES_SPECIAL + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: CNT + LOGICAL :: MATCH + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Special rules + CNT = 0 + DO I = 1, SIZE(IN_RULES%SPECIAL_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%SPECIAL_RULES(I)%FILTER, & +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + CNT = CNT + 1 + ENDIF + ENDDO + + IF ( CNT .GT. 0 ) THEN + ALLOCATE( OUT_RULES_SPECIAL(CNT), STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 1 ) + CNT = 0 + DO I = 1, SIZE(IN_RULES%SPECIAL_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%SPECIAL_RULES(I)%FILTER, & +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + CNT = CNT + 1 + OUT_RULES_SPECIAL(CNT) = I + ! CALL RULE_COPY( IN_RULES%SPECIAL_RULES(I), OUT_RULES(CNT) ) + ENDIF + ENDDO + + ENDIF + + ! Default rules + CNT = 0 + DO I = 1, SIZE(IN_RULES%DEFAULT_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%DEFAULT_RULES(I)%FILTER, & +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + CNT = CNT + 1 + ENDIF + ENDDO + + IF ( CNT .GT. 0 ) THEN + ALLOCATE( OUT_RULES_DEFAULT(CNT), STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 2 ) + CNT = 0 + DO I = 1, SIZE(IN_RULES%DEFAULT_RULES) + CALL MATCH_FILTER_ATM( IN_RULES%DEFAULT_RULES(I)%FILTER, & +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISANSAMBLE, IN_ISCHEMICAL, MATCH ) + IF ( MATCH ) THEN + CNT = CNT + 1 + OUT_RULES_DEFAULT(CNT) = I + ! CALL RULE_COPY( IN_RULES%DEFAULT_RULES(I), OUT_RULES(CNT) ) + ENDIF + ENDDO + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating OUT_RULES_SPECIAL' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating OUT_RULES_SPECIAL: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (2) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating OUT_RULES_DEFAULT' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating OUT_RULES_DEFAULT: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE MATCH_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'SUGENERAL_RULES' +__THREAD_SAFE__ SUBROUTINE SUGENERAL_RULES( CFG, RULES, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATIONS_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATION + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATIONS + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATIONS + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(GENERAL_RULES_T), INTENT(OUT) :: RULES + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATION_T) :: ENCODING_RULES_CFG + TYPE(YAML_CONFIGURATIONS_T) :: DEFAULT_RULES_CFG + TYPE(YAML_CONFIGURATIONS_T) :: SPECIAL_RULES_CFG + LOGICAL :: CFG_HAS_ENCODING_RULES + LOGICAL :: CFG_HAS_DEFAULT_RULES + LOGICAL :: CFG_HAS_SPECIAL_RULES + + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Confiuguration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'encoding-rules', CFG_HAS_ENCODING_RULES, VERBOSE ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CFG_HAS_ENCODING_RULES, 0 ) + + ! Reading the encoding rules + IF ( CFG_HAS_ENCODING_RULES ) THEN + + ! Read the encoding rules + CALL YAML_GET_SUBCONFIGURATION( CFG, 'encoding-rules', ENCODING_RULES_CFG, VERBOSE ) + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( ENCODING_RULES_CFG, 'default-rules', CFG_HAS_DEFAULT_RULES, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( ENCODING_RULES_CFG, 'special-rules', CFG_HAS_SPECIAL_RULES, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CFG_HAS_DEFAULT_RULES .AND. .NOT.CFG_HAS_SPECIAL_RULES, 1 ) + + ! Read the default encoding rules (an array of rules that is supposed to be general) + IF ( CFG_HAS_DEFAULT_RULES ) THEN + + ! Read default rules from configuration + CALL YAML_GET_SUBCONFIGURATIONS( ENCODING_RULES_CFG, 'default-rules', DEFAULT_RULES_CFG, VERBOSE ) + + ! Read default rules from configuration + CALL READ_RULES( DEFAULT_RULES_CFG, RULES%DEFAULT_RULES, VERBOSE ) + + ! Free rules array + CALL YAML_DELETE_CONFIGURATIONS( DEFAULT_RULES_CFG, VERBOSE ) + + ENDIF + + ! Read the special encoding rules (specific ancoding rules meant to cover some edge cases) + IF ( CFG_HAS_SPECIAL_RULES ) THEN + + ! Read default rules from configuration + CALL YAML_GET_SUBCONFIGURATIONS( ENCODING_RULES_CFG, 'special-rules', SPECIAL_RULES_CFG, VERBOSE ) + + ! Read default rules from configuration + CALL READ_RULES( SPECIAL_RULES_CFG, RULES%SPECIAL_RULES, VERBOSE ) + + ! Free rules array + CALL YAML_DELETE_CONFIGURATIONS( SPECIAL_RULES_CFG, VERBOSE ) + + ENDIF + + ! Free rules array + CALL YAML_DELETE_CONFIGURATION( ENCODING_RULES_CFG, VERBOSE ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Encoding rules not found in configuration file' ) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'empty encoding rules section found in configuration file' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE SUGENERAL_RULES +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULES' +__THREAD_SAFE__ SUBROUTINE READ_RULES( CFG, RULES, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: OM_GENERAL_UTILS_MOD, ONLY: OM_REPLACE_ENVVAR_IN_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATIONS_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_CONFIGURATIONS_SIZE + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_CONFIGURATION_BY_ID + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATIONS_T), INTENT(IN) :: CFG + TYPE(GENERAL_RULES_T), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: RULES + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: FILE_EXISTS + LOGICAL :: RULE_HAS_FILE_KEY + LOGICAL :: RULE_HAS_RULE_KEY + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: N + TYPE(YAML_CONFIGURATION_T) :: RULE_CFG + TYPE(YAML_CONFIGURATION_T) :: CURR_CFG + CHARACTER(LEN=:), ALLOCATABLE :: YAMLFNAME + CHARACTER(LEN=1024) :: YAMLFNAME_FULL + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + CURR_CFG => NULL() + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(RULES), 0 ) + + ! Get the rules size + CALL YAML_GET_CONFIGURATIONS_SIZE( CFG, N, VERBOSE ) + + ! Allocate memory for rules + ALLOCATE( RULES(N), STATUS=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW(DEALLOC_STATUS .NE. 0, 1) + + ! Loop over the rules + RulesLoop: DO I = 1, N + + ! Get the current configuration + CALL YAML_GET_CONFIGURATION_BY_ID( CFG, I, CURR_CFG, VERBOSE ) + + ! Check if the rule is defined in-place or in a separate file + CALL YAML_CONFIGURATION_HAS_KEY( CURR_CFG, 'rule', RULE_HAS_RULE_KEY, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( CURR_CFG, 'file', RULE_HAS_FILE_KEY, VERBOSE ) + + PP_DEBUG_CRITICAL_COND_THROW( RULE_HAS_RULE_KEY.AND.RULE_HAS_FILE_KEY, 6 ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.RULE_HAS_RULE_KEY .AND. .NOT.RULE_HAS_FILE_KEY, 5 ) + + IF ( RULE_HAS_RULE_KEY ) THEN + + ! Read the rule from current file + CALL READ_RULE( CURR_CFG, RULES(I), VERBOSE ) + + ELSEIF ( RULE_HAS_FILE_KEY ) THEN + + ! Get the filename + CALL YAML_READ_STRING( CURR_CFG, 'file', YAMLFNAME, VERBOSE ) + PP_DEBUG_COND_THROW( .NOT.ALLOCATED(YAMLFILENAME), 2 ) + + ! Replace environment variables + CALL OM_REPLACE_ENVVAR_IN_STRING( YAMLFNAME, YAMLFNAME_FULL ) + + ! Free memory + DEALLOCATE(YAMLFNAME, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW(DEALLOC_STATUS .NE. 0, 4) + + ! Check if the file exsts + INQUIRE( FILE=TRIM(YAMLFNAME_FULL), EXIST=FILE_EXISTS ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.FILE_EXISTS, 3 ) + + ! Open the filename + CALL YAML_NEW_CONFIGURATION_FROM_FILE( RULE_CFG, TRIM(YAMLFNAME_FULL), VERBOSE ) + + ! Read the rule + CALL READ_RULE( RULE_CFG, RULES(I), VERBOSE ) + + ! Destroy the yaml configuration object + CALL YAML_DELETE_CONFIGURATION( RULE_CFG, VERBOSE ) + ENDIF + + ENDDO RulesLoop + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Rules array already allocated' ) + CASE (1) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating rules array' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating rules array: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'yaml file name for rules not allocated' ) + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'yaml file name for rules doen not exist: '//TRIM(YAMLFNAME_FULL) ) + CASE (4) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating yaml file name for rules' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating yaml file name for rules: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (5) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unable to find valid keyword: expected one of: [rule|file]' ) + CASE (5) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unexpeted both "rule" and "file" keys ' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULES +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE' +__THREAD_SAFE__ SUBROUTINE READ_RULE( CFG, RULE, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_FILTERS_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_FILTERS_UTILS_MOD, ONLY: READ_RULE_FILTER + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(GENERAL_RULE_T), INTENT(OUT) :: RULE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Read Name + CALL READ_RULE_NAME( CFG, RULE%NAME, VERBOSE ) + + ! Read Tag + CALL READ_RULE_TAG( CFG, RULE%TAG, VERBOSE ) + + ! Read Filter + CALL READ_RULE_FILTER( CFG, RULE%FILTER, VERBOSE ) + + ! Read Mappings + CALL READ_RULE_MAPPINGS( CFG, RULE%MAPPING, VERBOSE ) + + ! Read Encoding Info + CALL READ_RULE_ENCODING( CFG, RULE%ENCODING, VERBOSE ) + + ! Read Packing Info + CALL READ_RULE_PACKING( CFG, RULE%PACKING, VERBOSE ) + + ! Read Sink Info + CALL READ_RULE_SINK( CFG, RULE%SINK, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'FREE_RULES' +__THREAD_SAFE__ SUBROUTINE FREE_RULES( RULES ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(GENERAL_RULES_T), INTENT(INOUT) :: RULES + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Free default rules + IF ( ALLOCATED(RULES%DEFAULT_RULES) ) THEN + DO I = 1, SIZE(RULES%DEFAULT_RULES) + CALL FREE_RULE( RULES%DEFAULT_RULES(I) ) + ENDDO + DEALLOCATE( RULES%DEFAULT_RULES, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 0 ) + ENDIF + + ! Free special rules + IF ( ALLOCATED(RULES%SPECIAL_RULES) ) THEN + DO I = 1, SIZE(RULES%SPECIAL_RULES) + CALL FREE_RULE( RULES%SPECIAL_RULES(I) ) + ENDDO + DEALLOCATE( RULES%SPECIAL_RULES, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 1 ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating DEFAULT_RULES' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating DEFAULT_RULES: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (1) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating SPECIAL_RULES' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating SPECIAL_RULES: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE FREE_RULES +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'FREE_RULE' +__THREAD_SAFE__ SUBROUTINE FREE_RULE( RULE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(GENERAL_RULE_T), INTENT(OUT) :: RULE + + ! Local variables + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Free default rules + IF ( ALLOCATED(RULE%MAPPING%MAPS) ) THEN + DEALLOCATE( RULE%MAPPING%MAPS, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 0 ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating RULE%MAPPING%MAPS' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating RULE%MAPPING%MAPS: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE FREE_RULES +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_NAME' +__THREAD_SAFE__ SUBROUTINE READ_RULE_NAME( CFG, NAME, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=128), INTENT(OUT) :: NAME + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: RULE_HAS_RULE_KEY + LOGICAL :: RULE_HAS_FILE_KEY + CHARACTER(LEN=:), ALLOCATABLE :: LOC_NAME + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Check the configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'rule', RULE_HAS_RULE_KEY, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'file', RULE_HAS_FILE_KEY, VERBOSE ) + + ! Check consistency + PP_DEBUG_CRITICAL_COND_THROW( RULE_HAS_RULE_KEY .AND. RULE_HAS_FILE_KEY, 4 ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.RULE_HAS_RULE_KEY .AND. .NOT.RULE_HAS_FILE_KEY, 3 ) + + ! Read the name of the rule (usually the keyword "rule" is used for rules defined in-place, + ! and the keyword "name" is used for rules defined in a separate file) + IF ( RULE_HAS_RULE_KEY ) THEN + ! Rules defined in-place + CALL YAML_READ_STRING( CFG, '', LOC_NAME, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_NAME), 1 ) + PP_DEBUG_CRITICAL_COND_THROW( LEN(LOC_NAME).GT.LEN(NAME), 2 ) + NAME = LOC_NAME + DEALLOCATE(LOC_NAME, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS .NE. 0, 5 ) + ELSEIF ( RULE_HAS_FILE_KEY ) THEN + ! Rules defined in a separate file + CALL YAML_READ_STRING( CFG, '', LOC_NAME, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_NAME), 1 ) + PP_DEBUG_CRITICAL_COND_THROW( LEN(LOC_NAME).GT.LEN(NAME), 2 ) + NAME = LOC_NAME + DEALLOCATE(LOC_NAME, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS .NE. 0, 5 ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Rule name not allcoated' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate NAME: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate NAME' ) + ENDIF + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to find the rule name: expected one of [rule|name]' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unexpected both "rule" and "name" set' ) + CASE (5) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate LOC_NAME: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate LOC_NAME' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_NAME +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_TAG' +__THREAD_SAFE__ SUBROUTINE READ_RULE_TAG( CFG, TAG, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_FILTERS_UTILS_MOD, ONLY: TAG_LEN + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=TAG_LEN), INTENT(OUT) :: TAG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + CHARACTER(LEN=:), ALLOCATABLE :: LOC_TAG + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Rules defined in-place + CALL YAML_READ_STRING( CFG, 'tag', LOC_TAG, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_TAG), 1 ) + PP_DEBUG_CRITICAL_COND_THROW( LEN(LOC_TAG).GT.LEN(TAG), 2 ) + TAG = LOC_TAG + DEALLOCATE(LOC_TAG, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 3 ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Rule name not allcoated' ) + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Tag name too long' ) + CASE (3) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate LOC_TAG: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate LOC_TAG' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_TAG +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPINGS' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPINGS( CFG, MAPPINGS, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATIONS_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_CONFIGURATIONS_SIZE + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_CONFIGURATION_BY_ID + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATIONS + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATIONS + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(MAPPING_RULES_T) INTENT(OUT) :: MAPPINGS + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATIONS_T) :: MAPPING_RULES_CFG + TYPE(YAML_CONFIGURATION_T) :: CURR_CFG + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: N + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + LOGICAL :: CFG_HAS_MAPPING_RULES + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(MAPPINGS%MAPS), 0 ) + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'mapping-rules', CFG_HAS_MAPPING_RULES, VERBOSE ) + + ! Reading all the rules + IF ( CFG_HAS_MAPPING_RULES ) THEN + + ! Read the mapping rules + CALL YAML_GET_SUBCONFIGURATIONS( CFG, 'mapping-rules', MAPPING_RULES_CFG, VERBOSE ) + + ! Get the number of rules + CALL YAML_GET_CONFIGURATIONS_SIZE( MAPPING_RULES_CFG, N, VERBOSE ) + + ! Check the allocation status of the subconfigurations + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(MAPPING_RULES_CFG), 1 ) + + ! Allocate output structure + ALLOCATE( MAPPINGS%MAPS(N), STATUS=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS .NE. 0, 2 ) + + ! Read rules one-by-one + DO I = 1, N + + ! Get the current configuration + CALL YAML_GET_CONFIGURATION_BY_ID( MAPPING_RULES_CFG, I, CURR_CFG, VERBOSE ) + + ! Read the mapping rule + CALL READ_RULE_MAPPING( CURR_CFG, MAPPINGS%MAPPING(I), VERBOSE ) + + ENDDO + + ! Free subconfigurations + CALL YAML_DELETE_CONFIGURATIONS( MAPPING_RULES_CFG ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Mappings output structure already allocated' ) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Mappings configuration not allocated after reading' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate mapping output structure: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate lookup_table' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPINGS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPING' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPING( CFG, MAPPING, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(MAPPING_RULE_T), INTENT(OUT) :: MAPPING + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Read the matching conditions + CALL READ_RULE_MAPPING_FROM( CFG, & +& MAPPING%FROM_PARAM_ID, MAPPING%FROM_LEVEL, MAPPING%FROM_DIRECTION, & +& MAPPING%FROM_FREQUENCY, MAPPING%FROM_LEVTYPE, VERBOSE ) + + ! Read the mapping values + CALL READ_RULE_MAPPING_TO( CFG, & +& MAPPING%TO_PARAM_ID, MAPPING%TO_LEVEL, MAPPING%TO_DIRECTION, & +& MAPPING%TO_FREQUENCY, MAPPING%TO_LEVTYPE, MAPPING%SCALE_FACTOR, VERBOSE ) + + ! Check the mapping consistency + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%FROM_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%FROM_DIRECTION.NE.UNDEF_PARAM_E, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%TO_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%TO_DIRECTION.NE.UNDEF_PARAM_E, 2 ) + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%FROM_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%FROM_FREQUENCY.NE.UNDEF_PARAM_E, 3 ) + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%TO_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%TO_FREQUENCY.NE.UNDEF_PARAM_E, 4 ) + + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping from-level and from-direction cannot be specified at the same time' ) + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping to-level and to-direction cannot be specified at the same time' ) + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping from-level and from-frequency cannot be specified at the same time' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping to-level and to-frequency cannot be specified at the same time' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPING +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPING_FROM' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPING_FROM( CFG, PARAMID, LEVEL, & +& DIRECTION, FREQUENCY, LEVTYPE, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATION + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB), INTENT(OUT) :: PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: DIRECTION + INTEGER(KIND=JPIB), INTENT(OUT) :: FREQUENCY + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVTYPE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATION_T) :: FROM_CFG + CHARACTER(LEN=:), ALLOCATABLE :: LOC_LEVTYPE + INTEGER(KIND=JPIB_K) :: CNT + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + LOGICAL :: CONFIGURATION_HAS_FROM + LOGICAL :: CONFIGURATION_HAS_PARAMID + LOGICAL :: CONFIGURATION_HAS_LEVEL + LOGICAL :: CONFIGURATION_HAS_DIRECTION + LOGICAL :: CONFIGURATION_HAS_FREQUENCY + LOGICAL :: CONFIGURATION_HAS_LEVTYPE + LOGICAL :: CONFIGURATION_HAS_TAG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'from', CONFIGURATION_HAS_FROM, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_FROM, 3 ) + + ! Rules defined in-place + CNT = 0 + IF ( CONFIGURATION_HAS_FROM ) THEN + + ! Read the "from" subconfiguration + CALL YAML_GET_SUBCONFIGURATION( CFG, 'from', FROM_CFG, VERBOSE ) + + ! Configuration substructure + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'paramId', CONFIGURATION_HAS_PARAMID, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'level', CONFIGURATION_HAS_LEVEL, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'direction', CONFIGURATION_HAS_DIRECTION, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'frequency', CONFIGURATION_HAS_FREQUENCY, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'levtype', CONFIGURATION_HAS_LEVTYPE, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'tag', CONFIGURATION_HAS_TAG, VERBOSE ) + + ! Read the paramId + IF ( CONFIGURATION_HAS_PARAMID ) THEN + CALL YAML_READ_INTEGER( FROM_CFG, 'paramId', PARAMID, VERBOSE ) + CNT = CNT + 1 + ELSE + PARAMID = UNDEF_PARAM_E + ENDIF + + ! Read the level + IF ( CONFIGURATION_HAS_LEVEL ) THEN + CALL YAML_INTEGER_STRING( FROM_CFG, 'level', LEVEL, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the direction + IF ( CONFIGURATION_HAS_DIRECTION ) THEN + CALL YAML_INTEGER_STRING( FROM_CFG, 'direction', DIRECTION, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the frequency + IF ( CONFIGURATION_HAS_FREQUENCY ) THEN + CALL YAML_INTEGER_STRING( FROM_CFG, 'frequency', FREQUENCY, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + IF ( CONFIGURATION_HAS_LEVTYPE ) THEN + CALL YAML_READ_STRING( FROM_CFG, 'levtype', LOC_LEVTYPE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_LEVTYPE), 1 ) + IF ( STRING_IS_INTEGER( LOC_LEVTYPE ) ) THEN + READ(LOC_LEVTYPE, *) LEVTYPE + ELSE + CALL CLEVTYPE2ILEVTYPE( LOC_LEVTYPE, LEVTYPE ) + ENDIF + DEALLOCATE(LOC_LEVTYPE, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 2 ) + CNT = CNT + 1 + ELSE + LEVTYPE = UNDEF_PARAM_E + ENDIF + + ! Free subconfiguration + CALL YAML_DELETE_CONFIGURATION( FROM_CFG ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( CNT.LT.1, 4 ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'levtype is not allocated after read' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype' ) + ENDIF + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to find "from" subconfiguration' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'no rule found in "from" subconfiguration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPING_FROM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPING_TO' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPING_TO( CFG, PARAMID, LEVEL, & +& DIRECTION, FREQUENCY, LEVTYPE, SCALE_FACTOR, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: OM_CORE_MOD, ONLY: JPRD_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATION + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_FLOAT + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB), INTENT(OUT) :: PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: DIRECTION + INTEGER(KIND=JPIB), INTENT(OUT) :: FREQUENCY + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVTYPE + REAL(KIND=JPRD_K), INTENT(OUT) :: SCALE_FACTOR + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATION_T) :: TO_CFG + CHARACTER(LEN=:), ALLOCATABLE :: LOC_LEVTYPE + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + INTEGER(KIND=JPIB_K) :: CNT + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + LOGICAL :: CONFIGURATION_HAS_TO + LOGICAL :: CONFIGURATION_HAS_PARAMID + LOGICAL :: CONFIGURATION_HAS_LEVEL + LOGICAL :: CONFIGURATION_HAS_DIRECTION + LOGICAL :: CONFIGURATION_HAS_FREQUENCY + LOGICAL :: CONFIGURATION_HAS_LEVTYPE + LOGICAL :: CONFIGURATION_HAS_SCALE_FACTOR + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'to', CONFIGURATION_HAS_TO, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_TO, 3 ) + + ! Rules defined in-place + CNT = 0 + IF ( CONFIGURATION_HAS_TO ) THEN + + ! Read the "from" subconfiguration + CALL YAML_GET_SUBCONFIGURATION( CFG, 'to', TO_CFG, VERBOSE ) + + ! Configuration substructure + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'paramId', CONFIGURATION_HAS_PARAMID, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'level', CONFIGURATION_HAS_LEVEL, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'direction', CONFIGURATION_HAS_DIRECTION, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'frequency', CONFIGURATION_HAS_FREQUENCY, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'levtype', CONFIGURATION_HAS_LEVTYPE, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'scale-factor', CONFIGURATION_HAS_SCALE_FACTOR, VERBOSE ) + + ! Read the paramId + IF ( CONFIGURATION_HAS_PARAMID ) THEN + CALL YAML_READ_INTEGER( TO_CFG, 'paramId', PARAMID, VERBOSE ) + CNT = CNT + 1 + ELSE + PARAMID = UNDEF_PARAM_E + ENDIF + + ! Read the level + IF ( CONFIGURATION_HAS_LEVEL ) THEN + CALL YAML_INTEGER_STRING( TO_CFG, 'level', LEVEL, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the direction + IF ( CONFIGURATION_HAS_DIRECTION ) THEN + CALL YAML_INTEGER_STRING( TO_CFG, 'direction', DIRECTION, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the frequency + IF ( CONFIGURATION_HAS_FREQUENCY ) THEN + CALL YAML_INTEGER_STRING( TO_CFG, 'frequency', FREQUENCY, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the lectype + IF ( CONFIGURATION_HAS_LEVTYPE ) THEN + CALL YAML_READ_STRING( TO_CFG, 'levtype', LOC_LEVTYPE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_LEVTYPE), 1 ) + IF ( STRING_IS_INTEGER( LOC_LEVTYPE ) ) THEN + READ(LOC_LEVTYPE, *) LEVTYPE + ELSE + CALL CLEVTYPE2ILEVTYPE( LOC_LEVTYPE, LEVTYPE ) + ENDIF + DEALLOCATE(LOC_LEVTYPE, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 2 ) + CNT = CNT + 1 + ELSE + LEVTYPE = UNDEF_PARAM_E + ENDIF + + ! Read the scale factor + IF ( CONFIGURATION_HAS_SCALE_FACTOR ) THEN + CALL YAML_READ_FLOAT( TO_CFG, 'scale-factor', LOC_SCALE_FACTOR, VERBOSE ) + ELSE + LEVTYPE = 1.0_JPRD_K + ENDIF + + ! Free subconfiguration + CALL YAML_DELETE_CONFIGURATION( FROM_CFG ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( CNT.LT.1, 4 ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'levtype is not allocated after read' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype' ) + ENDIF + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to find "from" subconfiguration' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'no rule found in "from" subconfiguration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPING_TO +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_MAPPING_ATM' +__THREAD_SAFE__ SUBROUTINE MATCH_MAPPING_ATM( MAP, & +& IN_PARAMID, IN_LEVEL, IN_LEVTYPE, MATCH, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + MATCH = .TRUE. + + IF ( MATCH .AND. MAP%FROM_PARAM_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_PARAM_ID.EQ.IN_PARAMID ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_LEVEL_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_LEVEL.EQ.IN_LEVEL ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_LEVTYPE_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_LEVTYPE.EQ.IN_LEVTYPE ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE MATCH_MAPPING_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'APPLY_MAPPING_ATM' +__THREAD_SAFE__ SUBROUTINE APPLY_MAPPING_ATM( MAP, & +& IN_PARAMID, IN_LEVEL, IN_LEVTYPE, & +& OUT_PARAMID, OUT_LEVEL, OUT_LEVTYPE, OUT_SCALE_FACTOR, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVTYPE + REAL(KIND=JPRD_K), INTENT(OUT) :: OUT_SCALE_FACTOR + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: MATCH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + CALL MATCH_MAPPING_ATM( MAP, IN_PARAMID, IN_LEVEL, IN_LEVTYPE, MATCH, VERBOSE ) + + ! Crete mapped values + IF ( MATCH .AND. MAP%TO_PARAM_ID .NE. UNDEF_PARAM_E ) THEN + OUT_PARAMID = MAP%TO_PARAM_ID + ELSE + OUT_PARAMID = IN_PARAMID + ENDIF + + IF ( MATCH .AND. MAP%TO_LEVEL .NE. UNDEF_PARAM_E ) THEN + OUT_LEVEL = MAP%TO_LEVEL + ELSE + OUT_LEVEL = IN_LEVEL + ENDIF + + IF ( MATCH .AND. MAP%TO_LEVTYPE .NE. UNDEF_PARAM_E ) THEN + OUT_LEVTYPE = MAP%TO_LEVTYPE + ELSE + OUT_LEVTYPE = IN_LEVTYPE + ENDIF + + OUT_SCALE_FACTOR = MAP%SCALE_FACTOR + + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE APPLY_MAPPING_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_MAPPING_WAM' +__THREAD_SAFE__ SUBROUTINE MATCH_MAPPING_WAM( MAP,& +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_LEVTYPE, MATCH, VERBOSE) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + MATCH = .TRUE. + + IF ( MATCH .AND. MAP%FROM_PARAM_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_PARAM_ID.EQ.IN_PARAMID ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_DIRECTION.NE.UNDEF_PARAM_E ) THEN + MATCH = ( MAP%FROM_DIRECTION.EQ.IN_DIRECTION ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_FREQUENCY.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_FREQUENCY.EQ.IN_FREQUENCY ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_LEVTYPE_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_LEVTYPE.EQ.IN_LEVTYPE ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE MATCH_MAPPING_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'APPLY_MAPPING_WAM' +__THREAD_SAFE__ SUBROUTINE APPLY_MAPPING_WAM( MAP,& +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_LEVTYPE, & +& OUT_PARAMID, OUT_DIRECTION, OUT_FREQUENCY, OUT_LEVTYPE, & +& OUT_SCALE_FACTOR, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVTYPE + REAL(KIND=JPRD_K), INTENT(OUT) :: OUT_SCALE_FACTOR + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: MATCH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Check if the mapping matches the input values + CALL MATCH_MAPPING_WAM( MAP, IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_LEVTYPE, MATCH, VERBOSE ) + + ! Crete mapped values + IF ( MATCH .AND. MAP%TO_PARAM_ID .NE. UNDEF_PARAM_E ) THEN + OUT_PARAMID = MAP%TO_PARAM_ID + ELSE + OUT_PARAMID = IN_PARAMID + ENDIF + + IF ( MATCH .AND. MAP%TO_DIRECTION .NE. UNDEF_PARAM_E ) THEN + OUT_DIRECTION = MAP%TO_DIRECTION + ELSE + OUT_DIRECTION = IN_DIRECTION + ENDIF + + IF ( MATCH .AND. MAP%TO_FREQUENCY .NE. UNDEF_PARAM_E ) THEN + OUT_FREQUENCY = MAP%TO_FREQUENCY + ELSE + OUT_FREQUENCY = IN_FREQUENCY + ENDIF + + IF ( MATCH .AND. MAP%TO_LEVTYPE .NE. UNDEF_PARAM_E ) THEN + OUT_LEVTYPE = MAP%TO_LEVTYPE + ELSE + OUT_LEVTYPE = IN_LEVTYPE + ENDIF + + OUT_SCALE_FACTOR = MAP%SCALE_FACTOR + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE APPLY_MAPPING_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_ENCODING' +__THREAD_SAFE__ SUBROUTINE READ_RULE_ENCODING( CFG, ENCODING, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(ENCODING_RULE_T), INTENT(OUT) :: ENCODING + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration to allow using paramIDECMF for fields that are not already defined in eccodes + CALL READ_RULE_ENCODING_USEPARAMIDECMF( CFG, ENCODING%USEPARAMIDECMF, VERBOSE ) + + ! Select the grib edition for the field to be encoded + CALL READ_RULE_ENCODING_EDITION( CFG, ENCODING%EDITION, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE_ENCODING +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_PACKING' +__THREAD_SAFE__ SUBROUTINE READ_RULE_PACKING( CFG, PACKING, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(PACKING_RULE_T), INTENT(OUT) :: PACKING + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Read the packing type + CALL READ_RULE_PACKING_PACKING_TYPE( CFG, ENCODING%PACKING_TYPE, VERBOSE ) + + ! Read the bits per value + CALL READ_RULE_PACKING_BITS_PER_VALUE( CFG, ENCODING%BITS_PER_VALUE, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE_PACKING +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_SINK' +__THREAD_SAFE__ SUBROUTINE READ_RULE_SINK( CFG, PACKING, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(SINK_RULE_T), INTENT(OUT) :: SINK + LOGICAL, INTENT(IN) :: VERBOSE + + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Read the packing type + CALL READ_RULE_SINK_DIRECT_TO_FDB( CFG, SINK%DIRECT_TO_FDB, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE_SINK +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_ENCODING_USEPARAMIDECMF' +__THREAD_SAFE__ SUBROUTINE READ_RULE_ENCODING_USEPARAMIDECMF( CFG, USEPARAMIDECMF, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_LOGICAL + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(OUT) :: USEPARAMIDECMF + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: CONFIGURATION_HAS_USEPARAMIDECMF + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! REpository structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'use-paramId-ECMF', CONFIGURATION_HAS_USEPARAMIDECMF, VERBOSE ) + + ! Read the local definition template number + IF ( CONFIGURATION_HAS_USEPARAMIDECMF ) THEN + CALL YAML_READ_INTEGER( CFG, 'use-paramId-ECMF', USEPARAMIDECMF, VERBOSE ) + ELSE + USEPARAMIDECMF = DEFAULT_USEPARAMIDECMF + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE_ENCODING_USEPARAMIDECMF +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_SINK_DIRECT_TO_FDB' +__THREAD_SAFE__ SUBROUTINE READ_RULE_SINK_DIRECT_TO_FDB( CFG, DIRECT_TO_FDB, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_LOGICAL + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(OUT) :: DIRECT_TO_FDB + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: CONFIGURATION_HAS_DIRECT_TO_FDB + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Repository structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'direct-to-fdb', CONFIGURATION_HAS_DIRECT_TO_FDB, VERBOSE ) + + ! Read the local definition template number + IF ( CONFIGURATION_HAS_DIRECT_TO_FDB ) THEN + CALL YAML_READ_INTEGER( CFG, 'direct-to-fdb', DIRECT_TO_FDB, VERBOSE ) + ELSE + DIRECT_TO_FDB = DEFAULT_DIRECT_TO_FDB + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE_SINK_DIRECT_TO_FDB +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_PACKING_PACKING_TYPE' +__THREAD_SAFE__ SUBROUTINE READ_RULE_PACKING_PACKING_TYPE( CFG, PACKINGTYPE, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: PACKINGTYPE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ATMP + LOGICAL :: CONFIGURATION_HAS_PACKINGTYPE + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'packing-type', CONFIGURATION_HAS_PACKINGTYPE, VERBOSE ) + + ! Read the local definition template number + IF ( CONFIGURATION_HAS_PACKINGTYPE ) THEN + + ! Read teh configuration variable + CALL YAML_READ_STRING( CFG, 'packing-type', ATMP, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(ATMP), 0 ) + + ! Handle configuration cases + SELECT CASE (CLTMP) + CASE ('grid_simple') + PACKINGTYPE = PACKING_TYPE_GRIB_SIMPLE_E + CASE ('spectral_complex') + PACKINGTYPE = PACKING_TYPE_GRIB_COMPLEX_E + CASE ('grid_ccsds') + PACKINGTYPE = PACKING_TYPE_GRIB_CCSDE_E + CASE DEFAULT + PP_DEBUG_CRITICAL_THROW( 2 ) + END SELECT + DEALLOCATE(ATMP,STAT=DEALLOC_STATUS,ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 3 ) + ELSE + PACKINGTYPE = UNDEF_PARAM_E + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP1 + CHARACTER(LEN=32) :: TMP2 + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'packing-type is not allocated after read' ) + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown option for packing-type: '//TRIM(ADJUSTL(ATMP)) ) + CASE (3) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate packing-type: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate packing-type' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Free memory + IF ( ALLOCATED(ATMP) ) DEALLOCATE(ATMP) + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_PACKING_PACKING_TYPE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_PACKING_BITS_PER_VALUE' +__THREAD_SAFE__ SUBROUTINE READ_RULE_PACKING_BITS_PER_VALUE( CFG, BITS_PER_VALUE, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: STRING_IS_INTEGER + USE :: YAML_CORE_UTILS_MOD, ONLY: STRING_TO_INTEGER + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: ENCODINGEDITION + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ATMP + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + LOGICAL :: CONFIGURATION_HAS_BITS_PER_VALUE + LOGICAL :: IS_INTEGER + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'bits-per-value', CONFIGURATION_HAS_BITS_PER_VALUE, VERBOSE ) + + ! Read the bits per value to be used to encode the current field + IF ( CONFIGURATION_HAS_BITS_PER_VALUE ) THEN + + ! Read the bits per value + CALL YAML_READ_STRING( CFG, 'bits-per-value', ATMP, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(ATMP), 0 ) + + ! Check if the value is an integer + CALL STRING_IS_INTEGER( ATMP, IS_INTEGER, VERBOSE ) + + ! Depending on the value of the bits-per-value, set the number of bits per value + IF ( IS_INTEGER ) THEN + + ! Read the integer value + CALL STRING_TO_INTEGER( ATMP, BITS_PER_VALUE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( BITS_PER_VALUE.LT.BITS_PER_VALUE_MIN, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( BITS_PER_VALUE.GT.BITS_PER_VALUE_MAX, 2 ) + + ELSE + + ! Handle more general configurations + SELECT CASE( TRIM(ATMP) ) + CASE ( 'use-default-table' ) + BITS_PER_VALUE = BITS_PER_VALUE_DEFAULT_TABLE + CASE ( 'use-compressed-table' ) + BITS_PER_VALUE = BITS_PER_VALUE_COMPRESSED_TABLE + CASE DEFAULT + PP_DEBUG_CRITICAL_THROW( 3 ) + END SELECT + + ENDIF + + ! Free meomry + DEALLOCATE(ATMP,STAT=DEALLOC_STATUS,ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 4 ) + + ELSE + BITS_PER_VALUE = UNDEF_PARAM_E + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP1 + CHARACTER(LEN=32) :: TMP2 + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'bits-per-value is not allocated after read' ) + CASE (1) + TMP1=REPEAT(' ',32) + TMP2=REPEAT(' ',32) + WRITE(TMP1,'(I10)') BITS_PER_VALUE_MIN + WRITE(TMP2,'(I10)') BITS_PER_VALUE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'BitsPerValue lower than minimal possible value: minimal allowed='//TRIM(ADJUSTL(TMP1))//' - current='//TRIM(ADJUSTL(TMP2)) ) + CASE (2) + TMP1=REPEAT(' ',32) + TMP2=REPEAT(' ',32) + WRITE(TMP1,'(I10)') BITS_PER_VALUE_MAX + WRITE(TMP2,'(I10)') BITS_PER_VALUE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'BitsPerValue higher than maximum possible value: maximum allowed='//TRIM(ADJUSTL(TMP1))//' - current='//TRIM(ADJUSTL(TMP2)) ) + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown option for bits-per-value: '//TRIM(ADJUSTL(ATMP)) ) + CASE (4) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate bits-per-value: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate bits-per-value' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Free memory + IF ( ALLOCATED(ATMP) ) DEALLOCATE(ATMP) + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_PACKING_BITS_PER_VALUE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_ENCODING_ENCODINGEDITION' +__THREAD_SAFE__ SUBROUTINE READ_RULE_ENCODING_ENCODINGEDITION( CFG, ENCODINGEDITION, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: ENCODINGEDITION + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: CONFIGURATION_HAS_ENCODINGEDITION + + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'edition', CONFIGURATION_HAS_ENCODINGEDITION, VERBOSE ) + + ! Read the local definition template number + IF ( CONFIGURATION_HAS_ENCODINGEDITION ) THEN + CALL YAML_READ_INTEGER( CFG, 'edition', ENCODINGEDITION, VERBOSE ) + ELSE + ENCODINGEDITION = UNDEF_PARAM_E + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE READ_RULE_ENCODING_ENCODINGEDITION +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_GRIB_STRUCTURE' +__THREAD_SAFE__ SUBROUTINE READ_RULE_GRIB_STRUCTURE( CFG, GRIB_STRUCTURE, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(GRIB_STRUCTURE_T), INTENT(OUT) :: GRIB_STRUCTURE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: CONFIGURATION_HAS_LOCAL_DEFINITION_TEMPLATE_NUMBER + LOGICAL :: CONFIGURATION_HAS_GRID_DEFINITION_TEMPLATE_NUMBER + LOGICAL :: CONFIGURATION_HAS_PRODUCT_DEFINITION_TEMPLATE_NUMBER + LOGICAL :: CONFIGURATION_HAS_DATA_DEFINITION_TEMPLATE_NUMBER + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'local-definition-template-number', CONFIGURATION_HAS_LOCAL_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'grid-definition-template-number', CONFIGURATION_HAS_GRID_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'product-definition-template-number', CONFIGURATION_HAS_PRODUCT_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'data-definition-template-number', CONFIGURATION_HAS_DATA_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_LOCAL_DEFINITION_TEMPLATE_NUMBER, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_GRID_DEFINITION_TEMPLATE_NUMBER, 2 ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_PRODUCT_DEFINITION_TEMPLATE_NUMBER, 3 ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_DATA_DEFINITION_TEMPLATE_NUMBER, 4 ) + + ! Read the local definition template number + CALL YAML_READ_INTEGER( CFG, 'local-definition-template-number', GRIB_STRUCTURE%LOCAL_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + + ! Read the local definition template number + CALL YAML_READ_INTEGER( CFG, 'grid-definition-template-number', GRIB_STRUCTURE%GRID_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + + ! Read the local definition template number + CALL YAML_READ_INTEGER( CFG, 'product-definition-template-number', GRIB_STRUCTURE%PRODUCT_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + + ! Read the local definition template number + CALL YAML_READ_INTEGER( CFG, 'data-definition-template-number', GRIB_STRUCTURE%DATA_DEFINITION_TEMPLATE_NUMBER, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + +!$omp critical(error_handler) + ErrorHandler: BLOCK + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, '"local-definition-template-number" not found' ) + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, '"grid-definition-template-number" not found' ) + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, '"product-definition-template-number" not found' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, '"data-definition-template-number" not found' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler +!$omp end critical(error_handler) + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_GRIB_STRUCTURE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +END MODULE GENERAL_RULES_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/grib2/grib2_encoder_mod.F90 b/src/ecom/grib_info/grib2/grib2_encoder_mod.F90 new file mode 100644 index 000000000..c55e81bf1 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_encoder_mod.F90 @@ -0,0 +1,235 @@ +MODULE GRIB2_ENCODER_MOD + + USE :: SAMPLE_LOADER_MOD, ONLY: SAMPLE_LOADER_T + USE :: GRIB2_SECTION1_FACTORY_MOD, ONLY: GRIB2_SECTION1_BASE_T + USE :: GRIB2_SECTION2_FACTORY_MOD, ONLY: GRIB2_SECTION2_BASE_T + USE :: GRIB2_SECTION3_FACTORY_MOD, ONLY: GRIB2_SECTION3_BASE_T + USE :: GRIB2_SECTION4_FACTORY_MOD, ONLY: GRIB2_SECTION4_BASE_T + USE :: GRIB2_SECTION5_FACTORY_MOD, ONLY: GRIB2_SECTION5_BASE_T + USE :: GRIB_MESSAGE_MOD, ONLY: GRIB_MESSAGE_A + +IMPLICIT NONE + + + +TYPE, EXTENDS(GRIB_ENCODER_A) :: GRIB2_ENCODER_T + + !> Default visibility of the class members + PRIVATE + + CLASS(SAMPLE_LOADER_A), POINTER :: SAMPLE_LOADER => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC0 => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC1 => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC2 => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC3 => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC4 => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC5 => NULL() + CLASS(GRIB_SECTION_BASE_A), POINTER :: SEC6 => NULL() + +CONTAINS + + PROCEDURE, PUBLIC, PASS, NON_OVERRRIDABLE :: INIT => GRIB2_MESSAGE_INIT + + PROCEDURE, PUBLIC, PASS, NON_OVERRRIDABLE :: ALLOCATE => GRIB2_MESSAGE_ALLOCATE + + PROCEDURE, PUBLIC, PASS, NON_OVERRRIDABLE :: PRESET => GRIB2_MESSAGE_PRESET + + PROCEDURE, PUBLIC, PASS, NON_OVERRRIDABLE :: GET_RUNTIME_OPS => GRIB2_MESSAGE_GET_RUNTIME_OPS + + PROCEDURE, PUBLIC, PASS, NON_OVERRRIDABLE :: FREE => GRIB2_MESSAGE_FREE + +END TYPE + + +CONTAINS + + +SUBROUTINE GRIB2_MESSAGE_INIT( THIS, PARAMS, CFG, VERBOSE ) + + USE :: GRIB2_SECTIONS_FACTORY_MOD, ONLY: GRIB2_SECTIONS_FACTORY + +IMPLICIT NONE + +! Dummy arguments +CLASS(GRIB2_ENCODER_T), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG +LOGICAL, INTENT(IN) :: VERBOSE + +! Initialize the sections +CALL SAMPLE_LOADER_FACTORY( THIS%SAMPLE_LOADER, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC0, 0, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC1, 1, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC2, 2, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC3, 3, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC4, 4, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC5, 5, PARAMS, CFG, VERBOSE ) +CALL GRIB2_SECTIONS_FACTORY( THIS%SEC6, 6, PARAMS, CFG, VERBOSE ) + +END SUBROUTINE GRIB2_MESSAGE_INIT + + + +SUBROUTINE GRIB2_MESSAGE_ALLOCATE( THIS, PARAMS, METADATA, VERBOSE ) + +IMPLICIT NONE + +! Dummy arguments +CLASS(GRIB2_ENCODER_T), INTENT(IN) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +CLASS(METADATA_BASE_T), INTENT(INOUT) :: METADATA +LOGICAL, INTENT(IN) :: VERBOSE + +! Initialize the sections +CALL THIS%SAMPLE_LOADER%LOAD( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC0%ALLOCATE( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC1%ALLOCATE( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC2%ALLOCATE( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC3%ALLOCATE( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC4%ALLOCATE( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC5%ALLOCATE( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC6%ALLOCATE( PARAMS, METADATA, VERBOSE ) + +END SUBROUTINE GRIB2_MESSAGE_ALLOCATE + + +SUBROUTINE GRIB2_MESSAGE_PRESET( THIS, PARAMS, METADATA, VERBOSE ) + +IMPLICIT NONE + +! Dummy arguments +CLASS(GRIB2_ENCODER_T), INTENT(IN) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +CLASS(METADATA_BASE_T), INTENT(INOUT) :: METADATA +LOGICAL, INTENT(IN) :: VERBOSE + +! Allocate the grib strucutre +CALL THIS%ALLOCATE( PARAMS, METADATA, VERBOSE ) + +! Initialize the sections +CALL THIS%SEC0%PRESET( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC1%PRESET( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC2%PRESET( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC3%PRESET( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC4%PRESET( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC5%PRESET( PARAMS, METADATA, VERBOSE ) +CALL THIS%SEC6%PRESET( PARAMS, METADATA, VERBOSE ) + +END SUBROUTINE GRIB2_MESSAGE_PRESET + + +SUBROUTINE GRIB2_MESSAGE_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) + +IMPLICIT NONE + +! Dummy arguments +CLASS(GRIB2_ENCODER_T), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), ALLOCATABLE, INTENT(IN) :: RUNTIME_OPS +LOGICAL, INTENT(IN) :: VERBOSE + +! Local variables +INTEGER(KIND=JPIB_K) :: CNT +INTEGER(KIND=JPIB_K) :: N_RUNTIME_OPS +INTEGER(KIND=JPIB_K), DIMENSION(0:6) :: LO +INTEGER(KIND=JPIB_K), DIMENSION(0:6) :: HI + +! Initialize the sections +CNT = 0 + +CALL THIS%SEC0%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(0) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(0) = CNT + +CALL THIS%SEC1%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(1) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(1) = CNT + +CALL THIS%SEC2%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(2) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(2) = CNT + +CALL THIS%SEC3%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(3) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(3) = CNT + +CALL THIS%SEC4%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(4) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(4) = CNT + +CALL THIS%SEC5%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(5) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(5) = CNT + +CALL THIS%SEC6%NUMBER_OF_RUNTIME_OPS( PARAMS, N_RUNTIME_OPS, VERBOSE ) +LO(6) = CNT + 1 +CNT = CNT + N_RUNTIME_OPS +HI(6) = CNT + +! Allocate the runtime ops +ALLOCATE(RUNTIME_OPS(CNT)) + +! Initialize the sections +CALL THIS%SEC1%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(0):HI(0)), VERBOSE ) +CALL THIS%SEC1%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(1):HI(1)), VERBOSE ) +CALL THIS%SEC2%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(2):HI(2)), VERBOSE ) +CALL THIS%SEC3%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(3):HI(3)), VERBOSE ) +CALL THIS%SEC4%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(4):HI(4)), VERBOSE ) +CALL THIS%SEC5%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(5):HI(5)), VERBOSE ) +CALL THIS%SEC1%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS(LO(6):HI(6)), VERBOSE ) + +END SUBROUTINE GRIB2_MESSAGE_GET_RUNTIME_OPS + + +SUBROUTINE GRIB2_MESSAGE_FREE( THIS, VERBOSE ) + + USE :: GRIB2_SECTION1_FACTORY_MOD, ONLY: GRIB2_SECTION1_FACTORY + USE :: GRIB2_SECTION2_FACTORY_MOD, ONLY: GRIB2_SECTION2_FACTORY + USE :: GRIB2_SECTION3_FACTORY_MOD, ONLY: GRIB2_SECTION3_FACTORY + USE :: GRIB2_SECTION4_FACTORY_MOD, ONLY: GRIB2_SECTION4_FACTORY + USE :: GRIB2_SECTION5_FACTORY_MOD, ONLY: GRIB2_SECTION5_FACTORY + +IMPLICIT NONE + +! Dummy arguments +CLASS(GRIB2_ENCODER_T), INTENT(INOUT) :: THIS +LOGICAL, INTENT(IN) :: VERBOSE + +! Initialize the sections +CALL THIS%SAMPLE_LOADER%FREE( VERBOSE ) +CALL THIS%SEC0%FREE( VERBOSE ) +CALL THIS%SEC1%FREE( VERBOSE ) +CALL THIS%SEC2%FREE( VERBOSE ) +CALL THIS%SEC3%FREE( VERBOSE ) +CALL THIS%SEC4%FREE( VERBOSE ) +CALL THIS%SEC5%FREE( VERBOSE ) +CALL THIS%SEC6%FREE( VERBOSE ) + +DEALLOCATE( THIS%SAMPLE_LOADER ) +DEALLOCATE( THIS%SEC0 ) +DEALLOCATE( THIS%SEC1 ) +DEALLOCATE( THIS%SEC2 ) +DEALLOCATE( THIS%SEC3 ) +DEALLOCATE( THIS%SEC4 ) +DEALLOCATE( THIS%SEC5 ) +DEALLOCATE( THIS%SEC6 ) + +NULLIFY( THIS%SAMPLE_LOADER ) +NULLIFY( THIS%SEC0 ) +NULLIFY( THIS%SEC1 ) +NULLIFY( THIS%SEC2 ) +NULLIFY( THIS%SEC3 ) +NULLIFY( THIS%SEC4 ) +NULLIFY( THIS%SEC5 ) +NULLIFY( THIS%SEC6 ) + +END SUBROUTINE GRIB2_MESSAGE_FREE + + +END MODULE GRIB2_ENCODER_MOD \ No newline at end of file diff --git a/src/ecom/grib_info/grib2/grib2_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_factory_mod.F90 new file mode 100644 index 000000000..3c3d75fbb --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_factory_mod.F90 @@ -0,0 +1,175 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_FACTORY_MOD' +MODULE GRIB2_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_FACTORY + +CONTAINS + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_FACTORY' +FUNCTION GRIB2_FACTORY( GRIB_SECTION, PARAMS, SEC, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('P') :: GRIB2_SECTION0_FACTORY_MOD, ONLY: GRIB2_SECTION0_FACTORY + PP_USE_L('P') :: GRIB2_SECTION1_FACTORY_MOD, ONLY: GRIB2_SECTION1_FACTORY + PP_USE_L('P') :: GRIB2_SECTION2_FACTORY_MOD, ONLY: GRIB2_SECTION2_FACTORY + PP_USE_L('P') :: GRIB2_SECTION3_FACTORY_MOD, ONLY: GRIB2_SECTION3_FACTORY + PP_USE_L('P') :: GRIB2_SECTION4_FACTORY_MOD, ONLY: GRIB2_SECTION4_FACTORY + PP_USE_L('P') :: GRIB2_SECTION5_FACTORY_MOD, ONLY: GRIB2_SECTION5_FACTORY + PP_USE_L('P') :: GRIB2_SECTION6_FACTORY_MOD, ONLY: GRIB2_SECTION6_FACTORY + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION + TYPE(PARAMS_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: SEC + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION0=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION1=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION2=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION3=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION4=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION5=6_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_BUILD_SECTION6=7_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION=8_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( SEC ) + CASE( 0 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION0) GRIB2_SECTION0_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE( 1 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION1) GRIB2_SECTION1_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE( 2 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION2) GRIB2_SECTION2_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE( 3 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION3) GRIB2_SECTION3_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE( 4 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION4) GRIB2_SECTION4_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE( 5 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION5) GRIB2_SECTION5_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE( 6 ) + PP_TRYCALL(ERRFLAG_BUILD_SECTION6) GRIB2_SECTION6_FACTORY( GRIB_SECTION, PARAMS, ID, CFG, VERBOSE ) + CASE DEFAULT + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION ) + END SELECT + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') SEC + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_BUILD_SECTION0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 0' ) + CASE (ERRFLAG_BUILD_SECTION1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 1' ) + CASE (ERRFLAG_BUILD_SECTION2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 2' ) + CASE (ERRFLAG_BUILD_SECTION3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 3' ) + CASE (ERRFLAG_BUILD_SECTION4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 4' ) + CASE (ERRFLAG_BUILD_SECTION5) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 5' ) + CASE (ERRFLAG_BUILD_SECTION6) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error building section 6' ) + CASE (ERRFLAG_UNKNOWN_SECTION) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/grib2/grib2_runtime_ops_mod.F90 b/src/ecom/grib_info/grib2/grib2_runtime_ops_mod.F90 new file mode 100644 index 000000000..58c330ca5 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_runtime_ops_mod.F90 @@ -0,0 +1,32 @@ +MODULE GRIB2_MESSAGE_MOD +IMPLICIT NONE + +TYPE, ABSTRACT :: RUNTIME_OP_A + +CONTAINS + + PROCEDURE(ENCODE_IF), PASS, DEFERRED :: ENCODE + PROCEDURE(FREE_IF), PASS, DEFERRED :: FREE + +END TYPE + +TYPE :: RUNTIME_OP_CONTAINER_T + + PRIVATE + + CLASS(RUNTIME_OP_A), POINTER :: ENCODE_OP => NULL() + +CONTAINS + + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: ENCODE => RUNTIME_OP_CONTAINER_INIT + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: ENCODE => RUNTIME_OP_CONTAINER_ENCODE + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: FREE => RUNTIME_OP_CONTAINER_FREE + +END TYPE + + + +CONTAINS + + +END MODULE GRIB2_MESSAGE_MOD \ No newline at end of file diff --git a/src/ecom/grib_info/grib2/grib2_section0/grib2_section0_000_mod.F90 b/src/ecom/grib_info/grib2/grib2_section0/grib2_section0_000_mod.F90 new file mode 100644 index 000000000..9fe49e2af --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section0/grib2_section0_000_mod.F90 @@ -0,0 +1,574 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section0_000_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION0_000_MOD' +MODULE GRIB2_SECTION0_000_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION0_000_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION0_000_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION0_000_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION0_000_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION0_000_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION0_000_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION0_000_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION0_000_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_000_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION0_000_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION0_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_000_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_000_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION0_000_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION0_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_000_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_000_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION0_000_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION0_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_000_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_000_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION0_000_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION0_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_000_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_000_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION0_000_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION0_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_000_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_000_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION0_000_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION0_000_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_000_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION0_000_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section0/grib2_section0_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section0/grib2_section0_factory_mod.F90 new file mode 100644 index 000000000..946c3471b --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section0/grib2_section0_factory_mod.F90 @@ -0,0 +1,158 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section0_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION6_000_MOD' +MODULE GRIB2_SECTION0_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION0_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION0_FACTORY' +FUNCTION GRIB2_SECTION0_FACTORY( GRIB_SECTION0, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION0_000_MOD, ONLY: GRIB2_SECTION0_000_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION0 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_0=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + + CASE( 0 ) + + ALLOCATE( GRIB2_SECTION0_000_T::GRIB_SECTION0, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_0 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION0%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section0 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section0 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section0 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing section0 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION0_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION0_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section1/grib2_section1_000_mod.F90 b/src/ecom/grib_info/grib2/grib2_section1/grib2_section1_000_mod.F90 new file mode 100644 index 000000000..4792caec1 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section1/grib2_section1_000_mod.F90 @@ -0,0 +1,579 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section1_000_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION1_000_MOD' +MODULE GRIB2_SECTION1_000_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION1_000_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION1_000_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION1_000_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION1_000_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION1_000_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION1_000_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION1_000_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION1_000_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_000_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION1_000_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION1_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_000_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_000_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION1_000_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION1_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_000_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_000_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION1_000_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION1_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_000_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_000_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION1_000_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION1_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_000_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_000_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION1_000_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION1_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_000_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_000_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION1_000_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION1_000_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_000_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION1_000_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section1/grib2_section1_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section1/grib2_section1_factory_mod.F90 new file mode 100644 index 000000000..af9dc72eb --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section1/grib2_section1_factory_mod.F90 @@ -0,0 +1,158 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section1_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION1_000_MOD' +MODULE GRIB2_SECTION1_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION1_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION1_FACTORY' +FUNCTION GRIB2_SECTION1_FACTORY( GRIB_SECTION1, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION1_000_MOD, ONLY: GRIB2_SECTION1_000_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION1 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_1=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + + CASE( 0 ) + + ALLOCATE( GRIB2_SECTION1_000_T::GRIB_SECTION1, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_1 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION1%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section1 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section1 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section1 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing section1 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION1_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION1_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_001_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_001_mod.F90 new file mode 100644 index 000000000..d77837b27 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_001_mod.F90 @@ -0,0 +1,577 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_001_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_001_MOD' +MODULE GRIB2_SECTION2_001_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_001_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_001_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_001_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_001_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_001_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_001_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_001_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_001_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_001_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_001_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_001_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_001_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_001_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_001_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_001_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_001_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_001_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_001_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_001_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_001_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_001_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_001_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_001_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_001_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_001_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_001_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_001_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_001_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_001_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_001_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_001_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_001_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_001_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_007_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_007_mod.F90 new file mode 100644 index 000000000..860bcbc41 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_007_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_007_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_007_MOD' +MODULE GRIB2_SECTION2_007_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_007_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_007_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_007_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_007_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_007_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_007_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_007_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_007_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_007_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_007_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_007_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_007_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_007_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_007_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_007_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_007_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_007_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_007_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_007_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_007_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_007_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_007_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_007_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_007_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_007_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_007_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_007_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_007_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_007_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_007_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_007_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_007_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_007_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_009_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_009_mod.F90 new file mode 100644 index 000000000..c49390718 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_009_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_009_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_009_MOD' +MODULE GRIB2_SECTION2_009_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_009_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_009_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_009_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_009_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_009_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_009_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_009_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_009_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_009_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_009_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_009_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_009_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_009_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_009_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_009_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_009_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_009_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_009_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_009_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_009_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_009_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_009_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_009_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_009_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_009_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_009_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_009_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_009_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_009_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_009_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_009_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_009_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_009_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_015_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_015_mod.F90 new file mode 100644 index 000000000..cdc8a8620 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_015_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_015_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_015_MOD' +MODULE GRIB2_SECTION2_015_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_015_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_015_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_015_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_015_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_015_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_015_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_015_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_015_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_015_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_015_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_015_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_015_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_015_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_015_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_015_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_015_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_015_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_015_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_015_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_015_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_015_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_015_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_015_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_015_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_015_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_015_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_015_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_015_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_015_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_015_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_015_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_015_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_015_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_018_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_018_mod.F90 new file mode 100644 index 000000000..cdc018252 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_018_mod.F90 @@ -0,0 +1,577 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_018_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_018_MOD' +MODULE GRIB2_SECTION2_018_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_018_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_018_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_018_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_018_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_018_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_018_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_018_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_018_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_018_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_018_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_018_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_018_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_018_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_018_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_018_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_018_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_018_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_018_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_018_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_018_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_018_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_018_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_018_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_018_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_018_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_018_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_018_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_018_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_018_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_018_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_018_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_018_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_018_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_023_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_023_mod.F90 new file mode 100644 index 000000000..571a30fc6 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_023_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_023_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_023_MOD' +MODULE GRIB2_SECTION2_023_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_023_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_023_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_023_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_023_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_023_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_023_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_023_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_023_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_023_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_023_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_023_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_023_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_023_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_023_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_023_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_023_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_023_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_023_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_023_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_023_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_023_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_023_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_023_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_023_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_023_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_023_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_023_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_023_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_023_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_023_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_023_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_023_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_023_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_024_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_024_mod.F90 new file mode 100644 index 000000000..548fce784 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_024_mod.F90 @@ -0,0 +1,577 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_024_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_024_MOD' +MODULE GRIB2_SECTION2_024_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_024_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_024_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_024_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_024_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_024_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_024_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_024_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_024_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_024_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_024_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_024_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_024_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_024_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_024_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_024_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_024_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_024_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_024_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_024_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_024_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_024_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_024_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_024_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_024_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_024_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_024_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_024_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_024_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_024_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_024_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_024_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_024_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_024_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_026_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_026_mod.F90 new file mode 100644 index 000000000..eba0d6959 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_026_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_026_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_026_MOD' +MODULE GRIB2_SECTION2_026_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_026_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_026_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_026_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_026_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_026_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_026_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_026_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_026_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_026_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_026_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_026_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_026_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_026_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_026_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_026_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_026_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_026_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_026_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_026_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_026_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_026_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_026_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_026_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_026_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_026_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_026_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_026_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_026_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_026_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_026_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_026_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_026_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_026_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_027_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_027_mod.F90 new file mode 100644 index 000000000..e254c34fd --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_027_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_027_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_027_MOD' +MODULE GRIB2_SECTION2_027_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_027_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_027_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_027_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_027_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_027_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_027_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_027_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_027_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_027_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_027_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_027_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_027_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_027_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_027_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_027_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_027_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_027_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_027_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_027_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_027_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_027_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_027_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_027_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_027_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_027_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_027_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_027_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_027_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_027_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_027_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_027_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_027_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_027_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_030_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_030_mod.F90 new file mode 100644 index 000000000..cf8cec587 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_030_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_030_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_030_MOD' +MODULE GRIB2_SECTION2_030_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_030_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_030_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_030_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_030_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_030_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_030_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_030_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_030_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_030_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_030_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_030_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_030_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_030_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_030_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_030_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_030_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_030_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_030_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_030_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_030_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_030_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_030_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_030_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_030_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_030_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_030_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_030_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_030_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_030_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_030_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_030_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_030_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_030_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_036_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_036_mod.F90 new file mode 100644 index 000000000..157530093 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_036_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_036_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_036_MOD' +MODULE GRIB2_SECTION2_036_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_036_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_036_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_036_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_036_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_036_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_036_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_036_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_036_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_036_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_036_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_036_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_036_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_036_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_036_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_036_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_036_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_036_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_036_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_036_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_036_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_036_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_036_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_036_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_036_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_036_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_036_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_036_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_036_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_036_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_036_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_036_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_036_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_036_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_192_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_192_mod.F90 new file mode 100644 index 000000000..bcb2b90d0 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_192_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_192_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_192_MOD' +MODULE GRIB2_SECTION2_192_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION2_192_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION2_192_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION2_192_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION2_192_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION2_192_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION2_192_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION2_192_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_192_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_192_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_192_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_192_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_192_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_192_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_192_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_192_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_192_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_192_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_192_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_192_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_192_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_192_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_192_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_192_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_192_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_192_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_192_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_192_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_192_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_192_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION2_192_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION2_192_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_192_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_192_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_factory_mod.F90 new file mode 100644 index 000000000..f3ed48472 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section2/grib2_section2_factory_mod.F90 @@ -0,0 +1,223 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section2_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION2_000_MOD' +MODULE GRIB2_SECTION2_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION2_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION2_FACTORY' +FUNCTION GRIB2_SECTION2_FACTORY( GRIB_SECTION2, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION2_001_MOD, ONLY: GRIB2_SECTION2_001_T + PP_USE_L('T') :: GRIB2_SECTION2_007_MOD, ONLY: GRIB2_SECTION2_007_T + PP_USE_L('T') :: GRIB2_SECTION2_009_MOD, ONLY: GRIB2_SECTION2_009_T + PP_USE_L('T') :: GRIB2_SECTION2_015_MOD, ONLY: GRIB2_SECTION2_015_T + PP_USE_L('T') :: GRIB2_SECTION2_018_MOD, ONLY: GRIB2_SECTION2_018_T + PP_USE_L('T') :: GRIB2_SECTION2_023_MOD, ONLY: GRIB2_SECTION2_023_T + PP_USE_L('T') :: GRIB2_SECTION2_024_MOD, ONLY: GRIB2_SECTION2_024_T + PP_USE_L('T') :: GRIB2_SECTION2_026_MOD, ONLY: GRIB2_SECTION2_026_T + PP_USE_L('T') :: GRIB2_SECTION2_027_MOD, ONLY: GRIB2_SECTION2_027_T + PP_USE_L('T') :: GRIB2_SECTION2_030_MOD, ONLY: GRIB2_SECTION2_030_T + PP_USE_L('T') :: GRIB2_SECTION2_036_MOD, ONLY: GRIB2_SECTION2_036_T + PP_USE_L('T') :: GRIB2_SECTION2_192_MOD, ONLY: GRIB2_SECTION2_192_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION2 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_2=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + CASE( 1 ) + + ALLOCATE( GRIB2_SECTION2_001_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 7 ) + + ALLOCATE( GRIB2_SECTION2_007_T::GRIB_SECTION2 , STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 9 ) + + ALLOCATE( GRIB2_SECTION2_009_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 15 ) + + ALLOCATE( GRIB2_SECTION2_015_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 18 ) + + ALLOCATE( GRIB2_SECTION2_018_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 23 ) + + ALLOCATE( GRIB2_SECTION2_023_T::GRIB_SECTION2 , STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 24 ) + + ALLOCATE( GRIB2_SECTION2_024_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 26 ) + + ALLOCATE( GRIB2_SECTION2_026_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 27 ) + + ALLOCATE( GRIB2_SECTION2_027_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 30 ) + + ALLOCATE( GRIB2_SECTION2_030_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 36 ) + + ALLOCATE( GRIB2_SECTION2_036_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 192 ) + + ALLOCATE( GRIB2_SECTION2_192_T::GRIB_SECTION2, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_2 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION2%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section2 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section2 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section2 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing section2 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION2_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION2_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_040_mod.F90 b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_040_mod.F90 new file mode 100644 index 000000000..9e29009da --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_040_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section3_040_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION3_040_MOD' +MODULE GRIB2_SECTION3_040_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION3_040_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION3_040_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION3_040_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION3_040_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION3_040_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION3_040_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION3_040_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION3_040_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_040_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_040_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_040_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_040_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_040_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_040_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_040_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_040_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_040_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_040_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_040_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_040_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_040_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_040_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_040_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_040_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_040_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_040_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_040_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_040_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_040_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_040_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_040_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_040_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION3_040_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_050_mod.F90 b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_050_mod.F90 new file mode 100644 index 000000000..4e0a09ee7 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_050_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section3_050_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION3_050_MOD' +MODULE GRIB2_SECTION3_050_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION3_050_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION3_050_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION3_050_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION3_050_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION3_050_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION3_050_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION3_050_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION3_050_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_050_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_050_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_050_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_050_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_050_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_050_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_050_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_050_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_050_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_050_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_050_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_050_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_050_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_050_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_050_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_050_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_050_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_050_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_050_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_050_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_050_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_050_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_050_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_050_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION3_050_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_101_mod.F90 b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_101_mod.F90 new file mode 100644 index 000000000..0616709d2 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_101_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section3_101_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION3_101_MOD' +MODULE GRIB2_SECTION3_101_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION3_101_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION3_101_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION3_101_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION3_101_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION3_101_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION3_101_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION3_101_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION3_101_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_101_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_101_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_101_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_101_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_101_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_101_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_101_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_101_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_101_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_101_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_101_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_101_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_101_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_101_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_101_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_101_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_101_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_101_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_101_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_101_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_101_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION3_101_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION3_101_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_101_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION3_101_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_factory_mod.F90 new file mode 100644 index 000000000..f1dab2c7b --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section3/grib2_section3_factory_mod.F90 @@ -0,0 +1,170 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section3_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION3_000_MOD' +MODULE GRIB2_SECTION3_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION3_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION3_FACTORY' +FUNCTION GRIB2_SECTION3_FACTORY( GRIB_SECTION3, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION3_040_MOD, ONLY: GRIB2_SECTION3_040_T + PP_USE_L('T') :: GRIB2_SECTION3_050_MOD, ONLY: GRIB2_SECTION3_050_T + PP_USE_L('T') :: GRIB2_SECTION3_101_MOD, ONLY: GRIB2_SECTION3_101_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION3 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_3=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + + CASE( 40 ) + + ALLOCATE( GRIB2_SECTION3_040_T::GRIB_SECTION3, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 50 ) + + ALLOCATE( GRIB2_SECTION3_050_T::GRIB_SECTION3, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 101 ) + + ALLOCATE( GRIB2_SECTION3_101_T::GRIB_SECTION3, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_3 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION3%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section3 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section3 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section3 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing section3 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION3_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION3_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_000_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_000_mod.F90 new file mode 100644 index 000000000..f03f92015 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_000_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_000_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_000_MOD' +MODULE GRIB2_SECTION4_000_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_000_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_000_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_000_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_000_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_000_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_000_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_000_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_000_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_000_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_000_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_000_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_000_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_000_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_000_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_000_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_000_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_000_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_000_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_000_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_000_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_000_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_000_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_000_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_000_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_000_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_000_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_000_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_000_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_001_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_001_mod.F90 new file mode 100644 index 000000000..4201a9a43 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_001_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_001_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_001_MOD' +MODULE GRIB2_SECTION4_001_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_001_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_001_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_001_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_001_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_001_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_001_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_001_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_001_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_001_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_001_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_001_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_001_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_001_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_001_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_001_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_001_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_001_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_001_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_001_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_001_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_001_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_001_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_001_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_001_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_001_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_001_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_001_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_001_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_001_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_001_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_001_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_001_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_001_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_008_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_008_mod.F90 new file mode 100644 index 000000000..acb9a54fa --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_008_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_008_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_008_MOD' +MODULE GRIB2_SECTION4_008_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_008_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_008_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_008_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_008_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_008_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_008_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_008_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_008_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_008_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_008_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_008_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_008_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_008_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_008_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_008_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_008_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_008_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_008_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_008_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_008_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_008_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_008_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_008_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_008_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_008_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_008_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_008_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_008_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_008_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_008_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_008_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_008_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_008_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_011_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_011_mod.F90 new file mode 100644 index 000000000..08f114ce9 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_011_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_011_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_011_MOD' +MODULE GRIB2_SECTION4_011_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_011_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_011_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_011_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_011_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_011_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_011_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_011_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_011_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_011_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_011_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_011_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_011_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_011_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_011_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_011_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_011_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_011_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_011_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_011_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_011_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_011_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_011_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_011_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_011_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_011_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_011_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_011_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_011_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_011_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_011_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_011_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_011_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_011_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_032_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_032_mod.F90 new file mode 100644 index 000000000..aa0bb0f5e --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_032_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_032_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_032_MOD' +MODULE GRIB2_SECTION4_032_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_032_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_032_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_032_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_032_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_032_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_032_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_032_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_032_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_032_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_032_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_032_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_032_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_032_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_032_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_032_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_032_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_032_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_032_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_032_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_032_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_032_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_032_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_032_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_032_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_032_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_032_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_032_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_032_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_032_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_032_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_032_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_032_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_032_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_040_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_040_mod.F90 new file mode 100644 index 000000000..0d7159dd6 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_040_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_040_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_040_MOD' +MODULE GRIB2_SECTION4_040_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_040_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_040_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_040_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_040_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_040_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_040_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_040_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_040_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_040_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_040_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_040_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_040_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_040_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_040_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_040_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_040_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_040_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_040_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_040_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_040_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_040_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_040_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_040_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_040_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_040_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_040_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_040_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_040_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_040_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_040_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_040_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_040_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_040_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_041_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_041_mod.F90 new file mode 100644 index 000000000..b2c469bbf --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_041_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_041_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_041_MOD' +MODULE GRIB2_SECTION4_041_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_041_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_041_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_041_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_041_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_041_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_041_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_041_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_041_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_041_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_041_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_041_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_041_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_041_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_041_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_041_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_041_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_041_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_041_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_041_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_041_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_041_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_041_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_041_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_041_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_041_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_041_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_041_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_041_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_041_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_041_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_041_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_041_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_041_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_099_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_099_mod.F90 new file mode 100644 index 000000000..cbebbed52 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_099_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_099_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_099_MOD' +MODULE GRIB2_SECTION4_099_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_099_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_099_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_099_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_099_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_099_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_099_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_099_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_099_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_099_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_099_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_099_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_099_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_099_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_099_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_099_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_099_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_099_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_099_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_099_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_099_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_099_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_099_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_099_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_099_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_099_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_099_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_099_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_099_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_099_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_099_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_099_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_099_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_099_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_103_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_103_mod.F90 new file mode 100644 index 000000000..793fe9991 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_103_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_103_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_103_MOD' +MODULE GRIB2_SECTION4_103_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION4_103_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION4_103_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION4_103_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION4_103_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION4_103_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION4_103_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION4_103_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_103_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_103_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_103_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_103_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_103_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_103_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_103_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_103_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_103_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_103_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_103_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_103_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_103_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_103_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_103_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_103_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_103_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_103_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_103_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_103_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_103_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_103_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION4_103_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION4_103_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_103_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_103_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_factory_mod.F90 new file mode 100644 index 000000000..4882215f5 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section4/grib2_section4_factory_mod.F90 @@ -0,0 +1,206 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section4_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION4_000_MOD' +MODULE GRIB2_SECTION4_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION4_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION4_FACTORY' +FUNCTION GRIB2_SECTION4_FACTORY( GRIB_SECTION4, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION4_000_MOD, ONLY: GRIB2_SECTION4_000_T + PP_USE_L('T') :: GRIB2_SECTION4_001_MOD, ONLY: GRIB2_SECTION4_001_T + PP_USE_L('T') :: GRIB2_SECTION4_008_MOD, ONLY: GRIB2_SECTION4_008_T + PP_USE_L('T') :: GRIB2_SECTION4_011_MOD, ONLY: GRIB2_SECTION4_011_T + PP_USE_L('T') :: GRIB2_SECTION4_032_MOD, ONLY: GRIB2_SECTION4_032_T + PP_USE_L('T') :: GRIB2_SECTION4_040_MOD, ONLY: GRIB2_SECTION4_040_T + PP_USE_L('T') :: GRIB2_SECTION4_041_MOD, ONLY: GRIB2_SECTION4_041_T + PP_USE_L('T') :: GRIB2_SECTION4_099_MOD, ONLY: GRIB2_SECTION4_099_T + PP_USE_L('T') :: GRIB2_SECTION4_103_MOD, ONLY: GRIB2_SECTION4_103_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION4 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_4=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + + CASE( 0 ) + + ALLOCATE( GRIB2_SECTION4_000_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 1 ) + + ALLOCATE( GRIB2_SECTION4_001_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 8 ) + + ALLOCATE( GRIB2_SECTION4_008_T::GRIB_SECTION4 , STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 11 ) + + ALLOCATE( GRIB2_SECTION4_011_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 32 ) + + ALLOCATE( GRIB2_SECTION4_032_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 40 ) + + ALLOCATE( GRIB2_SECTION4_040_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 41 ) + + ALLOCATE( GRIB2_SECTION4_041_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 99 ) + + ALLOCATE( GRIB2_SECTION4_099_T::GRIB_SECTION4 , STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 103 ) + + ALLOCATE( GRIB2_SECTION4_103_T::GRIB_SECTION4, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_4 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION4%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section4 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section4 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section4 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing section4 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION4_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION4_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_000_mod.F90 b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_000_mod.F90 new file mode 100644 index 000000000..520ecb3c2 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_000_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section5_000_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION5_000_MOD' +MODULE GRIB2_SECTION5_000_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION5_000_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION5_000_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION5_000_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION5_000_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION5_000_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION5_000_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION5_000_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION5_000_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_000_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_000_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_000_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_000_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_000_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_000_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_000_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_000_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_000_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_000_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_000_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_000_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_000_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_000_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_000_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_000_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_000_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_000_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_000_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION5_000_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_042_mod.F90 b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_042_mod.F90 new file mode 100644 index 000000000..f960be035 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_042_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section5_042_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION5_042_MOD' +MODULE GRIB2_SECTION5_042_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION5_042_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION5_042_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION5_042_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION5_042_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION5_042_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION5_042_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION5_042_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION5_042_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_042_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_042_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_042_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_042_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_042_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_042_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_042_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_042_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_042_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_042_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_042_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_042_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_042_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_042_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_042_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_042_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_042_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_042_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_042_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_042_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_042_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_042_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_042_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_042_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION5_042_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_051_mod.F90 b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_051_mod.F90 new file mode 100644 index 000000000..b716e6b3f --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_051_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section5_051_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION5_051_MOD' +MODULE GRIB2_SECTION5_051_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION5_051_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION5_051_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION5_051_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION5_051_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION5_051_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION5_051_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION5_051_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION5_051_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_051_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_051_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_051_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_051_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_051_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_051_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_051_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_051_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_051_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_051_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_051_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_051_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_051_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_051_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_051_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_051_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_051_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_051_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_051_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_051_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_051_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION5_051_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION5_051_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_051_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION5_051_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_factory_mod.F90 new file mode 100644 index 000000000..30549f048 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section5/grib2_section5_factory_mod.F90 @@ -0,0 +1,170 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section5_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION5_000_MOD' +MODULE GRIB2_SECTION5_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION5_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION5_FACTORY' +FUNCTION GRIB2_SECTION5_FACTORY( GRIB_SECTION5, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION5_001_MOD, ONLY: GRIB2_SECTION5_001_T + PP_USE_L('T') :: GRIB2_SECTION5_042_MOD, ONLY: GRIB2_SECTION5_042_T + PP_USE_L('T') :: GRIB2_SECTION5_051_MOD, ONLY: GRIB2_SECTION5_051_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION5 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_5=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + + CASE( 1 ) + + ALLOCATE( GRIB2_SECTION5_001_T::GRIB_SECTION5, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 42 ) + + ALLOCATE( GRIB2_SECTION5_042_T::GRIB_SECTION5, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE( 51 ) + + ALLOCATE( GRIB2_SECTION5_051_T::GRIB_SECTION5, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_5 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION5%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_5) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown section1 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section1 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating section1 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing section1 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION5_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION5_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section6/grib2_section6_000_mod.F90 b/src/ecom/grib_info/grib2/grib2_section6/grib2_section6_000_mod.F90 new file mode 100644 index 000000000..a3f743c40 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section6/grib2_section6_000_mod.F90 @@ -0,0 +1,580 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section6_000_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION6_000_MOD' +MODULE GRIB2_SECTION6_000_MOD + + ! Symbols imported from other modules within the project. + USE :: GRIB_SECTION_MOD, ONLY: GRIB_SECTION_BASE_A + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + + +!> +!> @class Grib2 section0 encoder +TYPE, EXTENDS(GRIB_SECTION_BASE_A) :: GRIB2_SECTION6_000_T + +CONTAINS + + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: INIT => GRIB2_SECTION6_000_INIT + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: ALLOCATE => GRIB2_SECTION6_000_ALLOCATE + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: PRESET => GRIB2_SECTION6_000_PRESET + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: NUMBER_OF_RUNTIME_OPS => GRIB2_SECTION6_000_GET_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: GET_RUNTIME_OPS => GRIB2_SECTION6_000_NUMBER_OF_RUNTIME_OPS + PUBLIC, PASS, PUBLIC, NON_OVERRIDABLE :: FREE => GRIB2_SECTION6_000_FREE + +END TYPE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION6_000_T + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_000_INIT' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION6_000_INIT( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION6_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_000_INIT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_000_ALLOCATE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION6_000_ALLOCATE( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION6_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_000_ALLOCATE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_000_PRESET' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION6_000_PRESET( THIS, PARAMS, MSG, METADATA, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + PP_USE_L('T') :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION6_000_T), INTENT(IN) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + CLASS(METADATA_BASE_A), POINTER, INTENT(INOUT) :: METADATA + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + PP_METADATA_ENTER_PROCEDURE( METADATA ) + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_METADATA_EXIT_PROCEDURE( METADATA ) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_000_PRESET +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_000_NUMBER_OF_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION6_000_NUMBER_OF_RUNTIME_OPS( THIS, PARAMS, MSG, NUM_RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MESSAGE_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION6_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM_RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_000_NUMBER_OF_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_000_GET_RUNTIME_OPS' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION6_000_GET_RUNTIME_OPS( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: RUNTIME_OP_CONTAINER_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION6_000_T), INTENT(INOUT) :: THIS + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), INTENT(INOUT) :: RUNTIME_OPS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_000_GET_RUNTIME_OPS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_000_FREE' +__THREAD_SAFE__ FUNCTION GRIB2_SECTION6_000_FREE( THIS, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + !> Dummy arguments + CLASS(GRIB2_SECTION6_000_T), INTENT(INOUT) :: THIS + LOGICAL, INTENT(IN) :: VERBOSE + + !> Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_000_FREE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION6_000_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2/grib2_section6/grib2_section6_factory_mod.F90 b/src/ecom/grib_info/grib2/grib2_section6/grib2_section6_factory_mod.F90 new file mode 100644 index 000000000..62b548365 --- /dev/null +++ b/src/ecom/grib_info/grib2/grib2_section6/grib2_section6_factory_mod.F90 @@ -0,0 +1,158 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'grib2_section6_factory_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'GRIB2_SECTION6_000_MOD' +MODULE GRIB2_SECTION6_FACTORY_MOD + +IMPLICIT NONE + +!> +!> Default symbols visibility +PRIVATE + +!> Public symbols (dataTypes) +PUBLIC :: GRIB2_SECTION6_FACTORY + +CONTAINS + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'GRIB2_SECTION6_FACTORY' +FUNCTION GRIB2_SECTION6_FACTORY( GRIB_SECTION6, PARAMS, ID, CFG, VERBOSE ) RESULT(RET) + + !> Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: GRIB2_SECTION6_000_MOD, ONLY: GRIB2_SECTION6_000_T + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('T') :: OM_DATA_TYPES_MOD, ONLY: MODEL_PAR_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CLASS(GRIB_SECTION_BASE_A), POINTER, INTENT(INOUT) :: GRIB_SECTION6 + TYPE(MODEL_PAR_T), INTENT(IN) :: PARAMS + INTEGER(KIND=JPIB_K), INTENT(IN) :: ID + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNKNOWN_SECTION_6=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INITIALIZATION_ERROR=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialize the section + SELECT CASE( ID ) + + CASE( 0 ) + + ALLOCATE( GRIB2_SECTION6_000_T::GRIB_SECTION6, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + CASE DEFAULT + + PP_DEBUG_CRITICAL_THROW( ERRFLAG_UNKNOWN_SECTION_6 ) + + END SELECT + + !> Initialization of the section + PP_TRYCALL(ERRFLAG_INITIALIZATION_ERROR) GRIB2_SECTION6%INIT( PARAMS, CFG, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point (On success) + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMP + + TMP = REPEAT(' ', 32) + WRITE(TMP,'(I32)') ID + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNKNOWN_SECTION_6) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unknown SECTION6 number: '//TRIM(ADJUSTL(TMP)) ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating SECTION6 number: '//TRIM(ADJUSTL(TMP)) ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating SECTION6 number: '//TRIM(ADJUSTL(TMP))//' : '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_INITIALIZATION_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error initializing SECTION6 number: '//TRIM(ADJUSTL(TMP)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GRIB2_SECTION6_FACTORY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE GRIB2_SECTION6_FACTORY_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME diff --git a/src/ecom/grib_info/grib2_encoder_mod.F90 b/src/ecom/grib_info/grib2_encoder_mod.F90 new file mode 100644 index 000000000..f2aa812d1 --- /dev/null +++ b/src/ecom/grib_info/grib2_encoder_mod.F90 @@ -0,0 +1,40 @@ +MODULE GRIB2_ENCODER_MOD +IMPLICIT NONE + + +TYPE, EXTENDS(ENCODER_BASE_T) :: GRIB2_ENCODER_T + + !> Default visibility of the class + PRIVATE + + !> Sample + CLASS(SAMPLE_LOADER_T), POINTER :: SAMPLE_LOADER => NULL() + + !> Preset actions + CLASS(GRIB2_SECTION1_PRESET_ENCODER_T), POINTER :: SECTION1_PRESET_ENCODER_ => NULL() + CLASS(GRIB2_SECTION2_PRESET_ENCODER_T), POINTER :: SECTION2_PRESET_ENCODER_ => NULL() + CLASS(GRIB2_SECTION3_PRESET_ENCODER_T), POINTER :: SECTION3_PRESET_ENCODER_ => NULL() + CLASS(GRIB2_SECTION4_PRESET_ENCODER_T), POINTER :: SECTION4_PRESET_ENCODER_ => NULL() + CLASS(GRIB2_SECTION5_PRESET_ENCODER_T), POINTER :: SECTION5_PRESET_ENCODER_ => NULL() + + !> Runtime actions + CLASS(GRIB2_SECTION4_RUNTIME_ENCODER_T), POINTER :: SECTION4_RUNTIME_ENCODER_ => NULL() + +CONTAINS + + !> Initialize encoders (read configuration from yaml and allocate/initialize all the fields) + PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: INIT => ENCODER_INIT + + !> Load and preset the grib sample + PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: PRESET => ENCODER_PRESET + + !> Finalize the encoding of the grib sample + PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: ENCODE => ENCODER_ENCODE + + !> Free the memory allocated by the encoder + PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: FREE => ENCODER_FREE +END TYPE + +CONTAINS + +END MODULE GRIB2_ENCODER_MOD \ No newline at end of file diff --git a/src/ecom/grib_info/grib_section_mod.F90 b/src/ecom/grib_info/grib_section_mod.F90 new file mode 100644 index 000000000..27eda761b --- /dev/null +++ b/src/ecom/grib_info/grib_section_mod.F90 @@ -0,0 +1,94 @@ +MODULE GRIB_SECTION_MOD + +IMPLICIT NONE + + + +TYPE, ABSTRACT :: GRIB_SECTION_BASE_A + +CONTAINS + + PUBLIC(GRIB_SECTION_INIT_IF), DEFERRED, PASS, PUBLIC :: INIT + PUBLIC(GRIB_SECTION_ALLOCATE_IF), DEFERRED, PASS, PUBLIC :: ALLOCATE + PUBLIC(GRIB_SECTION_PRESET_IF), DEFERRED, PASS, PUBLIC :: PRESET + PUBLIC(GRIB_SECTION_NUMBER_OF_RUNTIME_OPS_IF), DEFERRED, PASS, PUBLIC :: NUMBER_OF_RUNTIME_OPS + PUBLIC(GRIB_SECTION_GET_RUNTIME_OPS_IF), DEFERRED, PASS, PUBLIC :: GET_RUNTIME_OPS + PUBLIC(GRIB_SECTION_FREE_IF), DEFERRED, PASS, PUBLIC :: FREE + +END TYPE + + +ABSTACT INTERFACE +__THREAD_SAFE__ FUNCTION GRIB_SECTION_INIT_IF( THIS, PARAMS, CFG, VERBOSE ) RESULT(RET) + IMPORT :: GRIB_SECTION_BASE_A +IMPLICIT NONE +! Dummy arguments +CLASS(GRIB_SECTION_BASE_A), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG +LOGICAL, INTENT(IN) :: VERBOSE +! Function result +INTEGER(KIND=JPIB_K) :: RET +END FUNCTION GRIB_SECTION_INIT_IF + +__THREAD_SAFE__ FUNCTION GRIB_SECTION_ALLOCATE_IF( THIS, PARAMS, METADATA, VERBOSE ) RESULT(RET) + IMPORT :: GRIB_SECTION_BASE_A +IMPLICIT NONE +! Dummy arguments +CLASS(GRIB_SECTION_BASE_A), INTENT(IN) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +CLASS(METADATA_BASE_T), INTENT(INOUT) :: METADATA +LOGICAL, INTENT(IN) :: VERBOSE +! Function result +INTEGER(KIND=JPIB_K) :: RET +END FUNCTION GRIB_SECTION_ALLOCATE_IF + +__THREAD_SAFE__ FUNCTION GRIB_SECTION_PRESET_IF( THIS, PARAMS, METADATA, VERBOSE ) RESULT(RET) + IMPORT :: GRIB_SECTION_BASE_A +IMPLICIT NONE +! Dummy arguments +CLASS(GRIB_SECTION_BASE_A), INTENT(IN) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +CLASS(METADATA_BASE_T), INTENT(INOUT) :: METADATA +LOGICAL, INTENT(IN) :: VERBOSE +! Function result +INTEGER(KIND=JPIB_K) :: RET +END FUNCTION GRIB_SECTION_PRESET_IF + +__THREAD_SAFE__ FUNCTION GRIB_SECTION_GET_RUNTIME_OPS_IF( THIS, PARAMS, RUNTIME_OPS, VERBOSE ) RESULT(RET) + IMPORT :: GRIB_SECTION_BASE_A +IMPLICIT NONE +! Dummy arguments +CLASS(GRIB_SECTION_BASE_A), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(RUNTIME_OP_CONTAINER_T), DIMENSION(:), ALLOCATABLE, INTENT(IN) :: METADATA +LOGICAL, INTENT(IN) :: VERBOSE +! Function result +INTEGER(KIND=JPIB_K) :: RET +END FUNCTION GRIB_SECTION_GET_RUNTIME_OPS_IF + +__THREAD_SAFE__ FUNCTION GRIB_SECTION_NUMBER_OF_RUNTIME_OPS_IF( THIS, PARAMS, HAS_RUNTIME_OPS, VERBOSE ) RESULT(RET) + IMPORT :: GRIB_SECTION_BASE_A +IMPLICIT NONE +! Dummy arguments +CLASS(GRIB_SECTION_BASE_A), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +LOGICAL, INTENT(OUT) :: HAS_RUNTIME_OPS +LOGICAL, INTENT(IN) :: VERBOSE +! Function result +INTEGER(KIND=JPIB_K) :: RET +END FUNCTION GRIB_SECTION_NUMBER_OF_RUNTIME_OPS_IF + + +__THREAD_SAFE__ FUNCTION GRIB_SECTION_FREE_IF( THIS ) RESULT(RET) + IMPORT :: GRIB_SECTION_BASE_A +IMPLICIT NONE +! Dummy arguments +CLASS(GRIB_SECTION_BASE_A), INTENT(INOUT) :: THIS +! Function result +INTEGER(KIND=JPIB_K) :: RET +END FUNCTION GRIB_SECTION_FREE_IF + +END INTERFACE + +END MODULE GRIB_SECTION_MOD \ No newline at end of file diff --git a/src/ecom/grib_info/page_mod.F90 b/src/ecom/grib_info/page_mod.F90 new file mode 100644 index 000000000..657e6ae32 --- /dev/null +++ b/src/ecom/grib_info/page_mod.F90 @@ -0,0 +1,136 @@ +MODULE PAGE_MOD + IMPLICIT NONE + INTEGER, PARAMETER :: LINE_LENGTH = 128 + INTEGER, PARAMETER :: PAGE_LENGTH = 512 + INTEGER, PARAMETER :: ERR_STRING_TOO_LONG = -1 + + TYPE :: PAGE_T + CHARACTER(LEN=LINE_LENGTH), DIMENSION(PAGE_LENGTH), ALLOCATABLE :: LINES + INTEGER :: CURRENT_LINE, CURRENT_COL + CONTAINS + PROCEDURE :: INIT => PAGE_INIT + PROCEDURE :: WRITE => PAGE_WRITE + PROCEDURE :: WRITE_TRIM => PAGE_WRITE_TRIM + PROCEDURE :: NEW_LINE => PAGE_NEW_LINE + PROCEDURE :: PRINT => PAGE_PRINT + END TYPE + +CONTAINS + + SUBROUTINE PAGE_INIT(SELF) + CLASS(PAGE_T), INTENT(INOUT) :: SELF + ALLOCATE(SELF%LINES(PAGE_LENGTH)) + SELF%CURRENT_LINE = 1 ! START AT THE FIRST LINE + SELF%CURRENT_COL = 0 ! START AT THE FIRST COLUMN + END SUBROUTINE PAGE_INIT + + SUBROUTINE PAGE_NEW_LINE(SELF, IOS) + CLASS(PAGE_T), INTENT(INOUT) :: SELF + INTEGER, INTENT(OUT) :: IOS + ! MOVE TO THE NEXT LINE IF AVAILABLE + IF (SELF%CURRENT_LINE < PAGE_LENGTH) THEN + SELF%CURRENT_LINE = SELF%CURRENT_LINE + 1 + SELF%CURRENT_COL = 0 ! RESET COLUMN TO START OF THE NEW LINE + IOS = 0 + ELSE + IOS = 1 ! NO MORE LINES AVAILABLE, PAGE IS FULL + END IF + END SUBROUTINE PAGE_NEW_LINE + + RECURSIVE SUBROUTINE PAGE_WRITE(SELF, INPUT_STRING, ADVANCE, TRIM_STRING, IOS) + IMPLICIT NONE + + ! Dummy arguments + CLASS(PAGE_T), INTENT(INOUT) :: SELF + CHARACTER(LEN=*), INTENT(IN) :: INPUT_STRING + LOGICAL, OPTIONAL, INTENT(IN) :: ADVANCE + INTEGER, OPTIONAL, INTENT(OUT) :: IOS + LOGICAL, OPTIONAL, INTENT(IN) :: TRIM_STRING + + ! Local variables + INTEGER :: STR_LEN + LOGICAL :: LOC_ADVANCE + INTEGER :: LOC_IOS + LOGICAL :: LOC_TRIM_STRING + + IF ( PRESENT(ADVANCE) ) THEN + LOC_ADVANCE = ADVANCE + ELSE + LOC_ADVANCE = .TRUE. + ENDIF + + IF ( PRESENT(TRIM_STRING) ) THEN + LOC_TRIM_STRING = TRIM_STRING + ELSE + LOC_TRIM_STRING = .FALSE. + ENDIF + + + STR_LEN = LEN(INPUT_STRING) + + ! CHECK IF THE INPUT STRING IS LONGER THAN THE ALLOWED LINE LENGTH + IF ( (.NOT.LOC_TRIM_STRING) .AND. (STR_LEN.GT.LINE_LENGTH) ) THEN + IF ( PRESENT(IOS) ) THEN + IOS = ERR_STRING_TOO_LONG + ENDIF + RETURN + END IF + + ! CHECK IF THE STRING FITS IN THE CURRENT LINE + IF (SELF%CURRENT_COL + STR_LEN <= LINE_LENGTH) THEN + ! IT FITS, SO APPEND TO THE CURRENT LINE + SELF%LINES(SELF%CURRENT_LINE)(SELF%CURRENT_COL+1:SELF%CURRENT_COL+STR_LEN) = INPUT_STRING + + IF ( LOC_ADVANCE ) THEN + SELF%CURRENT_COL = SELF%CURRENT_COL + STR_LEN + ENDIF + IF ( PRESENT(IOS) ) THEN + IOS = 0 + ENDIF + + ELSE + + ! MOVE TO THE NEXT LINE + CALL SELF%NEW_LINE(IOS) + + ! IF THERE'S NO SPACE LEFT, RETURN ERROR + IF (IOS /= 0) RETURN + + ! WRITE THE STRING TO THE NEW LINE (STARTING FROM THE BEGINNING OF THE LINE) + CALL SELF%WRITE( INPUT_STRING, LOC_ADVANCE, LOC_TRIM_STRING, IOS ) + + END IF + END SUBROUTINE PAGE_WRITE + + RECURSIVE SUBROUTINE PAGE_WRITE_TRIM(SELF, INPUT_STRING, IOS ) + CLASS(PAGE_T), INTENT(INOUT) :: SELF + CHARACTER(LEN=*), INTENT(INOUT) :: INPUT_STRING + INTEGER, INTENT(OUT) :: IOS + LOGICAL, OPTIONAL, INTENT(IN) :: ADVANCE + INTEGER :: STR_LEN, REMAINING_SPACE + + STR_LEN = LEN_TRIM(INPUT_STRING) + + ! CALCULATE REMAINING SPACE IN THE CURRENT LINE + REMAINING_SPACE = LINE_LENGTH - SELF%CURRENT_COL + + ! IF THE STRING FITS IN THE CURRENT LINE, APPEND IT + IF (STR_LEN <= REMAINING_SPACE) THEN + SELF%LINES(SELF%CURRENT_LINE)(SELF%CURRENT_COL+1:SELF%CURRENT_COL+STR_LEN) = INPUT_STRING + SELF%CURRENT_COL = SELF%CURRENT_COL + STR_LEN + IOS = 0 ! SUCCESS + ELSE + ! FILL THE REST OF THE CURRENT LINE WITH PART OF THE STRING + SELF%LINES(SELF%CURRENT_LINE)(SELF%CURRENT_COL+1:LINE_LENGTH) = INPUT_STRING(1:REMAINING_SPACE) + CALL SELF%NEW_LINE(IOS) + + ! IF THERE IS NO SPACE LEFT, RETURN ERROR + IF (IOS /= 0) RETURN + + ! WRITE THE REMAINING PART OF THE STRING TO THE NEW LINE + INPUT_STRING = INPUT_STRING(REMAINING_SPACE+1:) + CALL SELF%WRITE_TRIM(INPUT_STRING, IOS) + END IF + END SUBROUTINE PAGE_WRITE_TRIM + +END MODULE PAGE_MOD \ No newline at end of file diff --git a/src/ecom/grib_info/plan_mod.F90 b/src/ecom/grib_info/plan_mod.F90 new file mode 100644 index 000000000..cc7c9031b --- /dev/null +++ b/src/ecom/grib_info/plan_mod.F90 @@ -0,0 +1,230 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'plan_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'PLAN_MOD' +MODULE PLAN_MOD + +IMPLICIT NONE + +PRIVATE + + +TYPE :: ENCODING_INFO_T + + !> Default visibility of the class + PRIVATE + + !> Set of plans used to encode the data + TYPE(SPECIALIZED_PLAN_T), DIMENSION(:), POINTER :: PLANS_ => NULL() + +CONTAINS + + !> Initialize the encoding info + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: INIT => ENCODING_INFO_INIT + + !> Encode the message + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: ENCODE => ENCODING_INFO_ENCODE + + !> Free all the memory allocated by the encoding info + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: FREE => ENCODING_INFO_FREE + +END TYPE + + + + +TYPE :: PLAN_T + + !> Default visibility of the class + PRIVATE + + !> Set of filters used to select the data to be encoded + CLASS(FILTER_BASE_T), POINTER :: FILTER_ => NULL() + + !> Set of mappings used to remap the data before encoding + CLASS(MAPPINGS_BASE_T), POINTER :: MAPPINGS_ => NULL() + + !> Set of actions used to encode a GRIB message + CLASS(PRESET_ENCODER_BASE_T), POINTER :: PRESET_ENCODER_ => NULL() + + !> Set of actions used to encode a GRIB message + CLASS(RUNTIME_ENCODER_BASE_T), POINTER :: RUNTIME_ENCODERS_ => NULL() + + !> Action used to set the values in the GRIB message + CLASS(VALUES_ENCODER_T), DIMENSION(:), POINTER :: VALUES_RUNTIME_ENCODERS_ => NULL() + + !> Set of sinks used to store the encoded data + CLASS(SINK_BASE_T), POINTER, DIMENSION(:) :: SINKS_ => NULL() + +CONTAINS + + !> Initialize the plan (read from yaml) + PROCEDURE, PUBLIC, PASS :: INIT => PLAN_INIT + + !> If the message matches the message, search a valid mapping and + !> returns the specialized plan already preset + PROCEDURE, PUBLIC, PASS :: MATCH => PLAN_MATCH + + !> Free all the memory allocated by the plan + PROCEDURE, PUBLIC, PASS :: FREE => PLAN_FREE + +END TYPE + + +CONTAINS + +SUBROUTINE PLAN_INIT( THIS, PARAMS, CFG, VERBOSE ) +IMPLICIT NONE + +CLASS(PLAN_T), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG +LOGICAL, INTENT(IN) :: VERBOSE + +! Read the filter +RET = YAML_CONFIGURATION_HAS_KEY( CFG, "filter", HAS_FILTER, VERBOSE ) +PP_DEBUG_CRITICAL_COND_THROW( .NOT.HAS_FILTER, 1 ) +RET = YAML_GET_SUBCONFIGURATION( CFG, "filter", FILTER_RULES, VERBOSE ) +RET = READ_RULE_FILTER( FILTER_RULES, THIS%FILTER_, VERBOSE ) +RET = YAML_DELETE_CONFIGURATION( FILTER_RULES, VERBOSE ) + +! Read the mappings +RET = YAML_CONFIGURATION_HAS_KEY( CFG, "mapping", HAS_MAPPING, VERBOSE ) +IF ( HAS_MAPPING ) THEN + RET = YAML_GET_SUBCONFIGURATION( CFG, "mapping", MAPPING_RULES, VERBOSE ) + RET = READ_MAPPINGS( MAPPING_RULES, THIS%MAPPINGS_,VERBOSE ) + RET = YAML_DELETE_CONFIGURATION( MAPPING_RULES, VERBOSE ) +ENDIF + +! Read the encoder +RET = YAML_CONFIGURATION_HAS_KEY( CFG, "metadata-encoder", HAS_METADATA_ENCODER, VERBOSE ) +PP_DEBUG_CRITICAL_COND_THROW( .NOT.HAS_METADATA_ENCODER, 2 ) +RET = YAML_GET_SUBCONFIGURATION( CFG, "metadata-encoder", METADATA_ENCODER_RULES, VERBOSE ) +RET = READ_METADATA_ENCODER( METADATA_ENCODER_RULES, THIS%PRESET_ENCODER_, THIS%RUNTIME_ENCODERS_, VERBOSE ) +RET = YAML_DELETE_CONFIGURATION( METADATA_ENCODER_RULES, VERBOSE ) + +! Read value encoder +RET = YAML_CONFIGURATION_HAS_KEY( CFG, "values-encoder", HAS_VALUES_ENCODER, VERBOSE ) +IF ( HAS_VALUES_ENCODER ) THEN + RET = YAML_GET_SUBCONFIGURATION( CFG, "values-encoder", VALUES_ENCODER_RULES, VERBOSE ) + RET = READ_VALUES_ENCODER( VALUES_ENCODER_RULES, THIS%VALUES_RUNTIME_ENCODER_, VERBOSE ) + RET = YAML_DELETE_CONFIGURATION( VALUES_ENCODER_RULES, VERBOSE ) +ENDIF + +! Read the sinks +RET = YAML_CONFIGURATION_HAS_KEY( CFG, "sinks", HAS_SINKS, VERBOSE ) +PP_DEBUG_CRITICAL_COND_THROW( .NOT.HAS_SINKS, 3 ) +RET = YAML_GET_SUBCONFIGURATIONS( CFG, "sinks", SINKS_RULES, VERBOSE ) +RET = YAML_GET_CONFIGURATIONS_SIZE( SINKS_RULES, SINKS_SIZE, VERBOSE ) +ALLOCATE( THIS%SINKS_(SINKS_SIZE) ) +DO I = 1, SINKS_SIZE + RET = YAML_GET_CONFIGURATION_BY_IDX( SINKS_RULES, I, SINK_RULE, VERBOSE ) + RET = READ_SINK( SINK_RULE, THIS%SINKS_(I), VERBOSE ) + RET = YAML_DELETE_CONFIGURATION( SINK_RULE, VERBOSE ) +ENDDO +RET = YAML_DELETE_CONFIGURATIONS( SINKS_RULES, VERBOSE ) + +RETURN + +END SUBROUTINE PLAN_INIT + +SUBROUTINE PLAN_MATCH( THIS, PARAMS, MSG, MATCH, SPECIALIZED_PLAN, VERBOSE ) +IMPLICIT NONE + +! Dummy arguments +CLASS(PLAN_T), INTENT(INOUT) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(MESSAGE_T), INTENT(IN) :: MSG +LOGICAL, INTENT(OUT) :: MATCH +TYPE(SPECIALIZED_PLAN_T), POINTER, INTENT(OUT) :: SPECIALIZED_PLAN +LOGICAL, INTENT(IN) :: VERBOSE + +!> Check if the current message match the filter +CALL THIS%FILTER_%MATCH( PARAMS, MSG, MATCH, VERBOSE ) + +!> Allocate the specialized plan +ALLOCATE(SPECIALIZED_PLAN) + +!> Initialize the specialized plan +ALLOCATE( TIME_HIST ) +TIME_HIST%INIT( THIS%CAPACITY_ ) ! Todo: read capacity from yaml configutation + +! Allocate the metadata +IF ( .NOT. PRESENT(MULTIO_HANDLE) ) THEN + ALLOCATE( METADATA::GRIB_METADATA_T ) +ELSE + ALLOCATE( METADATA::MULTIO_METADATA_T ) +ENDIF + +! Initialize the sections +CALL THIS%FILTER_%MATCH( PARAMS, MSG, MATCH, PLAN, VERBOSE ) +CALL PLAN%MAPPINGS_%MATCH( PARAMS, MSG, MATCH, MAPPING, VERBOSE ) + +! Preset the sample +CALL PLAN%ENCODER%PRESET( PARAMS, METADATA, VERBOSE) + +! Get the runtime ops +CALL PLAN%ENCODER%GET_RUNTIME_OPS( PARAMS, MSG, RUNTIME_OPS, VERBOSE ) + +!> Initialize the specialized plan +CALL SPECIALIZED_PLAN%INIT( TIME_HIST, METADATA, MAPPING, THIS%VALUES_RUNTIME_ENCODER_, THIS%SINKS_, VERBOSE ) + +!> Exit with success +RETURN + +END SUBROUTINE PLAN_MATCH + +SUBROUTINE PLAN_FREE( THIS, VERBOSE ) +IMPLICIT NONE + +! Dummy arguments +CLASS(PLAN_T), INTENT(INOUT) :: THIS +LOGICAL, INTENT(IN) :: VERBOSE + +IF ( ASSOCIATED(THIS%FILTER_) ) THEN + CALL THIS%FILTER_%FREE() + DEALLOCATE(THIS%FILTER_) +ENDIF + +IF ( ASSOCIATED(THIS%MAPPINGS_) ) THEN + CALL THIS%MAPPINGS_%FREE() + DEALLOCATE(THIS%MAPPINGS_) +ENDIF + +IF ( ASSOCIATED(THIS%PRESET_ENCODER_) ) THEN + CALL THIS%PRESET_ENCOD_%FREE() + DEALLOCATE(THIS%PRESET_ENCODER_) +ENDIF + +IF ( ASSOCIATED(THIS%RUNTIME_ENCODER_) ) THEN + CALL THIS%RUNTIME_ENCODER_%FREE() + DEALLOCATE(THIS%RUNTIME_ENCODER_) +ENDIF + +IF ( ASSOCIATED(THIS%VALUES_RUNTIME_ENCODER_) ) THEN + CALL THIS%VALUES_RUNTIME_ENCODER_%FREE() + DEALLOCATE(THIS%VALUES_RUNTIME_ENCODER_) +ENDIF + +IF ( ASSOCIATED(THIS%SINKS_) ) THEN + DO I = 1, SIZE(THIS%SINKS_) + CALL THIS%SINKS_(I)%FREE() + ENDDO + DEALLOCATE(THIS%SINKS_) +ENDIF + +RETURN + + +END SUBROUTINE PLAN_FREE + +END MODULE PLAN_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/plans_mod.F90 b/src/ecom/grib_info/plans_mod.F90 new file mode 100644 index 000000000..013084340 --- /dev/null +++ b/src/ecom/grib_info/plans_mod.F90 @@ -0,0 +1,249 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'plans_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'PLANS_MOD' +MODULE PLANS_MOD + + !> Symbols imported from other modules within the project. + USE :: PLAN_MOD, ONLY: PLAN_T + USE :: PLAN_MOD, ONLY: SPECIALIZED_PLAN_T + +IMPLICIT NONE + +TYPE :: PLAN_NODE_T + + !> Set of plans readed from YAML files + TYPE(SPECIALIZED_PLAN_CONTAINER_T), POINTER, DIMENSION(:) :: SPLAN_ => NULL() + + TYPE(PLAN_NODE_T), POINTER :: NEXT_ => NULL() + +END TYPE + + +!> @class A class that contains a set of plans that can be used to encode a message +TYPE :: PLANS_T + + !> Default visibility of the class + PRIVATE + + !> YAML file name + CHARACTER(LEN=128) :: YAML_FILE_NAME=REPEAT(' ', 128) + + !> Set of plans readed from YAML files + + !> Theses are the default plans that are used to encode the messages + !> Default plans are the fallback solution when no specialized plan is found + TYPE(PLAN_T), DIMENSION(:), POINTER :: DEFAULT_PLANS_ => NULL() + + !> Theses are the specialized plans that are used to encode the messages + TYPE(PLAN_T), DIMENSION(:), POINTER :: SPECIAL_PLANS_ => NULL() + +CONTAINS + + !> Initialize the plans from the YAML files + PROCEDURE, PUBLIC, PASS :: INIT => PLANS_INIT + + !> Build an array of specialized plans from the plans + !> for all then plans that matches the message + PROCEDURE, PUBLIC, PASS :: MATCH => PLANS_MATCH + + !> Free all the memory allocated by the plans + PROCEDURE, PUBLIC, PASS :: FREE => PLANS_FREE + +END TYPE + + +!> Initialize the plans from the YAML files +PUBLIC :: PLANS_T + +CONTAINS + + +SUBROUTINE PLANS_INIT( THIS, PARAMS, YAML_FILE_NAME ) +IMPLICIT NONE + +!> Dummy arguments +CLASS(PLANS_T), INTENT(IN) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +CHARACTER(LEN=*), INTENT(IN) :: YAML_FILE_NAME + +!> Local variables +TYPE(YAML_CONFIGURATION_T) :: CFG +TYPE(YAML_CONFIGURATION_T) :: ENCODING_RULES +TYPE(YAML_CONFIGURATION_T) :: SPECIAL_ENCODING_RULE +TYPE(YAML_CONFIGURATION_T) :: DEFAULT_ENCODING_RULE +TYPE(YAML_CONFIGURATIONS_T) :: DEFAULT_ENCODING_RULES +TYPE(YAML_CONFIGURATIONS_T) :: SPECIAL_ENCODING_RULES +INTEGER(KIND=JPIB_K) :: I +LOGICAL :: VERBOSE + + +!> Initialize the plans filename +THIS%YAML_FILE_NAME = YAML_FILE_NAME + +!> Read the configuration from the YAML file +RET = YAML_NEW_CONFIGURATION_FROM_FILE( YAML_FILE_NAME, CFG, VERBOSE ) + +RET = YAML_GET_SUBCONFIGURATION( CFG, "encoding-rules", ENCODING_RULES, VERBOSE ) +RET = YAML_GET_SUBCONFIGURATIONS( ENCODING_RULES, "special-encoding-rules", SPECIAL_ENCODING_RULES, VERBOSE ) +RET = YAML_GET_SUBCONFIGURATIONS( ENCODING_RULES, "default-encoding-rules", DEFAULT_ENCODING_RULES, VERBOSE ) + +RET = YAML_GET_CONFIGURATIONS_SIZE( SPECIAL_ENCODING_RULES, SPECIAL_SIZE, VERBOSE ) +ALLOCATE(THIS%SPECIAL_PLANS_(SPECIAL_SIZE)) +DO I = 1, SPECIAL_SIZE + RET = YAML_GET_CONFIGURATION_BY_IDX( SPECIAL_ENCODING_RULES, I, SPECIAL_ENCODING_RULE, VERBOSE ) + RET = THIS%SPECIAL_PLANS_(I)%INIT( PARAMS, SPECIAL_ENCODING_RULE, VERBOSE ) + RET = YAML_DELETE_CONFIGURATION( SPECIAL_ENCODING_RULE, VERBOSE ) +ENDDO + + +RET = YAML_GET_CONFIGURATIONS_SIZE( DEFAULT_ENCODING_RULES, DEFAULT_SIZE, VERBOSE ) +ALLOCATE(THIS%DEFAULT_PLANS_(DEFAULT_SIZE)) +DO I = 1, DEFAULT_SIZE + RET = YAML_GET_CONFIGURATION_BY_IDX( DEFAULT_ENCODING_RULES, I, DEFAULT_ENCODING_RULE, VERBOSE ) + RET = THIS%SPECIAL_PLANS_(I)%INIT( PARAMS, DEFAULT_ENCODING_RULE, VERBOSE ) + RET = YAML_DELETE_CONFIGURATION( DEFAULT_ENCODING_RULE, VERBOSE ) +ENDDO + + +RET = YAML_DELETE_CONFIGURATIONS( DEFAULT_ENCODING_RULES, VERBOSE ) +RET = YAML_DELETE_CONFIGURATIONS( SPECIAL_ENCODING_RULES, VERBOSE ) +RET = YAML_DELETE_CONFIGURATION( ENCODING_RULES, VERBOSE ) + +RETURN + +END SUBROUTINE PLANS_INIT + + +SUBROUTINE PLANS_FREE( THIS ) +IMPLICIT NONE + +!> Dummy arguments +CLASS(PLANS_T), INTENT(INOUT) :: THIS + +INTEGER(KIND=JPIB_K) :: I + +THIS%YAML_FILE_NAME = REPEAT(' ', 128) + +DO I = 1, SIZE(THIS%DEFAULT_PLANS_) + CALL THIS%DEFAULT_PLANS_(I)%FREE() +ENDDO +DEALLOCATE(THIS%DEFAULT_PLANS_) + +DO I = 1, SIZE(THIS%SPECIAL_PLANS_) + CALL THIS%SPECIAL_PLANS_(I)%FREE() +ENDDO +DEALLOCATE(THIS%SPECIAL_PLANS_) + +RETURN + +END SUBROUTINE PLANS_FREE + + + +SUBROUTINE PLANS_MATCH( THIS, PARAMS, MSG, MATCH, ENCODING_INFO ) + + !> Symbols imported from other modules within the project. + USE :: MESSAGE_MOD, ONLY: MESSAGE_T + +IMPLICIT NONE + +!> Dummy arguments +CLASS(PLANS_T), INTENT(IN) :: THIS +TYPE(PARAMS_T), INTENT(IN) :: PARAMS +TYPE(MESSAGE_T), INTENT(IN) :: MSG +LOGICAL, INTENT(OUT) :: MATCH +TYPE(ENCODING_INFO_T), INTENT(OUT) :: ENCODING_INFO + +!> Local variables +TYPE(SPECIALIZED_PLAN_CONTAINER_T), POINTER, DIMENSION(:) :: CURR_PLAN +TYPE(PLAN_NODE_T), POINTER :: HEAD +TYPE(PLAN_NODE_T), POINTER :: CURR +INTEGER(KIND=JPIB_K) :: CNT +INTEGER(KIND=JPIB_K) :: I +LOGICAL :: MATCH + +!> Match the palns +CURR_PLAN => NULL() +HEAD => NULL() +CURR => NULL() +CNT = 0 +DO I = 1, SIZE(THIS%SPECIAL_PLANS_) + CALL THIS%SPECIAL_PLANS_(I)%MATCH( PARAMS, MSG, MATCH, CURR_PLAN ) + IF ( MATCH ) THEN + CNT = CNT + SIZE(CURR_PLAN) + ALLOCATE(CURR) + CURR%SPLAN_ => CURR_PLAN + CURR_PLAN => NULL() + IF ( .NOT. ASSOCIATED(HEAD) ) THEN + HEAD => CURR + ENDIF + CURR => CURR%NEXT_ + ENDIF +ENDDO + +IF ( CNT .EQ. 0 ) THEN + + DO I = 1, SIZE(THIS%DEFAULT_PLANS_) + CALL THIS%DEFAULT_PLANS_(I)%MATCH( PARAMS, MSG, MATCH, CURR_PLAN ) + IF ( MATCH ) THEN + CNT = CNT + SIZE(CURR_PLAN) + ALLOCATE(CURR) + CURR%SPLAN_ => CURR_PLAN + CURR_PLAN => NULL() + IF ( .NOT. ASSOCIATED(HEAD) ) THEN + HEAD => CURR + ENDIF + CURR => CURR%NEXT_ + ENDIF + ENDDO + + IF ( CNT .EQ. 0 ) THEN + WRITE(*,*) 'ERROR: No plan matched the message' + ELSEIF ( CNT .GT. 1 ) THEN + WRITE(*,*) 'ERROR: Multiple default plans matched the message' + ENDIF + +ENDIF + + +IF ( CNT .GT. 0 ) THEN + + + + !> Allocate the array of specialized plans + ALLOCATE(ENCODING_INFO%PLANS_(CNT)) + + !> Build the array of specialized plans + J = 0 + DO I = 1, CNT + DO K = 1, SIZE(CURR%SPLAN_) + J = J + 1 + ENCODING_INFO%PLANS_(K)%PLAN_ => CURR%SPLAN_(K)%SPLAN_ + ENDDO + CURR => CURR%NEXT_ + DEALLOCATE(HEAD) + HEAD => CURR + ENDDO + +ELSE + + WRITE(*,*) 'ERROR: No plan matched the message' + +ENDIF + +!> Exit point on success +RETURN + +END SUBROUTINE PLANS_MATCH + +END MODULE PLANS_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/specialized_plan_mod.F90 b/src/ecom/grib_info/specialized_plan_mod.F90 new file mode 100644 index 000000000..570285fa3 --- /dev/null +++ b/src/ecom/grib_info/specialized_plan_mod.F90 @@ -0,0 +1,185 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'specialized_plan_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'SPECIALIZED_PLAN_MOD' +MODULE SPECIALIZED_PLAN_MOD +IMPLICIT NONE + +PRIVATE + +!> A plan that has been already matched and needs to be added to the encoding info +TYPE :: SPECIALIZED_PLAN_CONTAINER_T + CLASS(SPECIALIZED_PLAN_T), POINTER :: SPLAN_ => NULL() +END TYPE + + +!> A plan that has been already matched and needs to be added to the encoding info +!> For a specific message +TYPE :: SPECIALIZED_PLAN_T + + !> Default visibility of the class + PRIVATE + + !> Track the last time a message arrived + CLASS(TIME_HISTORY_T), POINTER :: TIME_HIST_ => NULL() + + !> Metadata of the partially encoded grib message + CLASS(METADATA_BASE_A), POINTER :: METADATA_ => NULL() + + !> Set of mappings used to remap the data before encoding + CLASS(MAPPING_BASE_T), POINTER :: MAPPING_ => NULL() + + !> Set of actions used to encode a GRIB message + CLASS(RUNTIME_ENCODER_BASE_T), POINTER :: RUNTIME_ENCODER_ => NULL() + + !> Action used to set the values in the GRIB message + CLASS(VALUES_ENCODER_T), POINTER :: VALUES_RUNTIME_ENCODER_ => NULL() + + !> Set of sinks used to store the encoded data + CLASS(SINK_BASE_T), POINTER, DIMENSION(:) :: SINK_ => NULL() + +CONTAINS + + !> Initialize the specialized plan from the original plan + PROCEDURE, PUBLIC, PASS :: INIT => SPECIALIZED_PLAN_INIT + + !> Check if the current message needs to be encoded + PROCEDURE, PUBLIC, PASS :: TO_BE_ENCODED => SPECIALIZED_PLAN_TO_BE_ENCODED + + !> Encode the message (finalize the metadata encoding and set the values) + PROCEDURE, PUBLIC, PASS :: ENCODE => SPECIALIZED_PLAN_ENCODE + + !> Write all the encoded data with the sinks + PROCEDURE, PUBLIC, PASS :: SINK => SPECIALIZED_PLAN_SINK + + !> Free all the memory allocated by the plan + PROCEDURE, PUBLIC, PASS :: FREE => SPECIALIZED_PLAN_FREE + +END TYPE + + +PUBLIC :: SPECIALIZED_PLAN_T + +CONTAINS + + +SUBROUTINE SPECIALIZED_PLAN_INIT( THIS, TIME_HISTORY, METADATA, MAPPING, RUNTIME_ENCODER, VALUES_RUNTIME_ENCODER, SINKS, VERBOSE ) +IMPLICIT NONE + TYPE(SPECIALIZED_PLAN_T), INTENT(INOUT) :: THIS + CLASS(TIME_HISTORY_T), POINTER, INTENT(IN) :: TIME_HISTORY + CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA + CLASS(MAPPING_BASE_T), POINTER, INTENT(IN) :: MAPPING + CLASS(RUNTIME_ENCODER_BASE_T), POINTER, INTENT(IN) :: RUNTIME_ENCODER + CLASS(VALUES_ENCODER_T), POINTER, INTENT(IN) :: VALUES_RUNTIME_ENCODER + CLASS(SINK_BASE_T), POINTER, DIMENSION(:), INTENT(IN) :: SINKS + LOGICAL, INTENT(IN) :: VERBOSE + + THIS%TIME_HIST_ => TIME_HISTORY + THIS%METADATA_ => METADATA + THIS%MAPPING_ => MAPPING + THIS%RUNTIME_ENCODER_ => RUNTIME_ENCODER + THIS%VALUES_RUNTIME_ENCODER_ => VALUES_RUNTIME_ENCODER + THIS%SINKS_ => SINKS + + RETURN + +END SUBROUTINE SPECIALIZED_PLAN_INIT + + +SUBROUTINE SPECIALIZED_PLAN_TO_BE_ENCODED( THIS, PARAMS, MSG, CURR_TIME, TO_BE_ENCODED, VERBOSE ) +IMPLICIT NONE + TYPE(SPECIALIZED_PLAN_T), INTENT(INOUT) :: THIS + TYPE(PARAMS_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + TYPE(CURRENT_TIME_T), INTENT(IN) :: CURR_TIME + LOGICAL, INTENT(OUT) :: TO_BE_ENCODED + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(MESSAGE_T) :: MAPPED_MSG + + CALL THIS%MAPPING_%APPLY(PARAMS, MSG, MAPPED_MSG, VERBOSE) + + CALL THIS%RUNTIME_ENCODER_%TO_BE_ENCODED(PARAMS, MAPPED_MSG, CURR_TIME, THIS%TIME_HIST_, TO_BE_ENCODED, VERBOSE) + + RETURN + +END SUBROUTINE SPECIALIZED_PLAN_TO_BE_ENCODED + + +SUBROUTINE SPECIALIZED_PLAN_ENCODE( THIS, PARAMS, MSG, CURR_TIME, METADATA, VALUES, VERBOSE ) +IMPLICIT NONE + TYPE(SPECIALIZED_PLAN_T), INTENT(INOUT) :: THIS + TYPE(PARAMS_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + TYPE(CURRENT_TIME_T), INTENT(IN) :: CURR_TIME + LOGICAL, INTENT(OUT) :: TO_BE_ENCODED + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(MESSAGE_T) :: MAPPED_MSG + + CALL THIS%MAPPING_%APPLY(PARAMS, MSG, MAPPED_MSG, VERBOSE) + + CALL THIS%RUNTIME_ENCODER_%ENCODE( PARAMS, MAPPED_MSG, CURR_TIME, THIS%TIME_HIST_, METADATA, VERBOSE) + + CALL THIS%VALUES_RUNTIME_ENCODER_%ENCODE( PARAMS, MAPPED_MSG, METADATA, VERBOSE) + + RETURN + +END SUBROUTINE SPECIALIZED_PLAN_ENCODE + + +SUBROUTINE SPECIALIZED_PLAN_SINK( THIS, METADATA, VERBOSE ) +IMPLICIT NONE + TYPE(SPECIALIZED_PLAN_T), INTENT(INOUT) :: THIS + TYPE(PARAMS_T), INTENT(IN) :: PARAMS + TYPE(MESSAGE_T), INTENT(IN) :: MSG + TYPE(CURRENT_TIME_T), INTENT(IN) :: CURR_TIME + LOGICAL, INTENT(OUT) :: TO_BE_ENCODED + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(MESSAGE_T) :: MAPPED_MSG + INTEGER(KIND-JPIB_K) :: I + + DO I = 1, SIZE(THIS%SINKS_) + CALL THIS%SINKS_(I)%WRITE( THIS%METADATA_, VERBOSE ) + END DO + + RETURN + +END SUBROUTINE SPECIALIZED_PLAN_SINK + + +SUBROUTINE SPECIALIZED_PLAN_FREE( THIS, VERBOSE ) +IMPLICIT NONE + TYPE(SPECIALIZED_PLAN_T), INTENT(INOUT) :: THIS + CLASS(TIME_HISTORY_T), POINTER, INTENT(IN) :: TIME_HISTORY + CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA + CLASS(MAPPING_BASE_T), POINTER, INTENT(IN) :: MAPPING + CLASS(RUNTIME_ENCODER_BASE_T), POINTER, INTENT(IN) :: RUNTIME_ENCODER + CLASS(VALUES_ENCODER_T), POINTER, INTENT(IN) :: VALUES_RUNTIME_ENCODER + CLASS(SINK_BASE_T), POINTER, DIMENSION(:), INTENT(IN) :: SINKS + + THIS%TIME_HIST_ => NULL() + THIS%METADATA_ => NULL() + THIS%MAPPING_ => NULL() + THIS%RUNTIME_ENCODER_ => NULL() + THIS%VALUES_RUNTIME_ENCODER_ => NULL() + THIS%SINKS_ => NULL() + + RETURN + +END SUBROUTINE SPECIALIZED_PLAN_FREE + +END MODULE SPECIALIZED_PLAN_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/yaml_core_utils_mod.F90 b/src/ecom/grib_info/yaml_core_utils_mod.F90 new file mode 100644 index 000000000..4f7a32f5a --- /dev/null +++ b/src/ecom/grib_info/yaml_core_utils_mod.F90 @@ -0,0 +1,4089 @@ +!> +!> @file yaml_core_utils_mod.f90 +!> +!> @brief Provides utility routines for handling YAML configurations. +!> +!> This module contains various routines for managing YAML configurations, including reading, +!> creating, and manipulating configurations from files or memory. It supports functionalities such +!> as retrieving, deleting, and checking configurations, as well as handling errors and debugging. +!> +!> @section Public DataTypes +!> The module defines the following types: +!> - @ref YAML_CONFIGURATION_T +!> - @ref YAML_CONFIGURATIONS_T +!> +!> @section Public Interfaces +!> The module includes the following interfaces: +!> - @ref FUN_C2I_IF +!> +!> @section Public Routines +!> The module includes the following procedures: +!> - @ref YAML_NEW_CONFIGURATION_FROM_FILE +!> - @ref YAML_DELETE_CONFIGURATION +!> - @ref YAML_DELETE_CONFIGURATIONS +!> - @ref YAML_GET_SUBCONFIGURATION +!> - @ref YAML_GET_SUBCONFIGURATIONS +!> - @ref YAML_GET_CONFIGURATIONS_SIZE +!> - @ref YAML_GET_CONFIGURATION_BY_ID +!> - @ref YAML_CONFIGURATION_HAS_KEY +!> - @ref YAML_READ_STRING_ARRAY +!> - @ref YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> - @ref YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> - @ref YAML_READ_INTEGER_ARRAY +!> - @ref YAML_READ_FLOAT +!> - @ref YAML_READ_INTEGER +!> - @ref YAML_READ_STRING +!> - @ref YAML_READ_LOGICAL +!> +!> @section Private Routines +!> The module includes the following procedures: +!> - @ref READ_INTEGER_PATTERNS +!> - @ref READ_INTEGER +!> +!> @author Mirco Valentini +!> @date August, 2024 +!> + + +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'yaml_core_utils_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'MODULE YAML_CORE_UTILS_MOD' +MODULE YAML_CORE_UTILS_MOD + + !> Simbols imported from external libraries + PP_USE_E('P') :: FCKIT, ONLY: FCKIT_CONFIGURATION + +IMPLICIT NONE + +!> Default symbols visibility +PRIVATE + + +!> +!> @class main object representing a YAML configuration +TYPE :: YAML_CONFIGURATION_T + + !> Default symbols visibility + PRIVATE + + !> @brief Flag used to check if the configuration is allocated of just a reference + LOGICAL :: IS_ALLOCATED_ = .FALSE. + + !> @brief Pointer to the actual configuration object + TYPE(FCKIT_CONFIGURATION), POINTER : CFG_ => NULL() + +ENDTYPE + + +!> +!> @class object representing an array of YAML configurations +TYPE :: YAML_CONFIGURATIONS_T + + !> Default symbols visibility + PRIVATE + + !> @brief Pointer to the array of configurations + TYPE(FCKIT_CONFIGURATION), DIMENSION(:), POINTER :: CFGS_ => NULL() +ENDTYPE + + +!> +!> Interface for the function converting a characters to an integer +!> To be used for example when reading anumerators by name +INTERFACE + FUNCTION FUN_C2I_IF( CHAR, I ) RESULT( RET ) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + + IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: CHAR + INTEGER(KIND=JPIB_K), INTENT(OUT) :: I + INTEGER(KIND=ERR_K) :: RET + END FUNCTION FUN_C2I_IF +END INTERFACE + + +!> +!> Public symbols visibility (datatypes) +PUBLIC :: YAML_CONFIGURATION_T + +!> Public symbols visibility (interfaces) +PUBLIC :: FUN_C2I_IF + +!> Public symbols visibility (subroutines) +PUBLIC :: YAML_NEW_CONFIGURATION_FROM_FILE +PUBLIC :: YAML_DELETE_CONFIGURATION +PUBLIC :: YAML_DELETE_CONFIGURATIONS +PUBLIC :: YAML_GET_SUBCONFIGURATION +PUBLIC :: YAML_GET_SUBCONFIGURATIONS +PUBLIC :: YAML_GET_CONFIGURATIONS_SIZE +PUBLIC :: YAML_GET_CONFIGURATION_BY_ID +PUBLIC :: YAML_CONFIGURATION_HAS_KEY +PUBLIC :: YAML_READ_STRING_ARRAY +PUBLIC :: YAML_READ_INTEGER_ARRAY_WITH_FILTER +PUBLIC :: YAML_READ_INTEGER_ARRAY_WITH_RANGES +PUBLIC :: YAML_READ_INTEGER_ARRAY +PUBLIC :: YAML_READ_FLOAT +PUBLIC :: YAML_READ_INTEGER +PUBLIC :: YAML_READ_STRING +PUBLIC :: YAML_READ_LOGICAL + +CONTAINS + + +!> +!> @brief Creates a new YAML configuration from a file. +!> +!> This function reads a YAML file specified by `YAML_FILE_NAME` and creates a new YAML configuration, +!> which is then returned in the `VALUE` argument. The process can be controlled by the `VERBOSE` flag, +!> which enables additional output for debugging purposes. +!> +!> @section interface +!> @param [in] YAML_FILE_NAME The name of the YAML file from which the configuration will be read. +!> @param [out] VALUE The new YAML configuration object created from the file. +!> @param [in] VERBOSE Logical flag to enable verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the result of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection external dependencies +!> - @dependency [PROCEDURE] FCKIT_PATHNAME_MODULE::FCKIT_PATHNAME +!> - @dependency [PROCEDURE] FCKIT_CONFIGURATION_MODULE::FCKIT_YAMLCONFIGURATION +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_NEW_CONFIGURATION_FROM_FILE' +__THREAD_SAFE__ FUNCTION YAML_NEW_CONFIGURATION_FROM_FILE( YAML_FILE_NAME, VALUE, VERBOSE ) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported from other libraries + PP_USE_E('S') :: FCKIT_PATHNAME_MODULE, ONLY: FCKIT_PATHNAME + PP_USE_E('S') :: FCKIT_CONFIGURATION_MODULE, ONLY: FCKIT_YAMLCONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: YAML_FILE_NAME + TYPE(YAML_CONFIGURATION_T), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_ALREADY_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_ALLOCATED_FLAG=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_YAML_FILE_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_ALLOCATE_ERROR=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Erro handling + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(VALUE%CFG_), 1 ) + PP_DEBUG_CRITICAL_COND_THROW( VALUE%IS_ALLOCATED_, 2 ) + + ! Check if the file exsts + INQUIRE( FILE=TRIM(YAML_FILE_NAME), EXIST=EX ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, 1 ) + + ! Allocate the configuration + ALLOCATE( VALUE%CFG_, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, 1 ) + VALUE%IS_ALLOCATED_ = .TRUE. + + ! Load the configuration +!$omp critical(FCKIT_YAMLCONFIGURATION) + VALUE%CFG_ = FCKIT_YAMLCONFIGURATION( FCKIT_PATHNAME( TRIM(YAML_FILE_NAME) ) ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_ALREADY_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration already allocated' ) + CASE (ERRFLAG_CFG_ALLOCATED_FLAG) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'IS_ALLOCATED flag inconsistent with pointer allocation status' ) + CASE (ERRFLAG_YAML_FILE_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to find the YAML file to be read: '//TRIM(ADJUSTL(YAML_FILE_NAME)) ) + CASE (ERRFLAG_CFG_ALLOCATE_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating configuration' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating configuration: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_NEW_CONFIGURATION_FROM_FILE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Deletes a configuration from a YAML configuration object. +!> +!> This function removes a specific configuration from the provided YAML configuration object (`CFG`). +!> The removal process can be controlled by the `VERBOSE` flag, which enables additional output for +!> debugging purposes. If the configuration is allocated, the it will be deallocated, while if the +!> configuration is just a pointer to another configuration, then the pointer will be set to `NULL`. +!> +!> @section interface +!> @param [inout] CFG The YAML configuration object from which the configuration will be deleted. +!> @param [in] VERBOSE Logical flag to enable verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the result of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_DELETE_CONFIGURATIONS +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_DELETE_CONFIGURATION' +__THREAD_SAFE__ FUNCTION YAML_DELETE_CONFIGURATION( CFG, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(INOUT) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_CONFIGURATION=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + IF ( ASSOCIATED(CFG%CFG_) ) THEN + IF ( CFG%IS_ALLOCATED_ ) THEN +!$omp critical(FCKIT_YAMLCONFIGURATION) + CALL CFG%CFG_%FINAL() +!$omp end critical(FCKIT_YAMLCONFIGURATION) + DEALLOCATE( CFG%CFG_, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_CONFIGURATION ) + ELSE + NULLIFY( CFG%CFG_ ) + ENDIF + CFG%IS_ALLOCATED_ = .FALSE. + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_DEALLOC_CONFIGURATION) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating CONFIGURATIONS' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating CONFIGURATIONS: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_DELETE_CONFIGURATION +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Deletes configurations from a YAML configurations object. +!> +!> This function removes configurations from the provided YAML configurations object (`CFG`). +!> The operation can be controlled by the `VERBOSE` flag, which enables additional output for +!> debugging purposes. +!> +!> @section interface +!> @param [inout] CFG The YAML configurations object from which configurations will be deleted. +!> @param [in] VERBOSE Logical flag to enable verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the result of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATIONS_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection external dependencies +!> - @dependency [PROCEDURE] FCKIT_CONFIGURATION_MODULE::DEALLOCATE_FCKIT_CONFIGURATION +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_DELETE_CONFIGURATION +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_DELETE_CONFIGURATIONS' +__THREAD_SAFE__ FUNCTION YAML_DELETE_CONFIGURATIONS( CFG, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported from other libraries + PP_USE_E('S') :: FCKIT_CONFIGURATION_MODULE, ONLY: DEALLOCATE_FCKIT_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATIONS_T), INTENT(INOUT) :: CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_CONFIGURATIONS=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + IF ( ASSOCIATED(CFG%CFGS_) ) THEN + CALL DEALLOCATE_FCKIT_CONFIGURATION( CFG%CFGS_ ) + NULLIFY( CFG%CFGS_ ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_DELETE_CONFIGURATIONS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Retrieves a sub-configuration from a YAML configuration. +!> +!> This function extracts a specific sub-configuration from the provided YAML configuration object (`CFG`) +!> based on the given `KEY`. The extracted sub-configuration is stored in `VALUE`. The function supports +!> verbose output controlled by the `VERBOSE` flag for debugging purposes. +!> +!> @section interface +!> @param [in] CFG The main YAML configuration from which the sub-configuration is extracted. +!> @param [out] KEY The key identifying the sub-configuration within `CFG`. +!> @param [out] VALUE The sub-configuration extracted from `CFG` corresponding to the `KEY`. +!> @param [in] VERBOSE Logical flag to enable verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_GET_SUBCONFIGURATION' +__THREAD_SAFE__ FUNCTION YAML_GET_SUBCONFIGURATION( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(OUT) :: KEY + TYPE(YAML_CONFIGURATION_T), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + LOGICAL :: EX + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_SUBCCONFIGURATION=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(VALUE), ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED ) + + ! Initialize the output object + VALUE%CFG_ => NULL() + VALUE%IS_ALLOCATED_ = .FALSE. + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE%CFG_ ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_SUBCCONFIGURATION ) + VALUE%IS_ALLOCATED_ = .TRUE. + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Output string already allocated' ) + CASE (ERRFLAG_UNABLE_TO_SUBCCONFIGURATION) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read subconfiguration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_GET_SUBCONFIGURATION +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Retrieves sub-configurations from a YAML configuration. +!> +!> This function extracts sub-configurations from the provided YAML configuration object (`CFG`), +!> based on the specified `KEY`. The extracted sub-configurations are stored in `VALUE`. +!> Verbose output can be enabled via the `VERBOSE` flag for debugging purposes. +!> +!> @section interface +!> @param [in] CFG The main YAML configuration from which sub-configurations are extracted. +!> @param [out] KEY The key used to identify the sub-configurations within `CFG`. +!> @param [out] VALUE The sub-configurations extracted from `CFG` based on the `KEY`. +!> @param [in] VERBOSE Logical flag to enable verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> - @dependency [TYPE] YAML_CONFIGURATIONS_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_GET_SUBCONFIGURATIONS' +__THREAD_SAFE__ FUNCTION YAML_GET_SUBCONFIGURATIONS( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(OUT) :: KEY + TYPE(YAML_CONFIGURATIONS_T), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + LOGICAL :: EX + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_SUBCCONFIGURATIONS=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(VALUE), ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED ) + + ! Initialize the output object + VALUE%CFGS_ => NULL() + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE%CFGS_ ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_SUBCCONFIGURATIONS ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Output string already allocated' ) + CASE (ERRFLAG_UNABLE_TO_SUBCCONFIGURATION) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read subconfigurations' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_GET_SUBCONFIGURATIONS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Retrieves the size of the YAML configurations array. +!> +!> This function calculates the size of the given array of YAML configurations (`CFG`) +!> and returns the result in `CFG_SIZE`. It also supports verbose mode for debugging +!> purposes, providing additional output if needed. +!> +!> @section interface +!> @param [inout] CFG The array of YAML configurations whose size is being calculated. +!> @param [out] CFG_SIZE The size of the YAML configurations array. +!> @param [in] VERBOSE Logical flag to enable verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the function. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATIONS_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @section Error codes: +!> - `ERRFLAG_CFG_ARRAY_EMPTY` (301): The configurations array is empty. +!> - `ERRFLAG_CFG_ARRAY_CORRUPT` (302): The configurations array is corrupted or invalid. +!> +!> @see YAML_GET_CONFIGURATION_BY_ID +!> + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_GET_CONFIGURATIONS_SIZE' +__THREAD_SAFE__ FUNCTION YAML_GET_CONFIGURATIONS_SIZE( CFG, CFG_SIZE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATIONS_T), INTENT(INOUT) :: CFG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: CFG_SIZE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFGS_), ERRFLAG_CFGS_NOT_ALLOCATED ) + + ! Get the configuration size + CFG_SIZE = SIZE(GFG%CFGS_) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_GET_CONFIGURATIONS_SIZE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Retrieves a specific YAML configuration by its identifier. +!> +!> This subroutine retrieves a YAML configuration from a list of configurations (`CFG`) +!> using a specified configuration ID (`CFG_ID`). The retrieved configuration is stored +!> in `CURR_CFG`. Verbose mode can be enabled to display additional debug information during execution. +!> +!> @section interface +!> @param [inout] CFG The list of YAML configurations, from which one configuration is selected. +!> @param [out] CFG_ID The identifier of the YAML configuration to retrieve. +!> @param [out] CURR_CFG The YAML configuration that is retrieved based on `CFG_ID`. +!> @param [in] VERBOSE Logical flag for enabling verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the subroutine. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this subroutine: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> - @dependency [TYPE] YAML_CONFIGURATIONS_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_GET_CONFIGURATIONS_SIZE +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_GET_CONFIGURATION_BY_ID' +__THREAD_SAFE__ FUNCTION YAML_GET_CONFIGURATION_BY_ID( CFG, CFG_ID, CURR_CFG, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATIONS_T), INTENT(INOUT) :: CFG + INTEGER(KIND=JPIB_K), INTENT(OUT) :: CFG_ID + TYPE(YAML_CONFIGURATION_T), INTENT(OUT) :: CURR_CFG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_OUT_OF_BOUNDS_UB=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_OUT_OF_BOUNDS_LB=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFGS_), ERRFLAG_CFGS_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( CFG_ID.GT.SIZE(CFG%CFGS_), ERRFLAG_OUT_OF_BOUNDS_UB ) + PP_DEBUG_CRITICAL_COND_THROW( CFG_ID.LT.1, ERRFLAG_OUT_OF_BOUNDS_LB ) + + ! Initialize the output object + CURR_CFG%CFGS_ => NULL() + CURR_CFG%IS_ALLOCATED_ = .FALSE. + + ! Get the configuration + CURR_CFG%CFG_ => CFG%CFGS_(CFG_ID) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_OUT_OF_BOUNDS_UB) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Id out of bounds, bigger than the upper bound' ) + CASE (ERRFLAG_OUT_OF_BOUNDS_LB) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Id out of bounds, lower than 1' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_GET_CONFIGURATION_BY_ID +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Checks if a specified key exists in a YAML configuration. +!> +!> This function checks if a given key (`KEY`) exists in the YAML configuration object (`CFG`). +!> It returns a logical flag (`HAS_KEY`) indicating whether the key was found. If verbose mode +!> is enabled, additional information is printed during execution. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object in which the key is searched. +!> @param [in] KEY The key to search for in the YAML configuration. +!> @param [out] HAS_KEY Logical flag that indicates whether the key exists (`.TRUE.` if it exists). +!> @param [in] VERBOSE Logical flag for enabling verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the function. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_CONFIGURATION_HAS_KEY' +__THREAD_SAFE__ FUNCTION YAML_CONFIGURATION_HAS_KEY( CFG, KEY, HAS_KEY, VERBOSE ) RESULT(EXISTS) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(OUT) :: KEY + LOGICAL, INTENT(OUT) :: HAS_KEY + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + HAS_KEY = CFG%CFG_%HAS( KEY ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_CONFIGURATION_HAS_KEY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads a string array from a YAML configuration. +!> +!> This function reads a string array from a provided YAML configuration object (`CFG`) +!> using the specified key (`KEY`). The `VALUE` array is populated with the parsed strings. +!> If an error occurs during the process, the function returns an error code. Verbose mode can be +!> enabled to display additional debug information. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object from which the string array is read. +!> @param [in] KEY The key corresponding to the string array in the YAML configuration. +!> @param [out] VALUE The string array to be populated with the parsed values. +!> @param [in] VERBOSE Logical flag for enabling verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the function. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_FLOAT +!> @see YAML_READ_INTEGER +!> @see YAML_READ_LOGICAL +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> @see YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_STRING_ARRAY' +__THREAD_SAFE__ FUNCTION YAML_READ_STRING_ARRAY( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + CHARACTER(LEN=:), ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + LOGICAL :: EX + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_STRING_ARRAY=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(VALUE), ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_READ_STRING_ARRAY ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_STRING_ARRAY_ALSREADY_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Output string already allocated' ) + CASE (ERRFLAG_UNABLE_TO_READ_STRING_ARRAY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read string array' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_STRING_ARRAY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads an integer array from a YAML configuration with an applied filter. +!> +!> This function reads an integer array from a provided YAML configuration object (`CFG`) +!> using the specified key (`KEY`). The `VALUE` array is populated with the parsed integers, +!> applying the given filter (`FILTER`) to each element. The function returns an error code +!> indicating success or failure. If verbose mode is enabled, additional debug information is printed. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object from which the integer array is read. +!> @param [in] KEY The key corresponding to the integer array in the YAML configuration. +!> @param [out] VALUE The integer array to be populated with the parsed values. +!> @param [in] FILTER A function pointer that applies a filter to each element of the array. +!> @param [in] VERBOSE Logical flag for enabling verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the function. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> - @dependency [INTERFACE] FUN_C2I_IF +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_STRING +!> @see YAML_READ_FLOAT +!> @see YAML_READ_INTEGER +!> @see YAML_READ_LOGICAL +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_INTEGER_ARRAY_WITH_FILTER' +__THREAD_SAFE__ FUNCTION YAML_READ_INTEGER_ARRAY_WITH_FILTER( CFG, KEY, VALUE, FILTER, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + INTEGER(KIND=JPIB_K), ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: VALUE + PROCEDURE(FUN_C2I_IF), POINTER, INTENT(IN) :: FILTER + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + CHARACTER(LEN=:), ALLOCATABLE, DIMENSION(:) :: ATMP + INTEGER(KIND=JPIB_K) :: VALUE_SIZE + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_VALUE_ALREADY_ALLOCATED=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_NOT_ALLOCATED=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_SIZE_LT_1=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CALL_FILTER=6_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOCATION_ERROR=7_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(VALUE), ERRFLAG_VALUE_ALREADY_ALLOCATED ) + + ! Read the paramId as a string array + CALL YAML_READ_STRING_ARRAY( CFG, KEY, ATMP, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(ATMP), ERRFLAG_STRING_ARRAY_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(ATMP).LT.1, ERRFLAG_STRING_ARRAY_SIZE_LT_1 ) + + ! Allocate the paramId array + VALUE_SIZE = SIZE(ATMP) + ALLOCATE( VALUE(VALUE_SIZE), STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + ! Compute the size of the paramId array + ParamIdFIlterSizeLoop: DO I = 1, VALUE_SIZE + + ! Filter the value + PP_TRYCALL(ERRFLAG_CALL_FILTER) FILTER(ATMP(I), VALUE(I)) + + ENDDO ParamIdFIlterSizeLoop + + ! Deallocate temporary memory + IF ( ALLOCATED(ATMP) ) THEN + DEALLOCATE( ATMP, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_DEALLOCATION_ERROR ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'YAML configuration not allocated' ) + CASE (ERRFLAG_VALUE_ALREADY_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'VALUE already allocated' ) + CASE (ERRFLAG_STRING_ARRAY_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'String array not allocated after read' ) + CASE (ERRFLAG_STRING_ARRAY_SIZE_LT_1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'String array is empty' ) + CASE (ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating VALUES' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating VALUES: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_CALL_FILTER) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error calling filter' ) + CASE (ERRFLAG_DEALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating ATMP' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating ATMP: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_INTEGER_ARRAY_WITH_FILTER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads an integer array with ranges from a YAML configuration. +!> +!> This function reads an integer array from a provided YAML configuration object (`CFG`) +!> using the specified key (`KEY`). The `VALUE` array is populated with the parsed integers, +!> supporting ranges in the YAML configuration. The function returns an error code indicating +!> success or failure of the operation. If verbose mode is enabled, additional output is generated +!> for debugging purposes. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object from which the integer array is read. +!> @param [in] KEY The key corresponding to the integer array in the YAML configuration. +!> @param [out] VALUE The integer array to be populated with the parsed values, supporting ranges. +!> @param [in] VERBOSE Logical flag for enabling verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the function. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> - @dependency [PROCEDURE] YAML_READ_STRING_ARRAY +!> - @dependency [PROCEDURE] STRING_IS_INTEGER +!> - @dependency [PROCEDURE] STRING_IS_INTEGER_RANGE +!> - @dependency [PROCEDURE] STRING_IS_INTEGER_RANGE_BY +!> - @dependency [PROCEDURE] STRING_TO_INTEGER +!> - @dependency [PROCEDURE] STRING_TO_INTEGER_RANGE +!> - @dependency [PROCEDURE] STRING_TO_INTEGER_RANGE_BY +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> @see YAML_READ_STRING +!> @see YAML_READ_FLOAT +!> @see YAML_READ_LOGICAL +!> @see YAML_READ_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_INTEGER_ARRAY_WITH_RANGES' +__THREAD_SAFE__ FUNCTION YAML_READ_INTEGER_ARRAY_WITH_RANGES( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + INTEGER(KIND=JPIB_K), ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + CHARACTER(LEN=:), ALLOCATABLE, DIMENSION(:) :: ATMP + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: J + LOGICAL :: IS_INTEGER + LOGICAL :: IS_INTEGER_RANGE + LOGICAL :: IS_INTEGER_RANGE_BY + INTEGER(KIND=JPIB_K) :: LO + INTEGER(KIND=JPIB_K) :: HI + INTEGER(KIND=JPIB_K) :: BY + INTEGER(KIND=JPIB_K) :: VALUE_SIZE + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_NOT_ALLOCATED=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STRING_ARRAY_SIZE_LT_1=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_STRING_IN_ARRAY_1=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_STRING_IN_ARRAY_2=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_STRING_IN_ARRAY_3=6_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_STRING_IN_ARRAY_4=7_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_STRING_IN_ARRAY_5=8_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ALLOCATION_ERROR=10_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_VALUE_OUT_OF_BOUNDS=12_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOCATION_ERROR=13_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_VALUS_SIZE_LT_1=14_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the paramId as a string array + CALL YAML_READ_STRING_ARRAY( CFG, KEY, ATMP, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(ATMP), ERRFLAG_STRING_ARRAY_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(ATMP).LT.1, ERRFLAG_STRING_ARRAY_SIZE_LT_1 ) + + ! Compute the size of the paramId array + VALUE_SIZE = 0_JPIB_K + ParamIdFIlterSizeLoop: DO I = 1, SIZE(ATMP) + + ! Check if the value is an integer + CALL STRING_IS_INTEGER ( ATMP(I), IS_INTEGER, VERBOSE ) + CALL STRING_IS_INTEGER_RANGE ( ATMP(I), IS_INTEGER_RANGE, VERBOSE ) + CALL STRING_IS_INTEGER_RANGE_BY( ATMP(I), IS_INTEGER_RANGE_BY, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.IS_INTEGER .AND. .NOT.IS_INTEGER_RANGE .AND. .NOT.IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_1 ) + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER .AND. IS_INTEGER_RANGE .AND. IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_2 ) + + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER .AND. IS_INTEGER_RANGE, ERRFLAG_INVALID_STRING_IN_ARRAY_3 ) + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER .AND. IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_4 ) + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER_RANGE .AND. IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_5 ) + + ! Update the total size of the paramId array + IF ( IS_INTEGER ) THEN + VALUE_SIZE = VALUE_SIZE + 1 + ELSE IF ( IS_INTEGER_RANGE ) THEN + CALL STRING_TO_INTEGER_RANGE( ATMP(I), LO, HI, VERBOSE ) + VALUE_SIZE = VALUE_SIZE + HI - LO + 1 + ELSE IF ( IS_INTEGER_RANGE_BY ) THEN + CALL STRING_TO_INTEGER_RANGE_BY( ATMP(I), LO, HI, BY, VERBOSE ) + VALUE_SIZE = VALUE_SIZE + (HI - LO + 1)/BY + ENDIF + + ENDDO ParamIdFIlterSizeLoop + PP_DEBUG_CRITICAL_COND_THROW( VALUE_SIZE.LT.1, ERRFLAG_VALUS_SIZE_LT_1 ) + + ! Allocate the paramId array + ALLOCATE( VALUE(VALUE_SIZE), STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_ALLOCATION_ERROR ) + + ! Fill the paramId array + J = 0_JPIB_K + ParamIdFIlterFillLoop: DO I = 1, SIZE(ATMP) + + ! Check if the value is an integer + CALL STRING_IS_INTEGER( ATMP(I), IS_INTEGER, VERBOSE ) + CALL STRING_IS_INTEGER_RANGE( ATMP(I), IS_INTEGER_RANGE, VERBOSE ) + CALL STRING_IS_INTEGER_RANGE_BY( ATMP(I), IS_INTEGER_RANGE_BY, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.IS_INTEGER .AND. .NOT.IS_INTEGER_RANGE .AND. .NOT.IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_1 ) + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER .AND. IS_INTEGER_RANGE .AND. IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_2 ) + + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER .AND. IS_INTEGER_RANGE, ERRFLAG_INVALID_STRING_IN_ARRAY_3 ) + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER .AND. IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_4 ) + PP_DEBUG_CRITICAL_COND_THROW( IS_INTEGER_RANGE .AND. IS_INTEGER_RANGE_BY, ERRFLAG_INVALID_STRING_IN_ARRAY_5 ) + + + ! Update the total size of the paramId array + IF ( IS_INTEGER ) THEN + + ! Fill the paramId array when the item is an integer (e.g., 1) + J = J + 1 + PP_DEBUG_CRITICAL_COND_THROW( J.GT.SIZE(VALUE), ERRFLAG_VALUE_OUT_OF_BOUNDS ) + CALL STRING_TO_INTEGER( ATMP(I), VALUE(J), VERBOSE ) + + ELSE IF ( IS_INTEGER_RANGE ) THEN + + ! Fill the paramId array when the item is an integer range (e.g., 1:10) + CALL STRING_TO_INTEGER_RANGE( ATMP(I), LO, HI, VERBOSE ) + ParamIdFIlterFillRangeLoop: DO + J = J + 1 + PP_DEBUG_CRITICAL_COND_THROW( J.GT.SIZE(VALUE), ERRFLAG_VALUE_OUT_OF_BOUNDS ) + VALUE(J) = LO + IF ( LO .EQ. HI ) THEN + EXIT ParamIdFIlterFillRangeLoop + ENDIF + LO = LO + 1 + ENDDO ParamIdFIlterFillRangeLoop + + ELSE IF ( IS_INTEGER_RANGE_BY ) THEN + + ! Fill the paramId array when the item is an integer range by (e.g., 1:10:2) + CALL STRING_TO_INTEGER_RANGE_BY( ATMP(I), LO, HI, BY, VERBOSE ) + ParamIdFIlterFillRangeByLoop: DO + J = J + 1 + PP_DEBUG_CRITICAL_COND_THROW( J.GT.SIZE(VALUE), ERRFLAG_VALUE_OUT_OF_BOUNDS ) + VALUE(J) = LO + IF ( LO .EQ. HI ) THEN + EXIT ParamIdFIlterFillRangeByLoop + ENDIF + LO = LO + BY + ENDDO ParamIdFIlterFillRangeByLoop + + ENDIF + + ENDDO ParamIdFIlterFillLoop + + ! Deallocate temporary memory + IF ( ALLOCATED(ATMP) ) THEN + DEALLOCATE( ATMP, STAT=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS.NE.0, ERRFLAG_DEALLOCATION_ERROR ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE(ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'YAML configuration not allocated' ) + CASE(ERRFLAG_STRING_ARRAY_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'String array not allocated after read' ) + CASE(ERRFLAG_STRING_ARRAY_SIZE_LT_1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'String array is empty' ) + CASE(ERRFLAG_INVALID_STRING_IN_ARRAY_1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Error parsing string no matches (no integer, no integer range, no integer range by)' ) + CASE(ERRFLAG_INVALID_STRING_IN_ARRAY_2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Error parsing string multiple matches ( integer, integer range, integer range by)' ) + CASE(ERRFLAG_INVALID_STRING_IN_ARRAY_3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Error parsing string multiple matches (integer, integer range)' ) + CASE(ERRFLAG_INVALID_STRING_IN_ARRAY_4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Error parsing string multiple matches (integer, integer range by)' ) + CASE(ERRFLAG_INVALID_STRING_IN_ARRAY_5) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Error parsing string multiple matches (integer range, integer range by)' ) + CASE(ERRFLAG_ALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating VALUES' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error allocating VALUES: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE(ERRFLAG_VALUE_OUT_OF_BOUNDS) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Out of bounds while setting integer value to the output array' ) + CASE(ERRFLAG_DEALLOCATION_ERROR) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating ATMP' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating ATMP: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_VALUS_SIZE_LT_1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Value size is less than 1 after parsing all the elements' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_INTEGER_ARRAY_WITH_RANGES +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads an integer array from a YAML configuration. +!> +!> This function reads an integer array from a provided YAML configuration object (`CFG`) +!> using the specified key (`KEY`). The `VALUE` array is populated with the parsed integers. +!> If an error occurs during the reading process, the function returns an error code. Verbose mode +!> can be enabled for additional debugging information. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object from which the integer array is read. +!> @param [in] KEY The key corresponding to the integer array in the YAML configuration. +!> @param [out] VALUE The integer array to be populated with the parsed values. +!> @param [in] VERBOSE Logical flag for enabling verbose output (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating the outcome of the function. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_INTEGER_ARRAY' +__THREAD_SAFE__ FUNCTION YAML_READ_INTEGER_ARRAY( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + INTEGER(KIND=JPIB_K), ALLOCATABLE, DIMENSION(:), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_INTEGER_ARRAY=2_ERR_K + + + ! Local variables + LOGICAL :: EX + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_READ_INTEGER_ARRAY ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_UNABLE_TO_READ_INTEGER_ARRAY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read integer array' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_INTEGER_ARRAY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + +!> +!> @brief Reads a string value from a YAML configuration object. +!> +!> This function retrieves a string value from the specified YAML configuration (`CFG`) +!> using the given key (`KEY`) and assigns the result to the output variable (`VALUE`). +!> It supports a verbose mode for additional output during the operation. If an error occurs, +!> an error code is returned to indicate the issue. +!> +!> @section interface +!> +!> @param [in] CFG The YAML configuration object from which the string value is read. +!> @param [in] KEY The key used to extract the string value from the configuration. +!> @param [out] VALUE The string value extracted from the configuration, which is allocated +!> dynamically. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`). +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_FLOAT +!> @see YAML_READ_INTEGER +!> @see YAML_READ_LOGICAL +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> @see YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_STRING' +__THREAD_SAFE__ FUNCTION YAML_READ_STRING( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + CHARACTER(LNE=:), ALLOCATABLE, INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_STRING=2_ERR_K + + ! Local variables + LOGICAL :: EX + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_READ_STRING ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_UNABLE_TO_READ_STRING) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read string from configuration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_STRING +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads an integer value from a YAML configuration object. +!> +!> This function retrieves an integer value from the specified YAML configuration (`CFG`) +!> using the given key (`KEY`) and assigns the result to the output variable (`VALUE`). +!> It supports a verbose mode for additional output during the operation. If an error occurs, +!> an error code is returned to indicate the issue. +!> +!> @section interface +!> +!> @param [in] CFG The YAML configuration object from which the integer value is read. +!> @param [in] KEY The key used to extract the integer value from the configuration. +!> @param [out] VALUE The integer value extracted from the configuration. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`). +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_FLOAT +!> @see YAML_READ_LOGICAL +!> @see YAML_READ_STRING +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> @see YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_INTEGER' +__THREAD_SAFE__ FUNCTION YAML_READ_INTEGER( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + INTEGER(KIND=JPIB_K), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_INTEGER=2_ERR_K + + ! Local variables + LOGICAL :: EX + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_READ_INTEGER ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_UNABLE_TO_READ_INTEGER) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read integer from configuration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_INTEGER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads a floating-point value from a YAML configuration object. +!> +!> This function reads a floating-point value from the provided YAML configuration (`CFG`) +!> using the specified key (`KEY`) and assigns the result to the output variable (`VALUE`). +!> If an error occurs during the reading process, an appropriate error code is returned. +!> Verbose mode can be enabled for detailed output during the operation. +!> +!> @section interface +!> +!> @param [in] CFG The YAML configuration object from which the floating-point value is read. +!> @param [in] KEY The key used to retrieve the floating-point value from the configuration. +!> @param [out] VALUE The floating-point value extracted from the configuration. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`). +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection module dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPRD_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_LOGICAL +!> @see YAML_READ_INTEGER +!> @see YAML_READ_STRING +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> @see YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_FLOAT' +__THREAD_SAFE__ FUNCTION YAML_READ_FLOAT( CFG, KEY, VALUE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPRD_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=*), INTENT(IN) :: KEY + REAL(KIND=JPRD_K), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_FLOAT=2_ERR_K + + ! Local variables + LOGICAL :: EX + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_READ_FLOAT ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_UNABLE_TO_READ_FLOAT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read float from configuration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_FLOAT +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads a logical (boolean) value from a YAML configuration object. +!> +!> This function reads a logical (`TRUE` or `FALSE`) value from the provided YAML +!> configuration (`CFG`) and assigns it to the output logical variable (`VALUE`). +!> If an error occurs, it returns an appropriate error code. Verbose mode can be +!> enabled for detailed output during the process. +!> +!> @section interface +!> +!> @param [in] CFG The YAML configuration object from which the logical value is read. +!> @param [out] VALUE The logical value extracted from the configuration. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`). +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [TYPE] YAML_CONFIGURATION_T +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see YAML_READ_FLOAT +!> @see YAML_READ_INTEGER +!> @see YAML_READ_STRING +!> @see YAML_READ_STRING_ARRAY +!> @see YAML_READ_INTEGER_ARRAY +!> @see YAML_READ_INTEGER_ARRAY_WITH_RANGES +!> @see YAML_READ_INTEGER_ARRAY_WITH_FILTER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'YAML_READ_LOGICAL' +__THREAD_SAFE__ FUNCTION YAML_READ_LOGICAL( CFG, VALUE, VERBOSE ) RETURN(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_CFG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_LOGICAL=2_ERR_K + + ! Local variables + LOGICAL :: EX + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(CFG%CFG_), ERRFLAG_CFG_NOT_ALLOCATED ) + + ! Read the string +!$omp critical(FCKIT_YAMLCONFIGURATION) + EX = CFG%CFG_%GET( KEY, VALUE ) +!$omp end critical(FCKIT_YAMLCONFIGURATION) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.EX, ERRFLAG_UNABLE_TO_READ_LOGICAL ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_CFG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Configuration not allocated' ) + CASE (ERRFLAG_UNABLE_TO_READ_LOGICAL) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read bool from configuration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION YAML_READ_LOGICAL +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Checks if a string contains an integer. +!> +!> The function also supports a `VERBOSE` mode +!> for additional output during debugging or verbose operation. +!> +!> @section interface +!> @param [in] STRING Input string representing the range (e.g. "1:10"). +!> @param [out] MATCH True if the string has the format "LO:HI". +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return Integer error code (`RET`) indicating success or failure: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see STRING_IS_INTEGER_RANGE +!> @see STRING_IS_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'STRING_IS_INTEGER' +__THREAD_SAFE__ FUNCTION STRING_IS_INTEGER( STRING, MATCH, VERBOSE ) RETURN(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: COUNT + INTEGER(KIND=JPIB_K), DIMENSION(1) :: TMP + LOGICAL :: LTMP + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARSE_ERROR=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Parse the string + PP_TRYCALL(ERRFLAG_PARSE_ERROR) READ_INTEGER_PATTERNS( STRING, LTMP, COUNT, VERBOSE, VALUES=TMP ) + + ! Generate the match flag + MATCH = LTMP + + IF ( MATCH .AND. COUNT .NE. 2 ) THEN + MATCH = .FALSE. + ENDIF + + IF ( MATCH .AND. TMP(1).GT.TMP(2) ) THEN + MATCH = .FALSE. + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARSE_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to parse string: '//TRIM(ADJUSTL(STRING)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION STRING_IS_INTEGER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Check if a string contains a range of integers with a specified step. +!> +!> This function checks if a string represents a range in the form of "LO:HI" +!> The function also supports a `VERBOSE` mode +!> for additional output during debugging or verbose operation. +!> +!> @section interface +!> @param [in] STRING Input string representing the range (e.g. "1:10"). +!> @param [out] MATCH True if the string has the format "LO:HI". +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return Integer error code (`RET`) indicating success or failure: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see STRING_IS_INTEGER_RANGE +!> @see STRING_IS_INTEGER +!> +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'STRING_IS_INTEGER_RANGE' +__THREAD_SAFE__ FUNCTION STRING_IS_INTEGER_RANGE( STRING, MATCH, VERBOSE ) RETURN(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: COUNT + INTEGER(KIND=JPIB_K), DIMENSION(2) :: TMP + LOGICAL :: LTMP + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARSE_ERROR=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Parse the string + PP_TRYCALL(ERRFLAG_PARSE_ERROR) READ_INTEGER_PATTERNS( STRING, LTMP, COUNT, VERBOSE, VALUES=TMP ) + + ! Generate the match flag + MATCH = LTMP + + IF ( MATCH .AND. COUNT .NE. 2 ) THEN + MATCH = .FALSE. + ENDIF + + IF ( MATCH .AND. TMP(1).GT.TMP(2) ) THEN + MATCH = .FALSE. + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARSE_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to parse string: '//TRIM(ADJUSTL(STRING)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION STRING_IS_INTEGER_RANGE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Check if a string contains a range of integers with a specified step. +!> +!> This function checks if a string represents a range in the form of "LO:HI:BY" +!> The function also supports a `VERBOSE` mode +!> for additional output during debugging or verbose operation. +!> +!> @section interface +!> @param [in] STRING Input string representing the range (e.g. "1:10:2"). +!> @param [out] MATCH True if the string has the format "LO:HI:BY". +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return Integer error code (`RET`) indicating success or failure: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see STRING_IS_INTEGER_RANGE +!> @see STRING_IS_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'STRING_IS_INTEGER_RANGE_BY' +__THREAD_SAFE__ FUNCTION STRING_IS_INTEGER_RANGE_BY( STRING, MATCH, VERBOSE ) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: COUNT + INTEGER(KIND=JPIB_K), DIMENSION(3) :: TMP + LOGICAL :: LTMP + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARSE_ERROR=1_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Parse the string + PP_TRYCALL(ERRFLAG_PARSE_ERROR) READ_INTEGER_PATTERNS( STRING, LTMP, COUNT, VERBOSE, VALUES=TMP ) + + ! Generate the match flag + MATCH = LTMP + + IF ( MATCH .AND. COUNT .NE. 3 ) THEN + MATCH = .FALSE. + ENDIF + + IF ( MATCH .AND. TMP(1).GT.TMP(2) ) THEN + MATCH = .FALSE. + ENDIF + + IF ( MATCH .AND. TMP(3).LT.0 ) THEN + MATCH = .FALSE. + ENDIF + + IF ( MATCH .AND.TMP(3).GT.(TMP(2)-TMP(1)) ) THEN + MATCH = .FALSE. + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARSE_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to parse string: '//TRIM(ADJUSTL(STRING)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION STRING_IS_INTEGER_RANGE_BY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Converts a string to an integer value. +!> +!> This function parses the input `STRING` and converts it to an integer value (`VALUE`). +!> If the conversion fails, the function returns an error code. It also supports a +!> `VERBOSE` mode, which provides additional output for debugging purposes. +!> +!> @section interface +!> @param [in] STRING Input string representing the integer value. +!> @param [out] VALUE The resulting integer value. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return Integer error code (`RET`) indicating success or failure: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see STRING_TO_INTEGER_RANGE +!> @see STRING_IS_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'STRING_TO_INTEGER' +__THREAD_SAFE__ FUNCTION STRING_TO_INTEGER( STRING, VALUE, VERBOSE ) RETURN(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + INTEGER(KIND=JPIB_K), INTENT(OUT) :: VALUE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: COUNT + INTEGER(KIND=JPIB_K), DIMENSION(1) :: TMP + LOGICAL :: MATCH + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARSE_ERROR=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NO_MATCH=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_WRONG_COUNT=3_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Parse the string + PP_TRYCALL(ERRFLAG_PARSE_ERROR) READ_INTEGER_PATTERNS( STRING, MATCH, COUNT, VERBOSE, VALUES=TMP ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.MATCH, ERRFLAG_NO_MATCH ) + PP_DEBUG_CRITICAL_COND_THROW( COUNT.NE.1, ERRFLAG_WRONG_COUNT ) + + ! Assign the values + VALUE=TMP(1) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMPSTR1 + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARSE_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to parse string: '//TRIM(ADJUSTL(STRING)) ) + CASE (ERRFLAG_NO_MATCH) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'No match between string and expected pattern: '//TRIM(ADJUSTL(STRING)) ) + CASE (ERRFLAG_WRONG_COUNT) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') COUNT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Wrong count: expected=1, got='//TRIM(ADJUST(TMPSTR1)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION STRING_TO_INTEGER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Converts a string into a range of integers. +!> +!> This function parses a string representing a range in the form of "LO:HI" and +!> converts it into integers `LO` and `HI`. The function also supports a `VERBOSE` mode +!> for additional output during debugging or verbose operation. +!> +!> @section interface +!> @param [in] STRING Input string representing the range (e.g., "1:10"). +!> @param [out] LO The lower bound of the range (integer). +!> @param [out] HI The upper bound of the range (integer). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return Integer error code (`RET`) indicating success or failure: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see STRING_TO_INTEGER_RANGE_BY +!> @see STRING_IS_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'STRING_TO_INTEGER_RANGE' +__THREAD_SAFE__ FUNCTION STRING_TO_INTEGER_RANGE( STRING, LO, HI, VERBOSE ) RETURN(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + INTEGER(KIND=JPIB_K), INTENT(OUT) :: LO + INTEGER(KIND=JPIB_K), INTENT(OUT) :: HI + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: COUNT + INTEGER(KIND=JPIB_K), DIMENSION(2) :: TMP + LOGICAL :: MATCH + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARSE_ERROR=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NO_MATCH=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_WRONG_COUNT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_WRONG_RANGE=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Parse the string + PP_TRYCALL(ERRFLAG_PARSE_ERROR) READ_INTEGER_PATTERNS( STRING, MATCH, COUNT, VERBOSE, VALUES=TMP ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.MATCH, ERRFLAG_NO_MATCH ) + PP_DEBUG_CRITICAL_COND_THROW( COUNT.NE.2, ERRFLAG_WRONG_COUNT ) + PP_DEBUG_CRITICAL_COND_THROW( TMP(1).GT.TMP(2), ERRFLAG_WRONG_RANGE ) + + ! Assign the values + LO=TMP(1) + HI=TMP(2) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMPSTR1 + CHARACTER(LEN=32) :: TMPSTR2 + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARSE_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to parse string: '//TRIM(ADJUSTL(STRING)) ) + CASE (ERRFLAG_NO_MATCH) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'No match between string and expected pattern: '//TRIM(ADJUSTL(STRING)) ) + CASE (ERRFLAG_WRONG_COUNT) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') COUNT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Wrong count: expected=2, got='//TRIM(ADJUST(TMPSTR1)) ) + CASE (ERRFLAG_WRONG_RANGE) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') TMP(1) + TMPSTR2 = REPEAT(' ', 32) + WRITE(TMPSTR2, '(I32)') TMP(2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Wrong range lower bound bigger than the upper bound: lb='//TRIM(ADJUSTL(TMPSTR1))//', ub='//TRIM(ADJUSTL(TMPSTR2)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION STRING_TO_INTEGER_RANGE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Converts a string into a range of integers with a specified step. +!> +!> This function parses a string representing a range in the form of "LO:HI:BY" and +!> converts it into integers `LO`, `HI`, and `BY`. The function also supports a `VERBOSE` mode +!> for additional output during debugging or verbose operation. +!> +!> @section interface +!> @param [in] STRING Input string representing the range (e.g. "1:10:2" ). +!> @param [out] LO The lower bound of the range (integer). +!> @param [out] HI The upper bound of the range (integer). +!> @param [out] BY The step size between the lower and upper bounds (integer). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return Integer error code (`RET`) indicating success or failure: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER_PATTERNS +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] OM_CORE_MOD::JPIB_K +!> +!> @subsection special dependencies +!> - @dependency [*] PP_DEBUG_USE_VARS::* +!> - @dependency [*] PP_LOG_USE_VARS::* +!> - @dependency [*] PP_TRACE_USE_VARS::* +!> +!> @see STRING_TO_INTEGER_RANGE +!> @see STRING_TO_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'STRING_TO_INTEGER_RANGE_BY' +__THREAD_SAFE__ FUNCTION STRING_TO_INTEGER_RANGE_BY( STRING, LO, HI, BY, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + INTEGER(KIND=JPIB_K), INTENT(OUT) :: LO + INTEGER(KIND=JPIB_K), INTENT(OUT) :: HI + INTEGER(KIND=JPIB_K), INTENT(OUT) :: BY + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function result + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: COUNT + INTEGER(KIND=JPIB_K), DIMENSION(3) :: TMP + LOGICAL :: MATCH + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARSE_ERROR=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NO_MATCH=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_WRONG_COUNT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_WRONG_RANGE=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STEP_SIGN=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_STEP_SIZE=6_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Parse the string + PP_TRYCALL(ERRFLAG_PARSE_ERROR) READ_INTEGER_PATTERNS( STRING, MATCH, COUNT, VERBOSE, VALUES=TMP ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.MATCH, ERRFLAG_NO_MATCH ) + PP_DEBUG_CRITICAL_COND_THROW( COUNT.NE.3, ERRFLAG_WRONG_COUNT ) + PP_DEBUG_CRITICAL_COND_THROW( TMP(1).GT.TMP(2), ERRFLAG_WRONG_RANGE ) + PP_DEBUG_CRITICAL_COND_THROW( TMP(3).LT.0, ERRFLAG_STEP_SIGN ) + PP_DEBUG_CRITICAL_COND_THROW( TMP(3).GT.(TMP(2)-TMP(1)), ERRFLAG_STEP_SIZE ) + + ! Assign the values + LO=TMP(1) + HI=TMP(2) + BY=TMP(3) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: TMPSTR1 + CHARACTER(LEN=32) :: TMPSTR2 + CHARACTER(LEN=32) :: TMPSTR3 + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARSE_ERROR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to parse string: '//TRIM(ADJUSTL(STRING)) ) + CASE (ERRFLAG_NO_MATCH) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'No match between string and expected pattern: '//TRIM(ADJUSTL(STRING)) ) + CASE (ERRFLAG_WRONG_COUNT) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') COUNT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Wrong count: expected=3, got='//TRIM(ADJUST(TMPSTR1)) ) + CASE (ERRFLAG_WRONG_RANGE) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') TMP(1) + TMPSTR2 = REPEAT(' ', 32) + WRITE(TMPSTR2, '(I32)') TMP(2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Wrong range lower bound bigger than the upper bound: lb='//TRIM(ADJUSTL(TMPSTR1))//', ub='//TRIM(ADJUSTL(TMPSTR2)) ) + CASE (ERRFLAG_STEP_SIGN) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') TMP(3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Step must be greater than 0: '//TRIM(ADJUSTL(TMPSTR1)) ) + CASE (ERRFLAG_STEP_SIZE) + TMPSTR1 = REPEAT(' ', 32) + WRITE(TMPSTR1, '(I32)') TMP(1) + TMPSTR2 = REPEAT(' ', 32) + WRITE(TMPSTR2, '(I32)') TMP(2) + TMPSTR3 = REPEAT(' ', 32) + WRITE(TMPSTR3, '(I32)') TMP(3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Step size too big: lb='//TRIM(ADJUSTL(TMPSTR1))//', ub='//TRIM(ADJUSTL(TMPSTR2))//', step='//TRIM(ADJUSTL(TMPSTR3)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION STRING_TO_INTEGER_RANGE_BY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads and validates integer patterns in a string. +!> +!> This function reads and validates integer patterns from the input `STRING`. It returns +!> the count of valid integers found and optionally populates the `VALUES` array. It uses +!> a state machine to process the string, checking for valid separators and number formats. +!> +!> @section interface +!> @param [in] STRING Input string containing integer patterns to be parsed. +!> @param [out] MATCH Logical flag set to `.TRUE.` if valid patterns are found, `.FALSE.` otherwise. +!> @param [out] COUNT Number of valid integer patterns found in the `STRING`. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> @param [out] VALUES Optional array that will be populated with the parsed integers. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies of this function: +!> +!> @subsection module dependencies +!> - @dependency [PROCEDURE] READ_INTEGER +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> +!> @see READ_INTEGER +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_INTEGER_PATTERNS' +__THREAD_SAFE__ FUNCTION READ_INTEGER_PATTERNS( STRING, MATCH, COUNT, VERBOSE, VALUES ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: STRING + LOGICAL, INTENT(OUT) :: MATCH + INTEGER(KIND=JPIB_K), INTENT(OUT) :: COUNT + LOGICAL, INTENT(IN) :: VERBOSE + INTEGER(KIND=JPIB_K), DIMENSION(:), OPTIONAL, INTENT(OUT) :: VALUES + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: GLB_IDX + INTEGER(KIND=JPIB_K) :: LO + INTEGER(KIND=JPIB_K) :: HI + INTEGER(KIND=JPIB_K) :: TMP + INTEGER(KIND=JPIB_K) :: OLD_STATE + INTEGER(KIND=JPIB_K) :: STATE + INTEGER(KIND=JPIB_K) :: ERR_IDX + CHARACTER(LEN=1) :: C + LOGICAL :: LOOP + LOGICAL :: THROW + + ! Error Codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_OK=0_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_CHAR_IN_CHECK_FIRST_NUM=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_CHAR_IN_SEARCH_SEPARATOR=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_CHAR_IN_SEPARATOR=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_OOB_IN_OUT_VALUES=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_UNEXPECTED=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_FAILED_READ_INTEGER=6_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_GLB_IDX_LOWER_THAN_1=7_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_GLB_IDX_BIGGER_THAN_STRING=8_ERR_K + + ! States + INTEGER(KIND=JPIB_K), PARAMETER :: ENTER_STATE=1 + INTEGER(KIND=JPIB_K), PARAMETER :: CHECK_PREFIX_STATE=2 + INTEGER(KIND=JPIB_K), PARAMETER :: CHECK_FIRST_NUMBER_NO_PULL_STATE=3 + INTEGER(KIND=JPIB_K), PARAMETER :: CHECK_FIRST_NUMBER_STATE=4 + INTEGER(KIND=JPIB_K), PARAMETER :: SEARCH_SEPARATOR_STATE=5 + INTEGER(KIND=JPIB_K), PARAMETER :: VALID_VALUE_STATE=6 + INTEGER(KIND=JPIB_K), PARAMETER :: LAST_VALID_VALUE_STATE=7 + INTEGER(KIND=JPIB_K), PARAMETER :: EXIT_STATE=8 + INTEGER(KIND=JPIB_K), PARAMETER :: ERROR_STATE=9 + INTEGER(KIND=JPIB_K), PARAMETER :: INVALID_STATE=666 + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Initialization + MATCH = .FALSE. + COUNT = 0 + GLB_IDX = 1 + ERR_IDX = 0 + LO = 0 + HI = 0 + LOOP = .TRUE. + THROW=.FALSE. + OLD_STATE = INVALID_STATE + STATE = ENTER_STATE + StatesLoop: DO WHILE (LOOP) + + ! Save the old state + OLD_STATE = STATE + + ! Check for out of bounds + IF ( GLB_IDX .GT. LEN(STRING) ) THEN + ERR_IDX = ERRFLAG_GLB_IDX_BIGGER_THAN_STRING + STATE=ERROR_STATE + ELSEIF ( GLB_IDX .LT. 1 ) THEN + ERR_IDX = ERRFLAG_GLB_IDX_LOWER_THAN_1 + STATE=ERROR_STATE + ENDIF + + + !> State machine + SELECT CASE (STATE) + + !> Enter in the state machine + CASE (ENTER_STATE) + + COUNT = 0 + GLB_IDX = 1 + STATE = CHECK_PREFIX_STATE + + !> Check the prefix (it can be '+', '-' or nothing) + CASE (CHECK_PREFIX_STATE) + + C = STRING(GLB_IDX:GLB_IDX) + LO = GLB_IDX + IF ( (C.NE.'+') .AND. (C.NE.'-') ) THEN + STATE = CHECK_FIRST_NUMBER_NO_PULL_STATE + ELSE + STATE = CHECK_FIRST_NUMBER_STATE + ENDIF + + !> Check the first digit of the integer (it can be 1..9) + CASE (CHECK_FIRST_NUMBER_NO_PULL_STATE) + + C = STRING(GLB_IDX:GLB_IDX) + IF ( (C.GE.'1') .AND. (C.LE.'9') ) THEN + STATE = SEARCH_SEPARATOR_STATE + ELSE + ERR_IDX = ERRFLAG_INVALID_CHAR_IN_CHECK_FIRST_NUM + STATE=ERROR_STATE + ENDIF + + !> Check the first digit of the integer (it can be 1..9) + CASE (CHECK_FIRST_NUMBER_STATE) + + GLB_IDX = GLB_IDX + 1 + C = STRING(GLB_IDX:GLB_IDX) + IF ( (C.GE.'1') .AND. (C.LE.'9') ) THEN + STATE = SEARCH_SEPARATOR_STATE + ELSE + ERR_IDX = ERRFLAG_INVALID_CHAR_IN_CHECK_FIRST_NUM + STATE=ERROR_STATE + ENDIF + + !> Search the separator (loop until a separator is found valid characters are 0..9) + CASE (SEARCH_SEPARATOR_STATE) + + GLB_IDX = GLB_IDX + 1 + C = STRING(GLB_IDX:GLB_IDX) + IF ( (C.GE.'0') .AND. (C.LE.'9') ) THEN + IF (GLB_IDX.EQ.LEN(STRING)) THEN + STATE = LAST_VALID_VALUE_STATE + ELSE + STATE = SEARCH_SEPARATOR_STATE + ENDIF + ELSEIF ( C.EQ.':' ) THEN + STATE = VALID_VALUE_STATE + ELSE + ERR_IDX = ERRFLAG_INVALID_CHAR_IN_SEARCH_SEPARATOR + STATE = ERROR_STATE + ENDIF + + !> Read the value, and search the next value or exit + CASE (VALID_VALUE_STATE) + + HI = GLB_IDX - 1 + COUNT = COUNT + 1 + + IF ( PRESENT(VALUES) ) THEN + IF ( READ_INTEGER( STRING(LO:HI), TMP, VERBOSE ) .NE. 0 ) THEN + ERR_IDX = ERRFLAG_FAILED_READ_INTEGER + STATE = ERROR_STATE + ELSE + IF ( COUNT .GT. SIZE(VALUES) ) THEN + ERR_IDX = ERRFLAG_OOB_IN_OUT_VALUES + STATE = ERROR_STATE + ELSE + VALUES(COUNT) = TMP + ENDIF + ENDIF + ENDIF + + GLB_IDX = GLB_IDX + 1 + STATE = CHECK_PREFIX_STATE + + !> Read the value, and search the next value or exit + CASE (LAST_VALID_VALUE_STATE) + + HI = GLB_IDX + COUNT = COUNT + 1 + + IF ( PRESENT(VALUES) ) THEN + IF ( READ_INTEGER( STRING(LO:HI), TMP, VERBOSE ) .NE. 0 ) THEN + ERR_IDX = ERRFLAG_FAILED_READ_INTEGER + STATE = ERROR_STATE + ELSE + IF ( COUNT .GT. SIZE(VALUES) ) THEN + ERR_IDX = ERRFLAG_OOB_IN_OUT_VALUES + STATE = ERROR_STATE + ELSE + VALUES(COUNT) = TMP + ENDIF + ENDIF + ENDIF + + STATE = EXIT_STATE + + !> Exit on success from the state machine + CASE (EXIT_STATE) + + MATCH = .TRUE. + LOOP = .FALSE. + THROW = .FALSE. + ERR_IDX = ERRFLAG_OK + + !> Exit on error from the state machine + CASE (ERROR_STATE) + + COUNT = -ERR_IDX + MATCH = .FALSE. + LOOP = .FALSE. + IF ( PRESENT(VALUES) ) THEN + THROW = .TRUE. + ELSE + THROW = .FALSE. + ENDIF + + !> Unhandled case + CASE DEFAULT + + ERR_IDX = ERRFLAG_UNEXPECTED + STATE = ERROR_STATE + + END SELECT + + ENDDO StatesLoop + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( ERR_IDX.NE.ERRFLAG_OK, ERR_IDX ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + CHARACTER(LEN=32) :: CPOS + CHARACTER(LEN=32) :: CSTATE + CHARACTER(LEN=32) :: CSTATEID + CHARACTER(LEN=4096) :: TMPSTR + + TMPSTR=REPEAT(' ',4096) + CPOS=REPEAT(' ',32) + CSTATE=REPEAT(' ',32) + CSTATEID=REPEAT(' ',32) + + WRITE(CPOS,'(I16)') GBL_IDX + + ! Handle different states + SELECT CASE(OLD_STATE) + CASE (ENTER_STATE) + CSTATE='ENTER_STATE' + CSTATEID='1' + CASE (CHECK_FIRST_NUMBER_NO_PULL_STATE) + CSTATE='CHECK_FIRST_NUMBER_NO_PULL_STATE' + CSTATEID='2' + CASE (CHECK_PREFIX_STATE) + CSTATE='CHECK_PREFIX_STATE' + CSTATEID='3' + CASE (CHECK_FIRST_NUMBER_STATE) + CSTATE='CHECK_FIRST_NUMBER_STATE' + CSTATEID='4' + CASE (SEARCH_SEPARATOR_STATE) + CSTATE='SEARCH_SEPARATOR_STATE' + CSTATEID='5' + CASE (VALID_VALUE_STATE) + CSTATE='VALID_VALUE_STATE' + CSTATEID='6' + CASE (LAST_VALID_VALUE_STATE) + CSTATE='LAST_VALID_VALUE_STATE' + CSTATEID='7' + CASE (EXIT_STATE) + CSTATE='EXIT_STATE' + CSTATEID='8' + CASE (ERROR_STATE) + CSTATE='ERROR_STATE' + CSTATEID='9' + CASE ( INVALID_STATE ) + CSTATE='INVALID_STATE' + CSTATEID='666' + CASE DEFAULT + CSTATE='UNKNOWN_STATE' + CSTATEID='0' + END SELECT + + ! Create the descriptive part of the error message + TMPSTR='(' + TMPSTR=TRIM(ADJUSTL(TMPSTR))//'state="'//TRIM(ADJUSTL(CSTATE))//'"' + TMPSTR=TRIM(ADJUSTL(TMPSTR))//', state_id='//TRIM(ADJUSTL(CSTATEID)) + TMPSTR=TRIM(ADJUSTL(TMPSTR))//', position='//TRIM(ADJUSTL(CPOS)) + TMPSTR=TRIM(ADJUSTL(TMPSTR))//', string="'//TRIM(ADJUSTL(STRING))//'"' + TMPSTR=')' + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_INVALID_CHAR_IN_CHECK_FIRST_NUM) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Invalid character in check first number: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_INVALID_CHAR_IN_SEARCH_SEPARATOR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Invalid character in search separator: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_INVALID_CHAR_IN_SEPARATOR) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Invalid character in separator: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_OOB_IN_OUT_VALUES) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Out of bounds in out values: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_UNEXPECTED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unexpected error: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_FAILED_READ_INTEGER) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Failed to read an integer: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_GLB_IDX_LOWER_THAN_1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Global index lower than 1: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE (ERRFLAG_GLB_IDX_BIGGER_THAN_STRING) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Global index bigger than string: '//TRIM(ADJUSTL(TMPSTR)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_INTEGER_PATTERNS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Converts a substring to an integer value. +!> +!> This function attempts to read an integer value from the provided substring and store +!> it in `NUM`. The function returns a status code indicating whether the conversion was successful. +!> +!> @section interface +!> @param [in] SUBSTR Input substring to be parsed. +!> @param [out] NUM Parsed integer value. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled. +!> +!> @return [Integer] Error code indicating success or failure of the operation. +!> - `0`: Success +!> - `1`: Failure to read an integer +!> +!> @section Dependencies of this function: +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> +!> @see READ_INTEGER_PATTERNS +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_INTEGER' +__THREAD_SAFE__ FUNCTION READ_INTEGER( S, NUM, VERBOSE ) RESULT(RET) + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + CHARACTER(LEN=*), INTENT(IN) :: S + INTEGER(KIND=JPIB_K), INTENT(OUT) :: NUM + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_INVALID_STRING=1_ERR_K + + ! Local variables + INTEGER :: IOS + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Read the integer from the string + READ(S, *, IOSTAT=IOS) NUM + PP_DEBUG_CRITICAL_COND_THROW( IOS .NE. 0, ERRFLAG_INVALID_STRING ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_INVALID_STRING) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to read an integer from a string: '//TRIM(ADJUSTL(S)) ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_INTEGER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + +END MODULE YAML_CORE_UTILS_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/yaml_filters_utils_mod.F90 b/src/ecom/grib_info/yaml_filters_utils_mod.F90 new file mode 100644 index 000000000..7294cad08 --- /dev/null +++ b/src/ecom/grib_info/yaml_filters_utils_mod.F90 @@ -0,0 +1,2554 @@ +!> +!> @file yaml_filter_utils_mod.f90 +!> +!> @brief Module containing procedures for reading and matching filter rules. +!> +!> This module provides various procedures to read and process filter rules +!> from a YAML configuration, and to match these rules against provided parameters. +!> Each procedure handles different aspects of the filter rules, including levels, +!> directions, frequencies, representations, level types, and other properties. +!> +!> @section Public DataTypes +!> - @ref FILTER_RULES_T +!> +!> @section Public Parameters +!> - @ref TAG_LEN +!> +!> @section Public Procedures +!> - @ref READ_RULE_FILTER +!> - @ref FREE_RULE_FILTER +!> - @ref MATCH_RULE_FILTER_ATM +!> - @ref MATCH_RULE_FILTER_WAM +!> +!> +!> @section Private Parameters +!> - @ref ISCHEMICAL_KEY +!> - @ref ISENSEMBLE_KEY +!> - @ref PARAMID_KEY +!> - @ref LEVEL_KEY +!> - @ref DIRECTION_KEY +!> - @ref FREQUENCY_KEY +!> - @ref REPRES_KEY +!> - @ref LEVTYPE_KEY +!> - @ref TAG_KEY +!> +!> @section Private Procedures +!> +!> - @ref READ_RULE_FILTER_PARAMID +!> - @ref READ_RULE_FILTER_LEVEL +!> - @ref READ_RULE_FILTER_DIRECTION +!> - @ref READ_RULE_FILTER_FREQUENCY +!> - @ref READ_RULE_FILTER_REPRES +!> - @ref READ_RULE_FILTER_LEVTYPE +!> - @ref READ_RULE_FILTER_TAG +!> - @ref READ_RULE_FILTER_ISCHEMICAL +!> - @ref READ_RULE_FILTER_ISENSEMBLE +!> +!> @section Dependencies +!> +!> @subsection local_dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [PROCEDURE] "OM_CORE_MOD::CLEVTYPE2ILEVTYPE" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_RANGES" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_FILTER" +!> - @dependency [INTERFACE] "YAML_CORE_UTILS_MOD::FUN_C2I_IF" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_LOGICAL" +!> +!> @author Mirco Valentini +!> @date August, 2024 +!> + +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'yaml_filter_utils_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'MODULE YAML_FILTERS_UTILS_MOD' +MODULE YAML_FILTERS_UTILS_MOD + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + +IMPLICIT NONE + +!> Default symbols visibility +PRIVATE + + +!> +!> Parameters + +!> Maximum length of a tag +INTEGER(KIND=JPIB_K), PARAMETER :: TAG_LEN=32_JPIB_K + +!> Key used to read the filter rule for the `is-chemical` property +CHARACTER(LEN=*), PARAMETER :: ISCHEMICAL_KEY='is-chemical' + +!> Key used to read the filter rule for the `is-ensemble` property +CHARACTER(LEN=*), PARAMETER :: ISENSEMBLE_KEY='is-ensemble' + +!> Key used to read the filter rule for the `paramid` property +CHARACTER(LEN=*), PARAMETER :: PARAMID_KEY='paramId' + +!> Key used to read the filter rule for the `level` property +CHARACTER(LEN=*), PARAMETER :: LEVEL_KEY='level' + +!> Key used to read the filter rule for the `direction` property +CHARACTER(LEN=*), PARAMETER :: DIRECTION_KEY='direction' + +!> Key used to read the filter rule for the `frequency` property +CHARACTER(LEN=*), PARAMETER :: FREQUENCY_KEY='frequency' + +!> Key used to read the filter rule for the `repres` property +CHARACTER(LEN=*), PARAMETER :: REPRES_KEY='repres' + +!> Key used to read the filter rule for the `levtype` property +CHARACTER(LEN=*), PARAMETER :: LEVTYPE_KEY='levtype' + +!> Key used to read the filter rule for the `tag` property +CHARACTER(LEN=*), PARAMETER :: TAG_KEY='tag' + + +!> +!> @class Rules used to match fields +TYPE :: FILTER_RULES_T + + !> Default visibility of the members + PRIVATE + + !> Logical flag indicating whether the `levtype` field is present in the filter + LOGICAL :: HAS_LEVTYPE = .FALSE. + + !> Logical flag indicating whether the `level` field is present in the filter + LOGICAL :: HAS_LEVEL = .FALSE. + + !> Logical flag indicating whether the `direction` field is present in the filter + LOGICAL :: HAS_DIRECTION = .FALSE. + + !> Logical flag indicating whether the `frequency` field is present in the filter + LOGICAL :: HAS_FREQUENCY = .FALSE. + + !> Logical flag indicating whether the `repres` field is present in the filter + LOGICAL :: HAS_REPRES = .FALSE. + + !> Logical flag indicating whether the `paramId` field is present in the filter + LOGICAL :: HAS_PARAMID = .FALSE. + + !> Logical flag indicating whether the `tag` field is present in the filter + LOGICAL :: HAS_TAG = .FALSE. + + !> Logical flag indicating whether the `is-chemical` field is present in the filter + LOGICAL :: HAS_IS_ENSEMBLE = .FALSE. + + !> Logical flag indicating whether the `is-ensemble` field is present in the filter + LOGICAL :: HAS_IS_CHEMICAL = .FALSE. + + + !> Array of `levtype` enumerators to match + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE :: LEVTYPE + + !> Array of `level` values to match + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE :: LEVEL + + !> Array of `direction` values to match + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE :: DIRECTION + + !> Array of `frequency` values to match + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE :: FREQUENCY + + !> Array of `repres` values to match + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE :: REPRES + + !> Array of `paramId` values to match + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE :: PARAMID + + !> Array of `tag` values to match + CHARACTER(LEN=TAG_LEN), DIMENSION(:), ALLOCATABLE :: TAG + + !> Value of `is-ensemble` to match + INTEGER(KIND=JPIB_K) :: IS_ENSEMBLE = .FALSE. + + !> Value of `is-chemical` to match + INTEGER(KIND=JPIB_K) :: IS_CHEMICAL = .FALSE. +END TYPE + + +!> Exposed symbols + +!> Whitelist of public symbols (datatypes) +PUBLIC :: FILTER_RULES_T + +!> Whitelist of public symbols (procedures) +PUBLIC :: READ_RULE_FILTER +PUBLIC :: MATCH_RULE_FILTER_WAM +PUBLIC :: MATCH_RULE_FILTER_ATM +PUBLIC :: FREE_RULEFILTER + +!> Whitelist of public symbols (parameters) +PUBLIC :: TAG_LEN + +CONTAINS + + +!> +!> @brief Reads filtering rules from a YAML configuration and populates a filter structure. +!> +!> This function reads the filtering rules from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER` structure with the parsed rules. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function also supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during the execution. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object from which the filter rules are read. +!> @param [out] FILTER The structure that will be populated with the parsed filtering rules. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_PARAMID" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_LEVEL" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_DIRECTION" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_FREQUENCY" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_REPRES" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_LEVTYPE" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_TAG" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_ISENSEMBLE" +!> - @dependency [PROCEDURE] "READ_RULE_FILTER_ISCHEMICAL" +!> +!> @subsubsection local dependencies +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_PARAMID_ALLOCATED` (1): Error allocating `PARAMID` +!> - `ERRFLAG_LEVEL_ALLOCATED` (2): Error allocating `LEVEL` +!> - `ERRFLAG_DIRECTION_ALLOCATED` (3): Error allocating `DIRECTION` +!> - `ERRFLAG_FREQUENCY_ALLOCATED` (4): Error allocating `FREQUENCY` +!> - `ERRFLAG_REPRES_ALLOCATED` (5): Error allocating `REPRES` +!> - `ERRFLAG_LEVTYPE_ALLOCATED` (6): Error allocating `LEVTYPE` +!> - `ERRFLAG_TAG_ALLOCATED` (7): Error allocating `TAG` +!> - `ERRFLAG_NESTED_READ_PARAMID` (100): Nested read error for `PARAMID` +!> - `ERRFLAG_NESTED_READ_LEVEL` (101): Nested read error for `LEVEL` +!> - `ERRFLAG_NESTED_READ_DIRECTION` (102): Nested read error for `DIRECTION` +!> - `ERRFLAG_NESTED_READ_FREQUENCY` (103): Nested read error for `FREQUENCY` +!> - `ERRFLAG_NESTED_READ_REPRES` (104): Nested read error for `REPRES` +!> - `ERRFLAG_NESTED_READ_LEVTYPE` (105): Nested read error for `LEVTYPE` +!> - `ERRFLAG_NESTED_READ_TAG` (106): Nested read error for `TAG` +!> - `ERRFLAG_NESTED_READ_ISENSEMBLE` (107): Nested read error for `ISENSEMBLE` +!> - `ERRFLAG_NESTED_READ_ISCHEMICAL` (108): Nested read error for `ISCHEMICAL` +!> +!> @see YAML_CONFIGURATION_T, FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER( CFG, FILTER, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(FILTER_RULES_T), INTENT(OUT) :: FILTER + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARAMID_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_LEVEL_ALLOCATED=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DIRECTION_ALLOCATED=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_FREQUENCY_ALLOCATED=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_REPRES_ALLOCATED=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_LEVTYPE_ALLOCATED=6_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_TAG_ALLOCATED=7_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_PARAMID=100_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_LEVEL=101_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_DIRECTION=102_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_FREQUENCY=103_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_REPRES=104_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_LEVTYPE=105_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_TAG=106_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_ISENSEMBLE=107_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_NESTED_READ_ISCHEMICAL=108_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%PARAMID), ERRFLAG_PARAMID_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%LEVEL), ERRFLAG_LEVEL_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%DIRECTION), ERRFLAG_DIRECTION_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%FREQUENCY), ERRFLAG_FREQUENCY_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%REPRES), ERRFLAG_REPRES_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%LEVTYPE), ERRFLAG_LEVTYPE_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(FILTER%TAG), ERRFLAG_TAG_ALLOCATED ) + + ! Read the filter rules + PP_TRYCALL(ERRFLAG_NESTED_READ_PARAMID) READ_RULE_FILTER_PARAMID( CFG, FILTER%PARAMID, FILTER%HAS_PARAMID, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_LEVEL) READ_RULE_FILTER_LEVEL( CFG, FILTER%LEVEL, FILTER%HAS_LEVEL, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_DIRECTION) READ_RULE_FILTER_DIRECTION( CFG, FILTER%DIRECTION, FILTER%HAS_DIRECTION, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_FREQUENCY) READ_RULE_FILTER_FREQUENCY( CFG, FILTER%FREQUENCY, FILTER%HAS_FREQUENCY, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_REPRES) READ_RULE_FILTER_REPRES( CFG, FILTER%REPRES, FILTER%HAS_REPRES, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_LEVTYPE) READ_RULE_FILTER_LEVTYPE( CFG, FILTER%LEVTYPE, FILTER%HAS_LEVTYPE, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_TAG) READ_RULE_FILTER_TAG( CFG, FILTER%TAG, FILTER%HAS_TAG, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_ISENSEMBLE) READ_RULE_FILTER_ISENSEMBLE( CFG, FILTER%ISENSEMBLE, FILTER%HAS_ISENSEMBLE, VERBOSE ) + PP_TRYCALL(ERRFLAG_NESTED_READ_ISCHEMICAL) READ_RULE_FILTER_ISCHEMICAL( CFG, FILTER%ISCHEMICAL, FILTER%HAS_ISCHEMICAL, VERBOSE ) + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARAMID_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%PARAMID already allocated allocated' ) + CASE (ERRFLAG_LEVEL_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%LEVEL already allocated allocated' ) + CASE (ERRFLAG_DIRECTION_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%DIRECTION already allocated allocated' ) + CASE (ERRFLAG_FREQUENCY_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%FREQUENCY already allocated allocated' ) + CASE (ERRFLAG_REPRES_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%REPRES already allocated allocated' ) + CASE (ERRFLAG_LEVTYPE_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%LEVTYPE already allocated allocated' ) + CASE (ERRFLAG_TAG_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER%TAG already allocated allocated' ) + CASE (ERRFLAG_NESTED_READ_PARAMID) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_PARAMID' ) + CASE (ERRFLAG_NESTED_READ_LEVEL) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_LEVEL' ) + CASE (ERRFLAG_NESTED_READ_DIRECTION) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_DIRECTION' ) + CASE (ERRFLAG_NESTED_READ_FREQUENCY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_FREQUENCY' ) + CASE (ERRFLAG_NESTED_READ_REPRES) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_REPRES' ) + CASE (ERRFLAG_NESTED_READ_LEVTYPE) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_LEVTYPE' ) + CASE (ERRFLAG_NESTED_READ_TAG) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_TAG' ) + CASE (ERRFLAG_NESTED_READ_ISENSEMBLE) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_ISENSEMBLE' ) + CASE (ERRFLAG_NESTED_READ_ISCHEMICAL) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: READ_RULE_FILTER_ISCHEMICAL' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Frees all resources associated with the filtering structure. +!> +!> This function deallocates memory for all fields within the provided `FILTER` structure. +!> It ensures that all dynamically allocated resources within `FILTER` are properly freed +!> and that no memory leaks occur. The function operates in a thread-safe manner and can +!> optionally run in verbose mode. +!> +!> @section interface +!> @param [inout] FILTER The filter structure whose resources are to be deallocated. +!> After completion, this structure will have no allocated resources. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_DEALLOC_PARAMID` (1): Error deallocating `PARAMID` +!> - `ERRFLAG_DEALLOC_LEVEL` (2): Error deallocating `LEVEL` +!> - `ERRFLAG_DEALLOC_DIRECTION` (3): Error deallocating `DIRECTION` +!> - `ERRFLAG_DEALLOC_FREQUENCY` (4): Error deallocating `FREQUENCY` +!> - `ERRFLAG_DEALLOC_REPRES` (5): Error deallocating `REPRES` +!> - `ERRFLAG_DEALLOC_LEVTYPE` (6): Error deallocating `LEVTYPE` +!> - `ERRFLAG_DEALLOC_TAG` (7): Error deallocating `TAG` +!> +!> @see FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'FREE_RULE_FILTER' +__THREAD_SAFE__ FUNCTION FREE_RULE_FILTER( FILTER, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(FILTER_RULES_T), INTENT(INOUT) :: FILTER + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_PARAMID=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_LEVEL=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_DIRECTION=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_FREQUENCY=4_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_REPRES=5_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_LEVTYPE=6_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DEALLOC_TAG=7_ERR_K + + ! Local variables + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Deallocate paramId + IF ( FILTER%HAS_PARAMID ) THEN + DEALLOCATE( FILTER%PARAMID, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_PARAMID ) + FILTER%HAS_PARAMID = .FALSE. + ENDIF + + ! Deallocate level + IF ( FILTER%HAS_LEVEL ) THEN + DEALLOCATE( FILTER%LEVEL, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_LEVEL ) + FILTER%HAS_LEVEL = .FALSE. + ENDIF + + ! Deallocate direction + IF ( FILTER%HAS_DIRECTION ) THEN + DEALLOCATE( FILTER%DIRECTION, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_DIRECTION ) + FILTER%HAS_DIRECTION = .FALSE. + ENDIF + + ! Deallocate frequency + IF ( FILTER%HAS_FREQUENCY ) THEN + DEALLOCATE( FILTER%FREQUENCY, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_FREQUENCY ) + FILTER%HAS_FREQUENCY = .FALSE. + ENDIF + + ! Deallocate repres + IF ( FILTER%HAS_REPRES ) THEN + DEALLOCATE( FILTER%REPRES, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_REPRES ) + FILTER%HAS_REPRES = .FALSE. + ENDIF + + ! Deallocate levtype + IF ( FILTER%HAS_LEVTYPE ) THEN + DEALLOCATE( FILTER%LEVTYPE, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_LEVTYPE ) + FILTER%HAS_LEVTYPE = .FALSE. + ENDIF + + ! Deallocate tag + IF ( FILTER%HAS_TAG ) THEN + DEALLOCATE( FILTER%TAG, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_DEALLOC_TAG ) + FILTER%HAS_TAG = .FALSE. + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_DEALLOC_PARAMID) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating PARAMID' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating PARAMID: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_DEALLOC_LEVEL) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating LEVEL' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating LEVEL: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_DEALLOC_DIRECTION) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating DIRECTION' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating DIRECTION: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_DEALLOC_FREQUENCY) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating FREQUENCY' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating FREQUENCY: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_DEALLOC_REPRES) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating REPRES' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating REPRES: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_DEALLOC_LEVTYPE) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating LEVTYPE' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating LEVTYPE: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE (ERRFLAG_DEALLOC_TAG) + IF ( .NOT.ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating TAG' ) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'error deallocating TAG: '//TRIM(ADJUSTL(ERRMSG)) ) + DEALLOCATE(ERRMSG) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION FREE_RULE_FILTER +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering parameter IDs from a YAML configuration and updates the parameter list. +!> +!> This function extracts parameter IDs from the provided YAML configuration object (`CFG`) +!> and populates the `FILTER_PARAMID` array with these IDs. It also sets the logical flag `HAS_PARAMID` +!> to indicate whether any parameter IDs were found. The function operates in a thread-safe manner and +!> can optionally run in verbose mode. +!> +!> @section interface +!> @param [in] CFG The YAML configuration object from which parameter IDs are read. +!> @param [out] FILTER_PARAMID The array that will be populated with the extracted parameter IDs. +!> @param [out] HAS_PARAMID Logical flag that will be set to `.TRUE.` if parameter IDs are found; +!> `.FALSE.` otherwise. +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "PARAMID_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_RANGES" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_PARAMID_NOT_ALLOCATED` (1): Error if `FILTER_PARAMID` could not be allocated. +!> - `ERRFLAG_PARAMID_EMPTY` (2): Error if `FILTER_PARAMID` is empty after reading. +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Error if the expected key is not present in the configuration. +!> - `ERRFLAG_READ_KEY_FAILED` (4): Error if reading the key from the configuration fails. +!> +!> @see YAML_CONFIGURATION_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_PARAMID' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_PARAMID( CFG, FILTER_PARAMID, HAS_PARAMID, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER_ARRAY_WITH_RANGES + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_PARAMID + LOGICAL, INTENT(OUT) :: HAS_PARAMID + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARAMID_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_PARAMID_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, PARAMID_KEY, HAS_PARAMID, VERBOSE ) + + ! Read the paramId + IF ( HAS_PARAMID ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_INTEGER_ARRAY_WITH_RANGES( CFG, PARAMID_KEY, FILTER_PARAMID, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_PARAMID), ERRFLAG_PARAMID_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_PARAMID).LT.1, ERRFLAG_PARAMID_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_PARAMID_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_PARAMID not allocated' ) + CASE (ERRFLAG_PARAMID_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_PARAMID not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_PARAMID +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering levels from a YAML configuration and populates a level structure. +!> +!> This function reads filtering levels from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_LEVEL` array with the parsed levels. It also indicates whether +!> the levels were successfully populated through the `HAS_LEVEL` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter levels are read. +!> @param [out] FILTER_LEVEL The array that will be populated with the parsed filtering levels. +!> @param [out] HAS_LEVEL Logical flag indicating whether the levels were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "LEVEL_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_RANGES" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_LEVEL_NOT_ALLOCATED` (1): Error allocating `LEVEL` +!> - `ERRFLAG_LEVEL_EMPTY` (2): Error when `LEVEL` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T, FILTER_RULES_T +!> + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_LEVEL' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_LEVEL( CFG, FILTER_LEVEL, HAS_LEVEL, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER_ARRAY_WITH_RANGES + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_LEVEL + LOGICAL, INTENT(OUT) :: HAS_LEVEL + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_LEVEL_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_LEVEL_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, LEVEL_KEY, HAS_LEVEL, VERBOSE ) + + ! Read the paramId + IF ( HAS_LEVEL ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_INTEGER_ARRAY_WITH_RANGES( CFG, LEVEL_KEY, FILTER_LEVEL, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_LEVEL), ERRFLAG_LEVEL_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_LEVEL).LT.1, ERRFLAG_LEVEL_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_LEVEL_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_LEVEL not allocated' ) + CASE (ERRFLAG_LEVEL_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_LEVEL not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_LEVEL +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering directions from a YAML configuration and populates a direction structure. +!> +!> This function reads filtering directions from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_DIRECTION` array with the parsed directions. It also indicates whether +!> the directions were successfully populated through the `HAS_DIRECTION` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter directions are read. +!> @param [out] FILTER_DIRECTION The array that will be populated with the parsed filtering directions. +!> @param [out] HAS_DIRECTION Logical flag indicating whether the directions were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "DIRECTION_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_RANGES" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_DIRECTION_NOT_ALLOCATED` (1): Error allocating `DIRECTION` +!> - `ERRFLAG_DIRECTION_EMPTY` (2): Error when `DIRECTION` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T, FILTER_RULES_T +!> + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_DIRECTION' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_DIRECTION( CFG, FILTER_DIRECTION, HAS_DIRECTION, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER_ARRAY_WITH_RANGES + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_DIRECTION + LOGICAL, INTENT(OUT) :: HAS_DIRECTION + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DIRECTION_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_DIRECTION_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, DIRECTION_KEY, HAS_DIRECTION, VERBOSE ) + + ! Read the paramId + IF ( HAS_DIRECTION ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_INTEGER_ARRAY_WITH_RANGES( CFG, DIRECTION_KEY, FILTER_DIRECTION, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_DIRECTION), ERRFLAG_DIRECTION_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_DIRECTION).LT.1, ERRFLAG_DIRECTION_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_DIRECTION_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_DIRECTION not allocated' ) + CASE (ERRFLAG_DIRECTION_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_DIRECTION not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_DIRECTION +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering frequencies from a YAML configuration and populates a frequency structure. +!> +!> This function reads filtering frequencies from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_FREQUENCY` array with the parsed frequencies. It also indicates whether +!> the frequencies were successfully populated through the `HAS_FREQUENCY` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter frequencies are read. +!> @param [out] FILTER_FREQUENCY The array that will be populated with the parsed filtering frequencies. +!> @param [out] HAS_FREQUENCY Logical flag indicating whether the frequencies were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "FREQUENCY_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_RANGES" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_FREQUENCY_NOT_ALLOCATED` (1): Error allocating `FREQUENCY` +!> - `ERRFLAG_FREQUENCY_EMPTY` (2): Error when `FREQUENCY` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T, FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_FREQUENCY' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_FREQUENCY( CFG, FILTER_FREQUENCY, HAS_FREQUENCY, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + P_USE('P') :: OM_CORE_MOD, ONLY: JPIB_K + P_USE('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + P_USE('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + P_USE('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER_ARRAY_WITH_RANGES + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_FREQUENCY + LOGICAL, INTENT(OUT) :: HAS_FREQUENCY + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_FREQUENCY_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_FREQUENCY_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, FREQUENCY_KEY, HAS_FREQUENCY, VERBOSE ) + + ! Read the paramId + IF ( HAS_FREQUENCY ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_INTEGER_ARRAY_WITH_RANGES( CFG, FREQUENCY_KEY, FILTER_FREQUENCY, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_FREQUENCY), ERRFLAG_FREQUENCY_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_FREQUENCY).LT.1, ERRFLAG_FREQUENCY_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_FREQUENCY_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_FREQUENCY not allocated' ) + CASE (ERRFLAG_FREQUENCY_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_FREQUENCY not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_FREQUENCY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering representations from a YAML configuration and populates a representation structure. +!> +!> This function reads filtering representations from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_REPRES` array with the parsed representations. It also indicates whether +!> the representations were successfully populated through the `HAS_REPRES` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter representations are read. +!> @param [out] FILTER_REPRES The array that will be populated with the parsed filtering representations. +!> @param [out] HAS_REPRES Logical flag indicating whether the representations were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "REPRES_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_FILTER" +!> - @dependency [INTERFACE] "YAML_CORE_UTILS_MOD::FUN_C2I_IF" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_REPRES_NOT_ALLOCATED` (1): Error allocating `REPRES` +!> - `ERRFLAG_REPRES_EMPTY` (2): Error when `REPRES` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T, FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_REPRES' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_REPRES( CFG, FILTER_REPRES, HAS_REPRES, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER_ARRAY_WITH_FILTER + PP_USE_L('I') :: YAML_CORE_UTILS_MOD, ONLY: FUN_C2I_IF + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_REPRES + LOGICAL, INTENT(OUT) :: HAS_REPRES + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_REPRES_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_REPRES_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables + PROCEDURE(FUN_C2I_IF), POINTER :: P_CREPRES2IREPRES + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, REPRES_KEY, HAS_REPRES, VERBOSE ) + + ! Read the paramId + IF ( HAS_REPRES ) THEN + + ! Associtate the conversion function + P_CREPRES2IREPRES => CREPRES2IREPRES + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_INTEGER_ARRAY_WITH_FILTER( CFG, REPRES_KEY, FILTER_REPRES, P_CREPRES2IREPRES, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_REPRES), ERRFLAG_REPRES_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_REPRES).LT.1, ERRFLAG_REPRES_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_REPRES_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_REPRES not allocated' ) + CASE (ERRFLAG_REPRES_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_REPRES not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_REPRES +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering level types from a YAML configuration and populates a level type structure. +!> +!> This function reads filtering level types from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_LEVTYPE` array with the parsed level types. It also indicates whether +!> the level types were successfully populated through the `HAS_LEVTYPE` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter level types are read. +!> @param [out] FILTER_LEVTYPE The array that will be populated with the parsed filtering level types. +!> @param [out] HAS_LEVTYPE Logical flag indicating whether the level types were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "LEVTYPE_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [PROCEDURE] "OM_CORE_MOD::CLEVTYPE2ILEVTYPE" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_INTEGER_ARRAY_WITH_FILTER" +!> - @dependency [INTERFACE] "YAML_CORE_UTILS_MOD::FUN_C2I_IF" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_LEVTYPE_NOT_ALLOCATED` (1): Error allocating `LEVTYPE` +!> - `ERRFLAG_LEVTYPE_EMPTY` (2): Error when `LEVTYPE` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T, FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_LEVTYPE' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_LEVTYPE( CFG, FILTER_LEVTYPE, HAS_LEVTYPE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('S') :: OM_CORE_MOD, ONLY: CLEVTYPE2ILEVTYPE + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER_ARRAY_WITH_FILTER + PP_USE_L('I') :: YAML_CORE_UTILS_MOD, ONLY: FUN_C2I_IF + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB_K), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_LEVTYPE + LOGICAL, INTENT(OUT) :: HAS_LEVTYPE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_LEVTYPE_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_LEVTYPE_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables + PROCEDURE(FUN_C2I_IF), POINTER :: P_CLEVTYPE2ILEVTYPE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, LEVTYPE_KEY, HAS_LEVTYPE, VERBOSE ) + + ! Read the paramId + IF ( HAS_LEVTYPE ) THEN + + ! Associtate the conversion function + P_CLEVTYPE2ILEVTYPE => CLEVTYPE2ILEVTYPE + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_INTEGER_ARRAY_WITH_FILTER( CFG, LEVTYPE_KEY, FILTER_LEVTYPE, P_CLEVTYPE2ILEVTYPE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_LEVTYPE), ERRFLAG_LEVTYPE_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_LEVTYPE).LT.1, ERRFLAG_LEVTYPE_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_LEVTYPE_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_LEVTYPE not allocated' ) + CASE (ERRFLAG_LEVTYPE_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_LEVTYPE not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_LEVTYPE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering tags from a YAML configuration and populates a tag array. +!> +!> This function reads filtering tags from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_TAG` array with the parsed tags. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function also supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during the execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter tags are read. +!> @param [out] FILTER_TAG The array that will be populated with the parsed filtering tags. +!> @param [out] HAS_TAG Logical flag indicating whether tags were successfully read (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section Dependencies +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "TAG_KEY" +!> +!> @subsection local_dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_STRING_ARRAY_FIXED_SIZE" +!> +!> @section Error Codes +!> This function defines several error codes: +!> +!> - `ERRFLAG_TAG_NOT_ALLOCATED`: Error when the tag array is not allocated. +!> - `ERRFLAG_TAG_EMPTY`: Error when the tag array is empty. +!> - `ERRFLAG_KEY_NOT_PRESENT`: Error when a required key is not present in the configuration. +!> - `ERRFLAG_READ_KEY_FAILED`: Error when reading a key from the configuration fails. +!> +!> @see YAML_CONFIGURATION_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_TAG' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_TAG( CFG, FILTER_TAG, HAS_TAG, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING_ARRAY_FIXED_SIZE + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + CHARACTER(LEN=TAG_LEN), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: FILTER_TAG + LOGICAL, INTENT(OUT) :: HAS_TAG + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_TAG_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_TAG_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, TAG_KEY, HAS_TAG, VERBOSE ) + + ! Read the paramId + IF ( HAS_TAG ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_READ_STRING_ARRAY_FIXED_SIZE( CFG, TAG_KEY, FILTER_TAG, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_TAG), ERRFLAG_TAG_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_TAG).LT.1, ERRFLAG_TAG_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_TAG_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_TAG not allocated' ) + CASE (ERRFLAG_TAG_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_TAG not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_TAG +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering is-ensemble flags from a YAML configuration and populates an is-ensemble flag. +!> +!> This function reads filtering is-ensemble flags from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_ISENSEMBLE` flag with the parsed values. It also indicates whether +!> the is-ensemble flags were successfully populated through the `HAS_IS_ENSEMBLE` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter is-ensemble flags are read. +!> @param [out] FILTER_ISENSEMBLE The flag that will be populated with the parsed is-ensemble values. +!> @param [out] HAS_IS_ENSEMBLE Logical flag indicating whether the is-ensemble flags were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "ISENSEMBLE_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_LOGICAL" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_ISENSEMBLE_NOT_ALLOCATED` (1): Error allocating `ISENSEMBLE` +!> - `ERRFLAG_ISENSEMBLE_EMPTY` (2): Error when `ISENSEMBLE` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_ISENSEMBLE' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_ISENSEMBLE( CFG, FILTER_ISENSEMBLE, HAS_IS_ENSEMBLE, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_LOGICAL + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(OUT) :: FILTER_ISENSEMBLE + LOGICAL, INTENT(OUT) :: HAS_IS_ENSEMBLE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ISENSEMBLE_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ISENSEMBLE_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, ISENSEMBLE_KEY, HAS_IS_ENSEMBLE, VERBOSE ) + + ! Read the paramId + IF ( HAS_IS_ENSEMBLE ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_LOGICAL( CFG, ISENSEMBLE_KEY, FILTER_ISENSEMBLE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_ISENSEMBLE), ERRFLAG_ISENSEMBLE_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_ISENSEMBLE).LT.1, ERRFLAG_ISENSEMBLE_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_ISENSEMBLE_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_ISENSEMBLE not allocated' ) + CASE (ERRFLAG_ISENSEMBLE_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_ISENSEMBLE not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_ISENSEMBLE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Reads filtering is-chemical flags from a YAML configuration and populates an is-chemical flag. +!> +!> This function reads filtering is-chemical flags from a provided YAML configuration object (`CFG`) +!> and populates the `FILTER_ISCHEMICAL` flag with the parsed values. It also indicates whether +!> the is-chemical flags were successfully populated through the `HAS_ISCHEMICAL` flag. If an error occurs, +!> the function returns an error code to indicate the nature of the issue. +!> +!> The function supports a `VERBOSE` mode, which can be enabled for debugging purposes, +!> providing additional output during execution. +!> +!> @param [in] CFG The YAML configuration object from which the filter is-chemical flags are read. +!> @param [out] FILTER_ISCHEMICAL The flag that will be populated with the parsed is-chemical values. +!> @param [out] HAS_ISCHEMICAL Logical flag indicating whether the is-chemical flags were successfully populated (`.TRUE.`) +!> or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) +!> for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> - @dependency [PARAMETER] "ISCHEMICAL_KEY" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> - @dependency [TYPE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_T" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_CONFIGURATION_HAS_KEY" +!> - @dependency [PROCEDURE] "YAML_CORE_UTILS_MOD::YAML_READ_LOGICAL" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_ISCHEMICAL_NOT_ALLOCATED` (1): Error allocating `ISCHEMICAL` +!> - `ERRFLAG_ISCHEMICAL_EMPTY` (2): Error when `ISCHEMICAL` is empty +!> - `ERRFLAG_KEY_NOT_PRESENT` (3): Key not present in the YAML configuration +!> - `ERRFLAG_READ_KEY_FAILED` (4): Failure reading key from YAML configuration +!> +!> @see YAML_CONFIGURATION_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'READ_RULE_FILTER_ISCHEMICAL' +__THREAD_SAFE__ FUNCTION READ_RULE_FILTER_ISCHEMICAL( CFG, FILTER_ISCHEMICAL, HAS_ISCHEMICAL, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + PP_USE_L('T') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + PP_USE_L('S') :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_LOGICAL + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + LOGICAL, INTENT(OUT) :: FILTER_ISCHEMICAL + LOGICAL, INTENT(OUT) :: HAS_ISCHEMICAL + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ISCHEMICAL_NOT_ALLOCATED=1_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_ISCHEMICAL_EMPTY=2_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_KEY_NOT_PRESENT=3_ERR_K + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_READ_KEY_FAILED=4_ERR_K + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Configuration structure + PP_TRYCALL(ERRFLAG_KEY_NOT_PRESENT) YAML_CONFIGURATION_HAS_KEY( CFG, ISCHEMICAL_KEY, HAS_ISCHEMICAL, VERBOSE ) + + ! Read the paramId + IF ( HAS_ISCHEMICAL ) THEN + + ! Read the paramId as a string array + PP_TRYCALL(ERRFLAG_READ_KEY_FAILED) YAML_READ_LOGICAL( CFG, ISCHEMICAL_KEY, FILTER_ISCHEMICAL, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(FILTER_ISCHEMICAL), ERRFLAG_ISCHEMICAL_NOT_ALLOCATED ) + PP_DEBUG_CRITICAL_COND_THROW( SIZE(FILTER_ISCHEMICAL).LT.1, ERRFLAG_ISCHEMICAL_EMPTY ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_ISCHEMICAL_NOT_ALLOCATED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_ISCHEMICAL not allocated' ) + CASE (ERRFLAG_ISCHEMICAL_EMPTY) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'FILTER_ISCHEMICAL not allocated or empty' ) + CASE (ERRFLAG_KEY_NOT_PRESENT) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_CONFIGURATION_HAS_KEY' ) + CASE (ERRFLAG_READ_KEY_FAILED) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Nested error calling: YAML_READ_INTEGER_ARRAY_WITH_RANGES' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION READ_RULE_FILTER_ISCHEMICAL +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Matches a filter rule against provided parameters and determines if a match is found. +!> +!> This function checks whether the provided parameters match the filter rules defined in `FILTER`. +!> It returns a logical flag `MATCH` indicating if the parameters meet the filter criteria. The function +!> also supports `VERBOSE` mode to provide additional debugging output. +!> +!> @param [in] FILTER The filter rules to be applied for matching. +!> @param [in] IN_PARAMID Parameter ID to be matched. +!> @param [in] IN_LEVEL Level to be matched. +!> @param [in] IN_REPRES Representation to be matched. +!> @param [in] IN_LEVTYPE Level type to be matched. +!> @param [in] IN_TAG Tag to be matched. +!> @param [in] IN_ISENSEMBLE Logical flag indicating whether is-ensemble should be matched. +!> @param [in] IN_ISCHEMICAL Logical flag indicating whether is-chemical should be matched. +!> @param [out] MATCH Logical flag indicating if the filter criteria are met (`.TRUE.`) or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_EMPTY_FILTER` (1): Error when `FILTER` is empty +!> +!> @see FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'MATCH_RULE_FILTER_ATM' +__THREAD_SAFE__ FUNCTION MATCH_RULE_FILTER_ATM( FILTER, & +& IN_PARAMID, IN_LEVEL, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISENSEMBLE, IN_ISCHEMICAL, MATCH, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + + +IMPLICIT NONE + + ! Dummy arguments + TYPE(FILTER_RULES_T), INTENT(IN) :: FILTER + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_REPRES + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + CHARACTER(LEN=TAG_LEN), INTENT(IN) :: IN_TAG + LOGICAL, INTENT(IN) :: IN_ISENSEMBLE + LOGICAL, INTENT(IN) :: IN_ISCHEMICAL + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_EMPTY_FILTER=1_ERR_K + + ! Local variables + LOGICAL, DIMENSION(7) :: CONDITIONS + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Get the conditions + CONDITIONS(1) = FILTER%HAS_PARAMID + CONDITIONS(2) = FILTER%HAS_LEVEL + CONDITIONS(3) = FILTER%HAS_REPRES + CONDITIONS(4) = FILTER%HAS_LEVTYPE + CONDITIONS(5) = FILTER%HAS_TAG + CONDITIONS(6) = FILTER%HAS_ISENSEMBLE + CONDITIONS(7) = FILTER%HAS_ISCHEMICAL + + ! Empty filter not allowed + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ANY(CONDITIONS), ERRFLAG_EMPTY_FILTER ) + + ! Initialization + MATCH = .TRUE. + + ! Try to match paramId + IF ( MATCH .AND. FILTER%HAS_PARAMID ) THEN + MATCH = MATCH .AND. ANY( FILTER%PARAMID.EQ.IN_PARAMID ) + ENDIF + + ! Try to match level + IF ( MATCH .AND. FILTER%HAS_LEVEL ) THEN + MATCH = MATCH .AND. ANY( FILTER%LEVEL.EQ.IN_LEVEL ) + ENDIF + + ! Try to match repres + IF ( MATCH .AND. FILTER%HAS_REPRES ) THEN + MATCH = MATCH .AND. ANY( FILTER%REPRES.EQ.IN_REPRES ) + ENDIF + + ! Try to match levtype + IF ( MATCH .AND. FILTER%HAS_LEVTYPE ) THEN + MATCH = MATCH .AND. ANY( FILTER%LEVTYPE.EQ.IN_LEVTYPE ) + ENDIF + + ! Try to match tag + IF ( MATCH .AND. FILTER%HAS_TAG ) THEN + MATCH = MATCH .AND. ANY( FILTER%TAG.EQ.IN_TAG ) + ENDIF + + ! Try to match is-ensemble + IF ( MATCH .AND. FILTER%HAS_ISENSEMBLE ) THEN + MATCH = MATCH .AND. (FILTER%ISENSEMBLE.EQ.IN_ISENSEMBLE) + ENDIF + + ! Try to match is-chemical + IF ( MATCH .AND. FILTER%HAS_ISCHEMICAL ) THEN + MATCH = MATCH .AND. (FILTER%ISCHEMICAL.EQ.IN_ISCHEMICAL) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_EMPTY_FILTER) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'EMPTY FILTERS are not allowed' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION MATCH_RULE_FILTER_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Matches a filter rule against provided parameters and determines if a match is found. +!> +!> This function checks whether the provided parameters match the filter rules defined in `FILTER`. +!> It returns a logical flag `MATCH` indicating if the parameters meet the filter criteria. The function +!> also supports `VERBOSE` mode to provide additional debugging output. +!> +!> @param [in] FILTER The filter rules to be applied for matching. +!> @param [in] IN_PARAMID Parameter ID to be matched. +!> @param [in] IN_DIRECTION Direction to be matched. +!> @param [in] IN_FREQUENCY Frequency to be matched. +!> @param [in] IN_REPRES Representation to be matched. +!> @param [in] IN_LEVTYPE Level type to be matched. +!> @param [in] IN_TAG Tag to be matched. +!> @param [in] IN_ISENSEMBLE Logical flag indicating whether is-ensemble should be matched. +!> @param [in] IN_ISCHEMICAL Logical flag indicating whether is-chemical should be matched. +!> @param [out] MATCH Logical flag indicating if the filter criteria are met (`.TRUE.`) or not (`.FALSE.`). +!> @param [in] VERBOSE Logical flag indicating whether verbose output is enabled (`.TRUE.`) for debugging purposes. +!> +!> @return Integer error code (`RET`) indicating success or failure of the operation. +!> Possible values: +!> - `0`: Success +!> - `1`: Failure +!> +!> @section dependencies Dependencies of this function: +!> +!> @subsubsection module dependencies +!> - @dependency [TYPE] "FILTER_RULES_T" +!> +!> @subsection local dependencies +!> - @dependency [PARAMETER] "OM_CORE_MOD::JPIB_K" +!> +!> @subsection special dependencies +!> - @dependency [*] "OM_DEBUG_MOD::*" +!> - @dependency [*] "OM_LOG_MOD::*" +!> - @dependency [*] "OM_TRACE_MOD::*" +!> +!> @section Error codes explicitly handled in this function: +!> - `ERRFLAG_EMPTY_FILTER` (1): Error when `FILTER` is empty +!> +!> @see FILTER_RULES_T +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'MATCH_RULE_FILTER_WAM' +__THREAD_SAFE__ FUNCTION MATCH_RULE_FILTER_WAM( FILTER, & +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_REPRES, IN_LEVTYPE, & +& IN_TAG, IN_ISENSEMBLE, IN_ISCHEMICAL, MATCH, VERBOSE ) RESULT(RET) + + ! Symbols imported from other modules within the project. + PP_USE_L('P') :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for logging purposes + PP_LOG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(FILTER_RULES_T), INTENT(IN) :: FILTER + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_DIRECTION + INTEGER(KIND=JPIB), INTENT(IN) :: IN_FREQUENCY + INTEGER(KIND=JPIB), INTENT(IN) :: IN_REPRES + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + CHARACTER(LEN=TAG_LEN), INTENT(IN) :: IN_TAG + LOGICAL, INTENT(IN) :: IN_ISENSEMBLE + LOGICAL, INTENT(IN) :: IN_ISCHEMICAL + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Function return value + INTEGER(KIND=ERR_K) :: RET + + ! Local error codes + INTEGER(KIND=ERR_K), PARAMETER :: ERRFLAG_EMPTY_FILTER=1_ERR_K + + ! Local variables + LOGICAL, DIMENSION(8) :: CONDITIONS + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for loging purposes + PP_LOG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) + + ! Get the conditions + CONDITIONS(1) = FILTER%HAS_PARAMID + CONDITIONS(2) = FILTER%HAS_DIRECTION + CONDITIONS(3) = FILTER%HAS_FREQUENCY + CONDITIONS(4) = FILTER%HAS_REPRES + CONDITIONS(5) = FILTER%HAS_LEVTYPE + CONDITIONS(6) = FILTER%HAS_TAG + CONDITIONS(7) = FILTER%HAS_ISENSEMBLE + CONDITIONS(8) = FILTER%HAS_ISCHEMICAL + + ! Empty filter not allowed + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ANY(CONDITIONS), ERRFLAG_EMPTY_FILTER ) + + ! Initialization + MATCH = .TRUE. + + ! Try to match paramId + IF ( MATCH .AND. FILTER%HAS_PARAMID ) THEN + MATCH = MATCH .AND. ANY( FILTER%PARAMID.EQ.IN_PARAMID ) + ENDIF + + ! Try to match direction + IF ( MATCH .AND. FILTER%HAS_DIRECTION ) THEN + MATCH = MATCH .AND. ANY( FILTER%DIRECTION.EQ.IN_DIRECTION ) + ENDIF + + ! Try to match frequency + IF ( MATCH .AND. FILTER%HAS_FREQUENCY ) THEN + MATCH = MATCH .AND. ANY( FILTER%FREQUENCY.EQ.IN_FREQUENCY ) + ENDIF + + ! Try to match repres + IF ( MATCH .AND. FILTER%HAS_REPRES ) THEN + MATCH = MATCH .AND. ANY( FILTER%REPRES.EQ.IN_REPRES ) + ENDIF + + ! Try to match levtype + IF ( MATCH .AND. FILTER%HAS_LEVTYPE ) THEN + MATCH = MATCH .AND. ANY( FILTER%LEVTYPE.EQ.IN_LEVTYPE ) + ENDIF + + ! Try to match tag + IF ( MATCH .AND. FILTER%HAS_TAG ) THEN + MATCH = MATCH .AND. ANY( FILTER%TAG.EQ.IN_TAG ) + ENDIF + + ! Try to match is-ensemble + IF ( MATCH .AND. FILTER%HAS_ISENSEMBLE ) THEN + MATCH = MATCH .AND. (FILTER%ISENSEMBLE.EQ.IN_ISENSEMBLE) + ENDIF + + ! Try to match is-chemical + IF ( MATCH .AND. FILTER%HAS_ISCHEMICAL ) THEN + MATCH = MATCH .AND. (FILTER%ISCHEMICAL.EQ.IN_ISCHEMICAL) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ! Initialization of bad path return value + PP_SET_ERR_FAILURE( RET ) + +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_EMPTY_FILTER) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'EMPTY FILTERS are not allowed' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point on error + RETURN + +END FUNCTION MATCH_RULE_FILTER_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +END MODULE YAML_FILTERS_UTILS_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/grib_info/yaml_mapping_uitls_mod.F90 b/src/ecom/grib_info/yaml_mapping_uitls_mod.F90 new file mode 100644 index 000000000..581aa2aa2 --- /dev/null +++ b/src/ecom/grib_info/yaml_mapping_uitls_mod.F90 @@ -0,0 +1,920 @@ +! Include preprocessor utils +#include "output_manager_preprocessor_utils.h" +#include "output_manager_preprocessor_trace_utils.h" +#include "output_manager_preprocessor_logging_utils.h" +#include "output_manager_preprocessor_errhdl_utils.h" + + +#define PP_FILE_NAME 'yaml_mapping_utils_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'YAML_MAPPING_UTILS_MOD' +MODULE YAML_MAPPING_UTILS_MOD +IMPLICIT NONE + +! Data types +TYPE :: MAPPING_RULE_T + + PRIVATE + + INTEGER(KIND=JPIB_K) :: FROM_PARAM_ID + INTEGER(KIND=JPIB_K) :: FROM_LEVEL + INTEGER(KIND=JPIB_K) :: FROM_DIRECTION + INTEGER(KIND=JPIB_K) :: FROM_FREQUENCY + INTEGER(KIND=JPIB_K) :: FROM_LEVTYPE + + INTEGER(KIND=JPIB_K) :: TO_PARAM_ID + INTEGER(KIND=JPIB_K) :: TO_LEVEL + INTEGER(KIND=JPIB_K) :: TO_DIRECTION + INTEGER(KIND=JPIB_K) :: TO_FREQUENCY + INTEGER(KIND=JPIB_K) :: TO_LEVTYPE + REAL(KIND_JPRD_K) :: SCALE_FACTOR + +CONTAINS + + PROCEDURE, PUBLIC, PASS :: READ => READ_RULE_MAPPING_FROM + PROCEDURE, PUBLIC, PASS :: MATCH => MATCH_RULE_MAPPING_FROM + PROCEDURE, PUBLIC, PASS :: APPLY => MATCH_RULE_MAPPING_FROM + PROCEDURE, PUBLIC, PASS :: FREE => FREE_RULE_MAPPING_FROM + +END TYPE + +TYPE :: MAPPING_RULES_T + TYPE(MAPPING_RULE_T), DIMENSION(:), ALLOCATABLE :: MAPS +END TYPE + + + +CONTAINS + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPINGS' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPINGS( CFG, MAPPINGS, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATIONS_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_CONFIGURATIONS_SIZE + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_CONFIGURATION_BY_ID + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATIONS + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATIONS + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(MAPPING_RULES_T) INTENT(OUT) :: MAPPINGS + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATIONS_T) :: MAPPING_RULES_CFG + TYPE(YAML_CONFIGURATION_T) :: CURR_CFG + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: N + INTEGER(KIND=JPIB_K) :: ALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + LOGICAL :: CFG_HAS_MAPPING_RULES + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( ALLOCATED(MAPPINGS%MAPS), 0 ) + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'mapping-rules', CFG_HAS_MAPPING_RULES, VERBOSE ) + + ! Reading all the rules + IF ( CFG_HAS_MAPPING_RULES ) THEN + + ! Read the mapping rules + CALL YAML_GET_SUBCONFIGURATIONS( CFG, 'mapping-rules', MAPPING_RULES_CFG, VERBOSE ) + + ! Get the number of rules + CALL YAML_GET_CONFIGURATIONS_SIZE( MAPPING_RULES_CFG, N, VERBOSE ) + + ! Check the allocation status of the subconfigurations + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(MAPPING_RULES_CFG), 1 ) + + ! Allocate output structure + ALLOCATE( MAPPINGS%MAPS(N), STATUS=ALLOC_STATUS, ERRMSG=ERRMSG ) + PP_DEBUG_CRITICAL_COND_THROW( ALLOC_STATUS .NE. 0, 2 ) + + ! Read rules one-by-one + DO I = 1, N + + ! Get the current configuration + CALL YAML_GET_CONFIGURATION_BY_ID( MAPPING_RULES_CFG, I, CURR_CFG, VERBOSE ) + + ! Read the mapping rule + CALL READ_RULE_MAPPING( CURR_CFG, MAPPINGS%MAPPING(I), VERBOSE ) + + ENDDO + + ! Free subconfigurations + CALL YAML_DELETE_CONFIGURATIONS( MAPPING_RULES_CFG ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (0) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Mappings output structure already allocated' ) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Mappings configuration not allocated after reading' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate mapping output structure: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to allocate lookup_table' ) + ENDIF + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPINGS +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPING' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPING( CFG, MAPPING, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + TYPE(MAPPING_RULE_T), INTENT(OUT) :: MAPPING + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Read the matching conditions + CALL READ_RULE_MAPPING_FROM( CFG, & +& MAPPING%FROM_PARAM_ID, MAPPING%FROM_LEVEL, MAPPING%FROM_DIRECTION, & +& MAPPING%FROM_FREQUENCY, MAPPING%FROM_LEVTYPE, VERBOSE ) + + ! Read the mapping values + CALL READ_RULE_MAPPING_TO( CFG, & +& MAPPING%TO_PARAM_ID, MAPPING%TO_LEVEL, MAPPING%TO_DIRECTION, & +& MAPPING%TO_FREQUENCY, MAPPING%TO_LEVTYPE, MAPPING%SCALE_FACTOR, VERBOSE ) + + ! Check the mapping consistency + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%FROM_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%FROM_DIRECTION.NE.UNDEF_PARAM_E, 1 ) + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%TO_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%TO_DIRECTION.NE.UNDEF_PARAM_E, 2 ) + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%FROM_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%FROM_FREQUENCY.NE.UNDEF_PARAM_E, 3 ) + PP_DEBUG_CRITICAL_COND_THROW( MAPPING%TO_LEVEL.NE.UNDEF_PARAM_E .AND. MAPPING%TO_FREQUENCY.NE.UNDEF_PARAM_E, 4 ) + + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping from-level and from-direction cannot be specified at the same time' ) + CASE (2) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping to-level and to-direction cannot be specified at the same time' ) + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping from-level and from-frequency cannot be specified at the same time' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Inconsistent mapping to-level and to-frequency cannot be specified at the same time' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPING +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPING_FROM' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPING_FROM( CFG, PARAMID, LEVEL, & +& DIRECTION, FREQUENCY, LEVTYPE, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATION + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB), INTENT(OUT) :: PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: DIRECTION + INTEGER(KIND=JPIB), INTENT(OUT) :: FREQUENCY + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVTYPE + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATION_T) :: FROM_CFG + CHARACTER(LEN=:), ALLOCATABLE :: LOC_LEVTYPE + INTEGER(KIND=JPIB_K) :: CNT + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + LOGICAL :: CONFIGURATION_HAS_FROM + LOGICAL :: CONFIGURATION_HAS_PARAMID + LOGICAL :: CONFIGURATION_HAS_LEVEL + LOGICAL :: CONFIGURATION_HAS_DIRECTION + LOGICAL :: CONFIGURATION_HAS_FREQUENCY + LOGICAL :: CONFIGURATION_HAS_LEVTYPE + LOGICAL :: CONFIGURATION_HAS_TAG + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'from', CONFIGURATION_HAS_FROM, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_FROM, 3 ) + + ! Rules defined in-place + CNT = 0 + IF ( CONFIGURATION_HAS_FROM ) THEN + + ! Read the "from" subconfiguration + CALL YAML_GET_SUBCONFIGURATION( CFG, 'from', FROM_CFG, VERBOSE ) + + ! Configuration substructure + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'paramId', CONFIGURATION_HAS_PARAMID, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'level', CONFIGURATION_HAS_LEVEL, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'direction', CONFIGURATION_HAS_DIRECTION, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'frequency', CONFIGURATION_HAS_FREQUENCY, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'levtype', CONFIGURATION_HAS_LEVTYPE, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( FROM_CFG, 'tag', CONFIGURATION_HAS_TAG, VERBOSE ) + + ! Read the paramId + IF ( CONFIGURATION_HAS_PARAMID ) THEN + CALL YAML_READ_INTEGER( FROM_CFG, 'paramId', PARAMID, VERBOSE ) + CNT = CNT + 1 + ELSE + PARAMID = UNDEF_PARAM_E + ENDIF + + ! Read the level + IF ( CONFIGURATION_HAS_LEVEL ) THEN + CALL YAML_INTEGER_STRING( FROM_CFG, 'level', LEVEL, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the direction + IF ( CONFIGURATION_HAS_DIRECTION ) THEN + CALL YAML_INTEGER_STRING( FROM_CFG, 'direction', DIRECTION, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the frequency + IF ( CONFIGURATION_HAS_FREQUENCY ) THEN + CALL YAML_INTEGER_STRING( FROM_CFG, 'frequency', FREQUENCY, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + IF ( CONFIGURATION_HAS_LEVTYPE ) THEN + CALL YAML_READ_STRING( FROM_CFG, 'levtype', LOC_LEVTYPE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_LEVTYPE), 1 ) + IF ( STRING_IS_INTEGER( LOC_LEVTYPE ) ) THEN + READ(LOC_LEVTYPE, *) LEVTYPE + ELSE + CALL CLEVTYPE2ILEVTYPE( LOC_LEVTYPE, LEVTYPE ) + ENDIF + DEALLOCATE(LOC_LEVTYPE, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 2 ) + CNT = CNT + 1 + ELSE + LEVTYPE = UNDEF_PARAM_E + ENDIF + + ! Free subconfiguration + CALL YAML_DELETE_CONFIGURATION( FROM_CFG ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( CNT.LT.1, 4 ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'levtype is not allocated after read' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype' ) + ENDIF + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to find "from" subconfiguration' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'no rule found in "from" subconfiguration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPING_FROM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'READ_RULE_MAPPING_TO' +__THREAD_SAFE__ SUBROUTINE READ_RULE_MAPPING_TO( CFG, PARAMID, LEVEL, & +& DIRECTION, FREQUENCY, LEVTYPE, SCALE_FACTOR, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + USE :: OM_CORE_MOD, ONLY: JPRD_K + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_T + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_GET_SUBCONFIGURATION + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_CONFIGURATION_HAS_KEY + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_INTEGER + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_STRING + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_READ_FLOAT + USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(YAML_CONFIGURATION_T), INTENT(IN) :: CFG + INTEGER(KIND=JPIB), INTENT(OUT) :: PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: DIRECTION + INTEGER(KIND=JPIB), INTENT(OUT) :: FREQUENCY + INTEGER(KIND=JPIB), INTENT(OUT) :: LEVTYPE + REAL(KIND=JPRD_K), INTENT(OUT) :: SCALE_FACTOR + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + TYPE(YAML_CONFIGURATION_T) :: TO_CFG + CHARACTER(LEN=:), ALLOCATABLE :: LOC_LEVTYPE + CHARACTER(LEN=:), ALLOCATABLE :: ERRMSG + INTEGER(KIND=JPIB_K) :: CNT + INTEGER(KIND=JPIB_K) :: DEALLOC_STATUS + LOGICAL :: CONFIGURATION_HAS_TO + LOGICAL :: CONFIGURATION_HAS_PARAMID + LOGICAL :: CONFIGURATION_HAS_LEVEL + LOGICAL :: CONFIGURATION_HAS_DIRECTION + LOGICAL :: CONFIGURATION_HAS_FREQUENCY + LOGICAL :: CONFIGURATION_HAS_LEVTYPE + LOGICAL :: CONFIGURATION_HAS_SCALE_FACTOR + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Configuration structure + CALL YAML_CONFIGURATION_HAS_KEY( CFG, 'to', CONFIGURATION_HAS_TO, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.CONFIGURATION_HAS_TO, 3 ) + + ! Rules defined in-place + CNT = 0 + IF ( CONFIGURATION_HAS_TO ) THEN + + ! Read the "from" subconfiguration + CALL YAML_GET_SUBCONFIGURATION( CFG, 'to', TO_CFG, VERBOSE ) + + ! Configuration substructure + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'paramId', CONFIGURATION_HAS_PARAMID, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'level', CONFIGURATION_HAS_LEVEL, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'direction', CONFIGURATION_HAS_DIRECTION, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'frequency', CONFIGURATION_HAS_FREQUENCY, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'levtype', CONFIGURATION_HAS_LEVTYPE, VERBOSE ) + CALL YAML_CONFIGURATION_HAS_KEY( TO_CFG, 'scale-factor', CONFIGURATION_HAS_SCALE_FACTOR, VERBOSE ) + + ! Read the paramId + IF ( CONFIGURATION_HAS_PARAMID ) THEN + CALL YAML_READ_INTEGER( TO_CFG, 'paramId', PARAMID, VERBOSE ) + CNT = CNT + 1 + ELSE + PARAMID = UNDEF_PARAM_E + ENDIF + + ! Read the level + IF ( CONFIGURATION_HAS_LEVEL ) THEN + CALL YAML_INTEGER_STRING( TO_CFG, 'level', LEVEL, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the direction + IF ( CONFIGURATION_HAS_DIRECTION ) THEN + CALL YAML_INTEGER_STRING( TO_CFG, 'direction', DIRECTION, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the frequency + IF ( CONFIGURATION_HAS_FREQUENCY ) THEN + CALL YAML_INTEGER_STRING( TO_CFG, 'frequency', FREQUENCY, VERBOSE ) + CNT = CNT + 1 + ELSE + LEVEL = UNDEF_PARAM_E + ENDIF + + ! Read the lectype + IF ( CONFIGURATION_HAS_LEVTYPE ) THEN + CALL YAML_READ_STRING( TO_CFG, 'levtype', LOC_LEVTYPE, VERBOSE ) + PP_DEBUG_CRITICAL_COND_THROW( .NOT.ALLOCATED(LOC_LEVTYPE), 1 ) + IF ( STRING_IS_INTEGER( LOC_LEVTYPE ) ) THEN + READ(LOC_LEVTYPE, *) LEVTYPE + ELSE + CALL CLEVTYPE2ILEVTYPE( LOC_LEVTYPE, LEVTYPE ) + ENDIF + DEALLOCATE(LOC_LEVTYPE, STATUS=DEALLOC_STATUS, ERRMSG=ERRMSG) + PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, 2 ) + CNT = CNT + 1 + ELSE + LEVTYPE = UNDEF_PARAM_E + ENDIF + + ! Read the scale factor + IF ( CONFIGURATION_HAS_SCALE_FACTOR ) THEN + CALL YAML_READ_FLOAT( TO_CFG, 'scale-factor', LOC_SCALE_FACTOR, VERBOSE ) + ELSE + LEVTYPE = 1.0_JPRD_K + ENDIF + + ! Free subconfiguration + CALL YAML_DELETE_CONFIGURATION( FROM_CFG ) + + ! Error handling + PP_DEBUG_CRITICAL_COND_THROW( CNT.LT.1, 4 ) + + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +! Error handler +PP_ERROR_HANDLER + + ErrorHandler: BLOCK + + ! Error handling variables + CHARACTER(LEN=:), ALLOCATABLE :: STR + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (1) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'levtype is not allocated after read' ) + CASE (2) + IF ( ALLOCATED(ERRMSG) ) THEN + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype: "'//TRIM(ERRMSG)//'"' ) + DEALLOCATE(ERRMSG) + ELSE + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to deallocate levtype' ) + ENDIF + CASE (3) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unable to find "from" subconfiguration' ) + CASE (4) + PP_DEBUG_CREATE_ERROR_MSG( STR, 'no rule found in "from" subconfiguration' ) + CASE DEFAULT + PP_DEBUG_CREATE_ERROR_MSG( STR, 'Unhandled error' ) + END SELECT + + ! Trace end of procedure (on error) + PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + + ! Write the error message and stop the program + PP_DEBUG_ABORT( STR ) + + END BLOCK ErrorHandler + + ! Exit point on error + RETURN + +END SUBROUTINE READ_RULE_MAPPING_TO +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_MAPPING_ATM' +__THREAD_SAFE__ SUBROUTINE MATCH_MAPPING_ATM( MAP, & +& IN_PARAMID, IN_LEVEL, IN_LEVTYPE, MATCH, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + MATCH = .TRUE. + + IF ( MATCH .AND. MAP%FROM_PARAM_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_PARAM_ID.EQ.IN_PARAMID ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_LEVEL_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_LEVEL.EQ.IN_LEVEL ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_LEVTYPE_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_LEVTYPE.EQ.IN_LEVTYPE ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE MATCH_MAPPING_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'APPLY_MAPPING_ATM' +__THREAD_SAFE__ SUBROUTINE APPLY_MAPPING_ATM( MAP, & +& IN_PARAMID, IN_LEVEL, IN_LEVTYPE, & +& OUT_PARAMID, OUT_LEVEL, OUT_LEVTYPE, OUT_SCALE_FACTOR, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVTYPE + REAL(KIND=JPRD_K), INTENT(OUT) :: OUT_SCALE_FACTOR + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: MATCH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + CALL MATCH_MAPPING_ATM( MAP, IN_PARAMID, IN_LEVEL, IN_LEVTYPE, MATCH, VERBOSE ) + + ! Crete mapped values + IF ( MATCH .AND. MAP%TO_PARAM_ID .NE. UNDEF_PARAM_E ) THEN + OUT_PARAMID = MAP%TO_PARAM_ID + ELSE + OUT_PARAMID = IN_PARAMID + ENDIF + + IF ( MATCH .AND. MAP%TO_LEVEL .NE. UNDEF_PARAM_E ) THEN + OUT_LEVEL = MAP%TO_LEVEL + ELSE + OUT_LEVEL = IN_LEVEL + ENDIF + + IF ( MATCH .AND. MAP%TO_LEVTYPE .NE. UNDEF_PARAM_E ) THEN + OUT_LEVTYPE = MAP%TO_LEVTYPE + ELSE + OUT_LEVTYPE = IN_LEVTYPE + ENDIF + + OUT_SCALE_FACTOR = MAP%SCALE_FACTOR + + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE APPLY_MAPPING_ATM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'MATCH_MAPPING_WAM' +__THREAD_SAFE__ SUBROUTINE MATCH_MAPPING_WAM( MAP,& +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_LEVTYPE, MATCH, VERBOSE) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + LOGICAL, INTENT(OUT) :: MATCH + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Initialization + MATCH = .TRUE. + + IF ( MATCH .AND. MAP%FROM_PARAM_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_PARAM_ID.EQ.IN_PARAMID ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_DIRECTION.NE.UNDEF_PARAM_E ) THEN + MATCH = ( MAP%FROM_DIRECTION.EQ.IN_DIRECTION ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_FREQUENCY.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_FREQUENCY.EQ.IN_FREQUENCY ) + ENDIF + + IF ( MATCH .AND. MAP%FROM_LEVTYPE_ID.NE.UNDEF_PARAM_E ) THEN + MATCH = MATCH .AND. ( MAP%FROM_LEVTYPE.EQ.IN_LEVTYPE ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE MATCH_MAPPING_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'SUBROUTINE' +#define PP_PROCEDURE_NAME 'APPLY_MAPPING_WAM' +__THREAD_SAFE__ SUBROUTINE APPLY_MAPPING_WAM( MAP,& +& IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_LEVTYPE, & +& OUT_PARAMID, OUT_DIRECTION, OUT_FREQUENCY, OUT_LEVTYPE, & +& OUT_SCALE_FACTOR, VERBOSE ) + + ! Symbols imported from other modules within the project. + USE :: OM_CORE_MOD, ONLY: JPIB_K + + ! Symbols imported by the preprocessor for debugging purposes + PP_DEBUG_USE_VARS + + ! Symbols imported by the preprocessor for tracing purposes + PP_TRACE_USE_VARS + +IMPLICIT NONE + + ! Dummy arguments + TYPE(MAPPING_RULE_T), INTENT(IN) :: MAP + INTEGER(KIND=JPIB), INTENT(IN) :: IN_PARAMID + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVEL + INTEGER(KIND=JPIB), INTENT(IN) :: IN_LEVTYPE + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_PARAMID + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVEL + INTEGER(KIND=JPIB), INTENT(OUT) :: OUT_LEVTYPE + REAL(KIND=JPRD_K), INTENT(OUT) :: OUT_SCALE_FACTOR + LOGICAL, INTENT(IN) :: VERBOSE + + ! Local variables + LOGICAL :: MATCH + + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS + + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS + + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() + + ! Check if the mapping matches the input values + CALL MATCH_MAPPING_WAM( MAP, IN_PARAMID, IN_DIRECTION, IN_FREQUENCY, IN_LEVTYPE, MATCH, VERBOSE ) + + ! Crete mapped values + IF ( MATCH .AND. MAP%TO_PARAM_ID .NE. UNDEF_PARAM_E ) THEN + OUT_PARAMID = MAP%TO_PARAM_ID + ELSE + OUT_PARAMID = IN_PARAMID + ENDIF + + IF ( MATCH .AND. MAP%TO_DIRECTION .NE. UNDEF_PARAM_E ) THEN + OUT_DIRECTION = MAP%TO_DIRECTION + ELSE + OUT_DIRECTION = IN_DIRECTION + ENDIF + + IF ( MATCH .AND. MAP%TO_FREQUENCY .NE. UNDEF_PARAM_E ) THEN + OUT_FREQUENCY = MAP%TO_FREQUENCY + ELSE + OUT_FREQUENCY = IN_FREQUENCY + ENDIF + + IF ( MATCH .AND. MAP%TO_LEVTYPE .NE. UNDEF_PARAM_E ) THEN + OUT_LEVTYPE = MAP%TO_LEVTYPE + ELSE + OUT_LEVTYPE = IN_LEVTYPE + ENDIF + + OUT_SCALE_FACTOR = MAP%SCALE_FACTOR + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point + RETURN + +END SUBROUTINE APPLY_MAPPING_WAM +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +END MODULE YAML_MAPPING_UTILS_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/ecom/include/standard/output_manager_preprocessor_errhdl_utils.h.in b/src/ecom/include/standard/output_manager_preprocessor_errhdl_utils.h.in index 0ce89a860..b2ccb6e8e 100644 --- a/src/ecom/include/standard/output_manager_preprocessor_errhdl_utils.h.in +++ b/src/ecom/include/standard/output_manager_preprocessor_errhdl_utils.h.in @@ -53,4 +53,5 @@ LINE, ERRIDX, MSG, GRIBID, GRIBMSG ) #define PP_DEBUG_ABORT( STR ) \ CALL OM_ABORT( STR ) + #endif \ No newline at end of file diff --git a/src/multio/action/ifs-atm-adaptor/store.h b/src/multio/action/ifs-atm-adaptor/store.h new file mode 100644 index 000000000..6a1cb8b0a --- /dev/null +++ b/src/multio/action/ifs-atm-adaptor/store.h @@ -0,0 +1,241 @@ +#include +#include +#include +#include +#include + +// Define a template structure for the iterator +template +class MultiLevelIterator { + using OuterIterator = typename OuterMap::const_iterator; + using BoxIterator = typename std::vector>>::const_iterator; + using VectorIterator = typename std::vector>::const_iterator; + using InnerVectorIterator = typename std::vector::const_iterator; + using InnerIterator = typename InnerMap::const_iterator; + + OuterIterator outer_it, outer_end; + BoxIterator box_it, box_end; + VectorIterator vec_it, vec_end; + InnerVectorIterator inner_vec_it, inner_vec_end; + InnerIterator inner_it, inner_end; + +public: + MultiLevelIterator(const OuterMap& outer_map) + : outer_it(outer_map.begin()), outer_end(outer_map.end()) { + if (outer_it != outer_end) { + box_it = outer_it->second.begin(); + box_end = outer_it->second.end(); + if (box_it != box_end) { + vec_it = box_it->begin(); + vec_end = box_it->end(); + if (vec_it != vec_end) { + inner_vec_it = vec_it->begin(); + inner_vec_end = vec_it->end(); + if (inner_vec_it != inner_vec_end) { + inner_it = inner_vec_it->begin(); + inner_end = inner_vec_it->end(); + } + } + } + } + } + + bool operator!=(const MultiLevelIterator& other) const { + return outer_it != other.outer_it || box_it != other.box_it || vec_it != other.vec_it || inner_vec_it != other.inner_vec_it || inner_it != other.inner_it; + } + + MultiLevelIterator& operator++() { + if (inner_it != inner_end) { + ++inner_it; + } + if (inner_it == inner_end) { + ++inner_vec_it; + if (inner_vec_it != inner_vec_end) { + inner_it = inner_vec_it->begin(); + inner_end = inner_vec_it->end(); + } else { + ++vec_it; + if (vec_it != vec_end) { + inner_vec_it = vec_it->begin(); + inner_vec_end = vec_it->end(); + if (inner_vec_it != inner_vec_end) { + inner_it = inner_vec_it->begin(); + inner_end = inner_vec_it->end(); + } + } else { + ++box_it; + if (box_it != box_end) { + vec_it = box_it->begin(); + vec_end = box_it->end(); + if (vec_it != vec_end) { + inner_vec_it = vec_it->begin(); + inner_vec_end = vec_it->end(); + if (inner_vec_it != inner_vec_end) { + inner_it = inner_vec_it->begin(); + inner_end = inner_vec_it->end(); + } + } + } else { + ++outer_it; + if (outer_it != outer_end) { + box_it = outer_it->second.begin(); + box_end = outer_it->second.end(); + if (box_it != box_end) { + vec_it = box_it->begin(); + vec_end = box_it->end(); + if (vec_it != vec_end) { + inner_vec_it = vec_it->begin(); + inner_vec_end = vec_it->end(); + if (inner_vec_it != inner_vec_end) { + inner_it = inner_vec_it->begin(); + inner_end = inner_vec_it->end(); + } + } + } + } + } + } + } + } + return *this; + } + + const Payload& operator*() const { + return inner_it->second; + } +}; + +template class OuterMapType = std::map, template class InnerMapType = std::map> +class MultiLevelDataStructure { +public: + using InnerMap = InnerMapType; + using Box = std::vector>>; + using DataMap = OuterMapType; + + MultiLevelDataStructure() {} + + // Method to get the size of the main map + size_t size() const { + return data.size(); + } + + // Overloaded size methods for partial sizes + size_t size(size_t p) const { + auto it = data.find(p); + if (it != data.end()) { + return it->second.size(); + } + return 0; + } + + size_t size(size_t p, int i) const { + if (data.find(p) != data.end() && i < Size1) { + return data.at(p)[i].size(); + } + return 0; + } + + size_t size(size_t p, int i, int j) const { + if (data.find(p) != data.end() && i < Size1 && j < Size2) { + return data.at(p)[i][j].size(); + } + return 0; + } + + size_t size(size_t p, int i, int j, int k) const { + if (data.find(p) != data.end() && i < Size1 && j < Size2 && k < Size3) { + return data.at(p)[i][j][k].size(); + } + return 0; + } + + // Method to check if an element exists + bool exist(size_t p, int i, int j, int k, size_t l) const { + if (data.find(p) != data.end() && i < Size1 && j < Size2 && k < Size3) { + return data.at(p)[i][j][k].find(l) != data.at(p)[i][j][k].end(); + } + return false; + } + + // Method to access or create an element + Payload* access_or_create(size_t p, int i, int j, int k, size_t l) { + if (data.find(p) == data.end()) { + data[p] = createBox(); + } + return &(data[p][i][j][k][l]); + } + + // Method to push an element + bool push(size_t p, int i, int j, int k, size_t l, const Payload& payload, bool force = false) { + if (exist(p, i, j, k, l) && !force) { + return false; + } + *access_or_create(p, i, j, k, l) = payload; + return true; + } + + // Method to get a pointer to an element + Payload* get(size_t p, int i, int j, int k, size_t l) { + if (exist(p, i, j, k, l)) { + return &(data[p][i][j][k][l]); + } + return nullptr; + } + + // Method to pop an element + Payload* pop(size_t p, int i, int j, int k, size_t l) { + if (!exist(p, i, j, k, l)) { + return nullptr; + } + Payload* payload = new Payload(data[p][i][j][k][l]); + data[p][i][j][k].erase(l); + return payload; + } + + // Method to clear all elements + void clear() { + data.clear(); + } + + // Method to erase an element by key + void erase(size_t p) { + data.erase(p); + } + + // Method to delete an element + void erase(size_t p, int i, int j, int k, size_t l) { + if (exist(p, i, j, k, l)) { + data[p][i][j][k].erase(l); + } + } + + // Method to display the structure (for demonstration purposes) + void display() const { + for (const auto& [key, box] : data) { + std::cout << "Key: " << key << std::endl; + for (size_t i = 0; i < box.size(); ++i) { + for (size_t j = 0; j < box[i].size(); ++j) { + for (size_t k = 0; k < box[i][j].size(); ++k) { + for (const auto& [innerKey, payload] : box[i][j][k]) { + std::cout << " [" << i << "][" << j << "][" << k << "][" << innerKey << "] = " << payload << std::endl; + } + } + } + } + } + } + + // Iterator support + using iterator = MultiLevelIterator; + iterator begin() const { return iterator(data); } + iterator end() const { return iterator(DataMap()); } + +private: + // Data structure to hold the multi-level data + DataMap data; + + // Helper method to create a 3D vector with the templated sizes + Box createBox() { + return Box(Size1, std::vector>(Size2, std::vector(Size3))); + } +};