diff --git a/src/multiom/data-structures/fortran_message_mod.F90 b/src/multiom/data-structures/fortran_message_mod.F90 index 173a9898..ec1a1429 100644 --- a/src/multiom/data-structures/fortran_message_mod.F90 +++ b/src/multiom/data-structures/fortran_message_mod.F90 @@ -778,9 +778,9 @@ END FUNCTION FORTRAN_MESSAGE_COPY_DATA_FROM FUNCTION FORTRAN_MESSAGE_SWAP_DATA( THIS, OTHER, OPT, HOOKS ) RESULT(RET) !> Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -796,7 +796,7 @@ FUNCTION FORTRAN_MESSAGE_SWAP_DATA( THIS, OTHER, OPT, HOOKS ) RESULT(RET) !> Dummy arguments CLASS(FORTRAN_MESSAGE_T), INTENT(INOUT) :: THIS TYPE(FORTRAN_MESSAGE_T), INTENT(INOUT) :: OTHER - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -969,9 +969,9 @@ END FUNCTION FORTRAN_MESSAGE_SWAP_DATA FUNCTION FORTRAN_MESSAGE_EQUAL_TO( THIS, OTHER, OPT, IS_EQUAL, HOOKS ) RESULT(RET) !> Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -985,11 +985,11 @@ FUNCTION FORTRAN_MESSAGE_EQUAL_TO( THIS, OTHER, OPT, IS_EQUAL, HOOKS ) RESULT(RE IMPLICIT NONE !> Dummy arguments - CLASS(FORTRAN_MESSAGE_T), INTENT(IN) :: THIS - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: OTHER - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: IS_EQUAL - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(FORTRAN_MESSAGE_T), INTENT(IN) :: THIS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: OTHER + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: OPT + LOGICAL, INTENT(OUT) :: IS_EQUAL + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -1013,55 +1013,55 @@ FUNCTION FORTRAN_MESSAGE_EQUAL_TO( THIS, OTHER, OPT, IS_EQUAL, HOOKS ) RESULT(RE !> Compare two messages IS_EQUAL = .TRUE. - IF ( OPT%CACHE_LOCAL_USE_INFO ) THEN + !IF ( OPT%CACHE_LOCAL_USE_INFO ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%STREAM .EQ. OTHER%STREAM ) IS_EQUAL = IS_EQUAL .AND. ( THIS%TYPE .EQ. OTHER%TYPE ) IS_EQUAL = IS_EQUAL .AND. ( THIS%CLASS .EQ. OTHER%CLASS ) IS_EQUAL = IS_EQUAL .AND. ( THIS%EXPVER .EQ. OTHER%EXPVER ) IS_EQUAL = IS_EQUAL .AND. ( THIS%ORIGIN .EQ. OTHER%ORIGIN ) - ENDIF + !ENDIF ! Information related to time should never be compared - IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN + !IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%ANOFFSET .EQ. OTHER%ANOFFSET ) - ENDIF + !ENDIF - IF ( OPT%CACHE_SATELLITES_INFO ) THEN + !IF ( OPT%CACHE_SATELLITES_INFO ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%NUMBER .EQ. OTHER%NUMBER ) IS_EQUAL = IS_EQUAL .AND. ( THIS%IDENT .EQ. OTHER%IDENT ) IS_EQUAL = IS_EQUAL .AND. ( THIS%INSTRUMENT .EQ. OTHER%INSTRUMENT ) IS_EQUAL = IS_EQUAL .AND. ( THIS%CHANNEL .EQ. OTHER%CHANNEL ) - ENDIF + !ENDIF - IF ( OPT%CACHE_PRODUCT_DEFINITION_INFO ) THEN + !IF ( OPT%CACHE_PRODUCT_DEFINITION_INFO ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%PARAM_TYPE .EQ. OTHER%PARAM_TYPE ) IS_EQUAL = IS_EQUAL .AND. ( THIS%CHEM .EQ. OTHER%CHEM ) IS_EQUAL = IS_EQUAL .AND. ( THIS%PARAM .EQ. OTHER%PARAM ) IS_EQUAL = IS_EQUAL .AND. ( THIS%LEVTYPE .EQ. OTHER%LEVTYPE ) IS_EQUAL = IS_EQUAL .AND. ( THIS%MODEL .EQ. OTHER%MODEL ) - ENDIF + !ENDIF - IF ( OPT%CACHE_TYPE_OF_LEVELS ) THEN + !IF ( OPT%CACHE_TYPE_OF_LEVELS ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%LEVELIST .EQ. OTHER%LEVELIST ) - ENDIF + !ENDIF - IF ( OPT%CACHE_DIRECTION_FREQUENCY ) THEN + !IF ( OPT%CACHE_DIRECTION_FREQUENCY ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%DIRECTION .EQ. OTHER%DIRECTION ) IS_EQUAL = IS_EQUAL .AND. ( THIS%FREQUENCY .EQ. OTHER%FREQUENCY ) - ENDIF + !ENDIF ! Time information should never be cached - IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN + !IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%DATE .EQ. OTHER%DATE ) IS_EQUAL = IS_EQUAL .AND. ( THIS%TIME .EQ. OTHER%TIME ) IS_EQUAL = IS_EQUAL .AND. ( THIS%STEP .EQ. OTHER%STEP ) - ENDIF + !ENDIF - IF ( OPT%CACHE_GRID_DEFINITION_INFO ) THEN + !IF ( OPT%CACHE_GRID_DEFINITION_INFO ) THEN IS_EQUAL = IS_EQUAL .AND. ( THIS%REPRES .EQ. OTHER%REPRES ) IS_EQUAL = IS_EQUAL .AND. ( THIS%GRID .EQ. OTHER%GRID ) - ENDIF + !ENDIF ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -1113,9 +1113,9 @@ END FUNCTION FORTRAN_MESSAGE_EQUAL_TO FUNCTION FORTRAN_MESSAGE_LOWER_THAN( THIS, OTHER, OPT, IS_LOWER_THAN, HOOKS ) RESULT(RET) !> Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1129,11 +1129,11 @@ FUNCTION FORTRAN_MESSAGE_LOWER_THAN( THIS, OTHER, OPT, IS_LOWER_THAN, HOOKS ) RE IMPLICIT NONE !> Dummy arguments - CLASS(FORTRAN_MESSAGE_T), INTENT(IN) :: THIS - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: OTHER - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: IS_LOWER_THAN - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(FORTRAN_MESSAGE_T), INTENT(IN) :: THIS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: OTHER + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: OPT + LOGICAL, INTENT(OUT) :: IS_LOWER_THAN + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -1156,55 +1156,55 @@ FUNCTION FORTRAN_MESSAGE_LOWER_THAN( THIS, OTHER, OPT, IS_LOWER_THAN, HOOKS ) RE !> Compare two messages IS_LOWER_THAN = .TRUE. - IF ( OPT%CACHE_LOCAL_USE_INFO ) THEN + ! IF ( OPT%CACHE_LOCAL_USE_INFO ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%STREAM .LT. OTHER%STREAM ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%TYPE .LT. OTHER%TYPE ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%CLASS .LT. OTHER%CLASS ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%EXPVER .LT. OTHER%EXPVER ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%ORIGIN .LT. OTHER%ORIGIN ) - ENDIF + ! ENDIF ! Information related to time should never be compared - IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN + ! IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%ANOFFSET .LT. OTHER%ANOFFSET ) - ENDIF + ! ENDIF - IF ( OPT%CACHE_SATELLITES_INFO ) THEN + ! IF ( OPT%CACHE_SATELLITES_INFO ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%NUMBER .LT. OTHER%NUMBER ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%IDENT .LT. OTHER%IDENT ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%INSTRUMENT .LT. OTHER%INSTRUMENT ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%CHANNEL .LT. OTHER%CHANNEL ) - ENDIF + ! ENDIF - IF ( OPT%CACHE_PRODUCT_DEFINITION_INFO ) THEN + ! IF ( OPT%CACHE_PRODUCT_DEFINITION_INFO ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%PARAM_TYPE .LT. OTHER%PARAM_TYPE ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%CHEM .LT. OTHER%CHEM ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%PARAM .LT. OTHER%PARAM ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%LEVTYPE .LT. OTHER%LEVTYPE ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%MODEL .LT. OTHER%MODEL ) - ENDIF + ! ENDIF - IF ( OPT%CACHE_TYPE_OF_LEVELS ) THEN + ! IF ( OPT%CACHE_TYPE_OF_LEVELS ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%LEVELIST .LT. OTHER%LEVELIST ) - ENDIF + ! ENDIF - IF ( OPT%CACHE_DIRECTION_FREQUENCY ) THEN + ! IF ( OPT%CACHE_DIRECTION_FREQUENCY ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%DIRECTION .LT. OTHER%DIRECTION ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%FREQUENCY .LT. OTHER%FREQUENCY ) - ENDIF + ! ENDIF ! Time information should never be cached!!! - IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN + ! IF ( OPT%CACHE_TIME_RELATED_INFO ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%DATE .LT. OTHER%DATE ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%TIME .LT. OTHER%TIME ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%STEP .LT. OTHER%STEP ) - ENDIF + ! ENDIF - IF ( OPT%CACHE_GRID_DEFINITION_INFO ) THEN + ! IF ( OPT%CACHE_GRID_DEFINITION_INFO ) THEN IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%REPRES .LT. OTHER%REPRES ) IS_LOWER_THAN = IS_LOWER_THAN .AND. ( THIS%GRID .LT. OTHER%GRID ) - ENDIF + ! ENDIF ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() diff --git a/src/multiom/data-structures/time_utils_mod.F90 b/src/multiom/data-structures/time_utils_mod.F90 index d2ef01fe..63a93b2b 100644 --- a/src/multiom/data-structures/time_utils_mod.F90 +++ b/src/multiom/data-structures/time_utils_mod.F90 @@ -42,6 +42,9 @@ MODULE TIME_UTILS_MOD !> @brief Default initialization of the data structure PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: COPY_TO => CURR_TIME_COPY_TO + !> @brief Compute the bytesize of the data structure + PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: BYTESIZE => CURR_TIME_MEMORY_BYTESIZE + !> @brief Cleanup of the current time data structure PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: FREE => CURR_TIME_FREE @@ -89,6 +92,9 @@ MODULE TIME_UTILS_MOD !> @brief Frees the memory allocated for the circular buffer. PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: SIZE => CB_SIZE + !> @brief Frees the memory allocated for the circular buffer. + PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: BYTESIZE => CB_BYTESIZE + !> @brief Frees the memory allocated for the circular buffer. PROCEDURE, PUBLIC, NON_OVERRIDABLE, PASS :: IS_EMPTY => CB_IS_EMPTY @@ -293,7 +299,7 @@ END FUNCTION CURR_TIME_INIT_DEFAULT #undef PP_PROCEDURE_TYPE #define PP_PROCEDURE_TYPE 'FUNCTION' -#define PP_PROCEDURE_NAME 'CB_ENQUEUE' +#define PP_PROCEDURE_NAME 'CURR_TIME_COPY_TO' PP_THREAD_SAFE FUNCTION CURR_TIME_COPY_TO( THIS, & & OTHER, HOOKS ) RESULT(RET) @@ -382,6 +388,97 @@ END FUNCTION CURR_TIME_COPY_TO #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'CURR_TIME_MEMORY_BYTESIZE' +PP_THREAD_SAFE FUNCTION CURR_TIME_MEMORY_BYTESIZE( THIS, & +& MEMORY_BYTESIZE, HOOKS ) RESULT(RET) + + !> Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_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(CURR_TIME_T), INTENT(IN) :: THIS + INTEGER(KIND=JPIB_K), INTENT(OUT) :: MEMORY_BYTESIZE + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + !> Function result + INTEGER(KIND=JPIB_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 ) + + ! TODO: Needs to be updated with the actual memory bytesize + MEMORY_BYTESIZE = 264_JPIB_K + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + + +END FUNCTION CURR_TIME_MEMORY_BYTESIZE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CURR_TIME_FREE' PP_THREAD_SAFE FUNCTION CURR_TIME_FREE( THIS, & @@ -1401,6 +1498,123 @@ PP_THREAD_SAFE FUNCTION CB_SIZE(THIS, SIZE, HOOKS ) RESULT(RET) END FUNCTION CB_SIZE #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'CB_BYTESIZE' +PP_THREAD_SAFE FUNCTION CB_BYTESIZE(THIS, MEMORY_BYTESIZE, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_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(TIME_HISTORY_T), INTENT(IN) :: THIS + INTEGER(KIND=JPIB_K), INTENT(OUT) :: MEMORY_BYTESIZE + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + !> Function result + INTEGER(KIND=JPIB_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: TMP_MEMORY_BYTESIZE + + ! Local error flags + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_SIZE_OUT_OF_BOUNDS=1_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_INDEX_OUT_OF_BOUNDS=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_COMPUTE_BUFFER_BYTESIZE=3_JPIB_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( THIS%SIZE_ .LT. 0, ERRFLAG_SIZE_OUT_OF_BOUNDS ) + PP_DEBUG_CRITICAL_COND_THROW( THIS%SIZE_ .GT. THIS%CAPACITY_, ERRFLAG_SIZE_OUT_OF_BOUNDS ) + PP_DEBUG_CRITICAL_COND_THROW( THIS%HEAD_ .LT. 1, ERRFLAG_INDEX_OUT_OF_BOUNDS ) + PP_DEBUG_CRITICAL_COND_THROW( THIS%HEAD_ .GT. THIS%CAPACITY_, ERRFLAG_INDEX_OUT_OF_BOUNDS ) + PP_DEBUG_CRITICAL_COND_THROW( THIS%TAIL_ .LT. 1, ERRFLAG_INDEX_OUT_OF_BOUNDS ) + PP_DEBUG_CRITICAL_COND_THROW( THIS%TAIL_ .GT. THIS%CAPACITY_, ERRFLAG_INDEX_OUT_OF_BOUNDS ) + + ! Get the current size + MEMORY_BYTESIZE = 32_JPIB_K + + ! Accumulate the size of the buffer + DO I = 1, SIZE(THIS%BUFFER_) + PP_TRYCALL(ERRFLAG_UNABLE_TO_COMPUTE_BUFFER_BYTESIZE) THIS%BUFFER_(I)%BYTESIZE( TMP_MEMORY_BYTESIZE, HOOKS ) + MEMORY_BYTESIZE = MEMORY_BYTESIZE + TMP_MEMORY_BYTESIZE + ENDDO + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_SIZE_OUT_OF_BOUNDS) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'size out of bounds' ) + CASE (ERRFLAG_INDEX_OUT_OF_BOUNDS) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'index out of bounds' ) + CASE (ERRFLAG_UNABLE_TO_COMPUTE_BUFFER_BYTESIZE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to compute buffer bytesize' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION CB_BYTESIZE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE !> diff --git a/src/multiom/encoding-rules/cached_encoder_collection_mod.F90 b/src/multiom/encoding-rules/cached_encoder_collection_mod.F90 index 0bc455ff..14904532 100644 --- a/src/multiom/encoding-rules/cached_encoder_collection_mod.F90 +++ b/src/multiom/encoding-rules/cached_encoder_collection_mod.F90 @@ -34,6 +34,8 @@ MODULE CACHED_ENCODER_COLLECTION_MOD PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: INIT => CACHED_ENCODER_COLLECTION_INIT PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: IS_INITIALIZED => CACHED_ENCODER_COLLECTION_INITIALIZED PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: SIZE => CACHED_ENCODER_COLLECTION_SIZE + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: BYTESIZE => CACHED_ENCODER_COLLECTION_BYTESIZE + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: DUMP => CACHED_ENCODER_COLLECTION_DUMP PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: ENCODE => CACHED_ENCODER_COLLECTION_ENCODE PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: FREE => CACHED_ENCODER_COLLECTION_FREE END TYPE @@ -356,6 +358,231 @@ END FUNCTION CACHED_ENCODER_COLLECTION_SIZE #undef PP_PROCEDURE_TYPE +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'CACHED_ENCODER_COLLECTION_BYTESIZE' +PP_THREAD_SAFE FUNCTION CACHED_ENCODER_COLLECTION_BYTESIZE( THIS, MEMORY_BYTESIZE, OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_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(CACHED_ENCODER_COLLECTION_T), INTENT(INOUT) :: THIS + INTEGER(KIND=JPIB_K), INTENT(OUT) :: MEMORY_BYTESIZE + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + !> Function result + INTEGER(KIND=JPIB_K) :: RET + + !> Local variables + INTEGER(KIND=JPIB_K) :: I + INTEGER(KIND=JPIB_K) :: SZ + + !> Local error codes + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_ENCODERS_NOT_ASSOCIATED=1_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_CALL_NESTED_SIZE=2_JPIB_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(THIS%ENCODERS_), ERRFLAG_ENCODERS_NOT_ASSOCIATED ) + + ! Get the size + MEMORY_BYTESIZE = 0_JPIB_K + + + DO I = 1, SIZE(THIS%ENCODERS_) + PP_TRYCALL(ERRFLAG_CALL_NESTED_SIZE) THIS%ENCODERS_(I)%BYTESIZE( SZ, OPT, HOOKS ) + MEMORY_BYTESIZE = MEMORY_BYTESIZE + SZ + ENDDO + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE(ERRFLAG_ENCODERS_NOT_ASSOCIATED) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'Encoders not associated' ) + CASE(ERRFLAG_CALL_NESTED_SIZE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'Error in nested call' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + + +END FUNCTION CACHED_ENCODER_COLLECTION_BYTESIZE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'CACHED_ENCODER_COLLECTION_DUMP' +PP_THREAD_SAFE FUNCTION CACHED_ENCODER_COLLECTION_DUMP( THIS, DUMP_PATH, CNT, OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_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(CACHED_ENCODER_COLLECTION_T), INTENT(INOUT) :: THIS + CHARACTER(LEN=*), INTENT(IN) :: DUMP_PATH + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + !> Function result + INTEGER(KIND=JPIB_K) :: RET + + !> Local variables + INTEGER(KIND=JPIB_K) :: I + + !> Local error codes + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_ENCODERS_NOT_ASSOCIATED=1_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_CALL_NESTED_DUMP=2_JPIB_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(THIS%ENCODERS_), ERRFLAG_ENCODERS_NOT_ASSOCIATED ) + + ! Dump the encoders + DO I = 1, SIZE(THIS%ENCODERS_) + CNT = CNT + 1 + PP_TRYCALL(ERRFLAG_CALL_NESTED_DUMP) THIS%ENCODERS_(I)%DUMP( DUMP_PATH, CNT, OPT, HOOKS ) + ENDDO + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE(ERRFLAG_ENCODERS_NOT_ASSOCIATED) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'Encoders not associated' ) + CASE(ERRFLAG_CALL_NESTED_DUMP) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'Error in nested call' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + + +END FUNCTION CACHED_ENCODER_COLLECTION_DUMP +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + #define PP_PROCEDURE_TYPE 'FUNCTION' diff --git a/src/multiom/encoding-rules/cached_encoder_mod.F90 b/src/multiom/encoding-rules/cached_encoder_mod.F90 index 964da8be..429413c4 100644 --- a/src/multiom/encoding-rules/cached_encoder_mod.F90 +++ b/src/multiom/encoding-rules/cached_encoder_mod.F90 @@ -41,9 +41,11 @@ MODULE CACHED_ENCODER_MOD CLASS(GRIB_SECTION_BASE_A), POINTER :: ENCODER_ => NULL() CONTAINS - PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: INIT => CACHED_ENCODER_INIT - PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: ENCODE => CACHED_ENCODER_ENCODE - PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: FREE => CACHED_ENCODER_FREE + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: INIT => CACHED_ENCODER_INIT + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: ENCODE => CACHED_ENCODER_ENCODE + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: DUMP => CACHED_ENCODER_DUMP + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: BYTESIZE => CACHED_ENCODER_BYTESIZE + PROCEDURE, PUBLIC, PASS, NON_OVERRIDABLE :: FREE => CACHED_ENCODER_FREE END TYPE !> Whitelist of public symbols (types) @@ -133,8 +135,6 @@ PP_THREAD_SAFE FUNCTION CACHED_ENCODER_INIT( THIS, MSG, PAR, TAG, NAME, & ! Associate the encoder THIS%ENCODER_ => ENCODER - WRITE(*,*) 'vercingetorice' - ! Preconfigure the local metadata with all the memory related information PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE) THIS%ENCODER_%ALLOCATE( MSG, PAR, OPT, THIS%METADATA_, HOOKS ) PP_TRYCALL(ERRFLAG_UNABLE_TO_PRESET) THIS%ENCODER_%PRESET( MSG, PAR, OPT, THIS%METADATA_, HOOKS ) @@ -368,6 +368,212 @@ END FUNCTION CACHED_ENCODER_ENCODE #undef PP_PROCEDURE_TYPE + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME ' CACHED_ENCODER_DUMP' +PP_THREAD_SAFE FUNCTION CACHED_ENCODER_DUMP( THIS, DUMP_PATH, CNT, OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_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(CACHED_ENCODER_T), INTENT(INOUT) :: THIS + CHARACTER(LEN=*), INTENT(IN) :: DUMP_PATH + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + !> Function result + INTEGER(KIND=JPIB_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 ) + + ! TODO Dump the metadata!!!! + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + + +END FUNCTION CACHED_ENCODER_DUMP +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME ' CACHED_ENCODER_BYTESIZE' +PP_THREAD_SAFE FUNCTION CACHED_ENCODER_BYTESIZE( THIS, MEMORY_BYTESIZE, OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_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(CACHED_ENCODER_T), INTENT(INOUT) :: THIS + INTEGER(KIND=JPIB_K), INTENT(OUT) :: MEMORY_BYTESIZE + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + !> Function result + INTEGER(KIND=JPIB_K) :: RET + + !> Local variables + INTEGER(KIND=JPIB_K) :: TMP_MEMORY_BYTESIZE + + !> Local error flag + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_COMPUTE_CIRCULAR_BUFFER_BYTESIZE=1_JPIB_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 memory bytesize + MEMORY_BYTESIZE = 256 + 256 + 8 + 8 + + ! Add the circular buffer byte size + PP_TRYCALL(ERRFLAG_UNABLE_TO_COMPUTE_CIRCULAR_BUFFER_BYTESIZE) THIS%TIME_HISTORY_%BYTESIZE(TMP_MEMORY_BYTESIZE, HOOKS) + MEMORY_BYTESIZE = MEMORY_BYTESIZE + TMP_MEMORY_BYTESIZE + + ! TODO: Add size of metadata + ! PP_TRYCALL(ERRFLAG_UNABLE_TO_COMPUTE_METADATA_BYTESIZE) THIS%METADATA_%BYTESIZE(TMP_MEMORY_BYTESIZE, HOOKS) + + ! TODO: Add size of encoder (if needed) + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE(ERRFLAG_UNABLE_TO_COMPUTE_CIRCULAR_BUFFER_BYTESIZE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'error unable to compute circular buffer byte size' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + + +END FUNCTION CACHED_ENCODER_BYTESIZE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME ' CACHED_ENCODER_FREE' PP_THREAD_SAFE FUNCTION CACHED_ENCODER_FREE( THIS, OPT, HOOKS ) RESULT(RET) diff --git a/src/multiom/encoding-rules/encoding_cache_mod.F90 b/src/multiom/encoding-rules/encoding_cache_mod.F90 index ad1aa701..b815d12d 100644 --- a/src/multiom/encoding-rules/encoding_cache_mod.F90 +++ b/src/multiom/encoding-rules/encoding_cache_mod.F90 @@ -41,16 +41,16 @@ MODULE ENCODING_CACHE_MOD INTERFACE - PP_THREAD_SAFE FUNCTION FUNCTION_ENCODING_CACHE_IF( KEY, OPT, HOOKS ) RESULT(RET) + PP_THREAD_SAFE FUNCTION FUNCTION_ENCODING_CACHE_IF( KEY, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T IMPLICIT NONE - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS INTEGER(KIND=JPIB_K) :: RET END FUNCTION FUNCTION_ENCODING_CACHE_IF END INTERFACE @@ -61,17 +61,17 @@ END FUNCTION FUNCTION_ENCODING_CACHE_IF END TYPE ABSTRACT INTERFACE - PP_THREAD_SAFE FUNCTION FUNCTOR_ENCODING_CACHE_IF( THIS, KEY, OPT, HOOKS ) RESULT(RET) + PP_THREAD_SAFE FUNCTION FUNCTOR_ENCODING_CACHE_IF( THIS, KEY, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T IMPORT :: FUNCTOR_ENCODING_CACHE_A IMPLICIT NONE CLASS(FUNCTOR_ENCODING_CACHE_A), INTENT(INOUT) :: THIS TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS INTEGER(KIND=JPIB_K) :: RET END FUNCTION FUNCTOR_ENCODING_CACHE_IF @@ -115,15 +115,26 @@ END FUNCTION FUNCTOR_ENCODING_CACHE_IF TYPE(ENCODING_CACHE_NODE_T), POINTER :: ROOT => NULL() !> Size of the map - INTEGER(KIND=JPIB_K) :: SIZE = -1_JPIB_K + INTEGER(KIND=JPIB_K) :: SIZE_ = -1_JPIB_K CONTAINS !> Public methods PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: INIT => ENCODING_CACHE_INIT PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: ACCESS_OR_CREATE => ENCODING_CACHE_ACCESS_OR_CREATE + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: REMOVE => ENCODING_CACHE_REMOVE PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: FREE => ENCODING_CACHE_FREE - ! PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: DUMP => ENCODING_CACHE_DUMP + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: MATCH => ENCODING_CACHE_MATCH + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: SIZE => ENCODING_CACHE_SIZE + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: MAXIMUM => ENCODING_CACHE_MAXIMUM + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: MINIMUM => ENCODING_CACHE_MINIMUM + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: GET_SORTED_KEYS => ENCODING_CACHE_GET_SORTED_KEYS + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: LIST => ENCODING_CACHE_LIST + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: PRINT => ENCODING_CACHE_PRINT + + + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: DUMP => ENCODING_CACHE_DUMP + PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: BYTESIZE => ENCODING_CACHE_BYTESIZE PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: APPLY_FUNCTION => ENCODING_CACHE_APPLY_FUNCTION PROCEDURE, NON_OVERRIDABLE, PUBLIC, PASS :: APPLY_FUNCTOR => ENCODING_CACHE_APPLY_FUNCTOR @@ -161,13 +172,13 @@ END FUNCTION FUNCTOR_ENCODING_CACHE_IF !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_EQUAL_TO' -PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, OPT, IS_EQUAL, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, CACHE_OPT, IS_EQUAL, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -181,11 +192,11 @@ PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, OPT, IS_EQUAL, HOOKS ) RESULT( IMPLICIT NONE ! Dummy arguments - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: IS_EQUAL - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + LOGICAL, INTENT(OUT) :: IS_EQUAL + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -209,7 +220,7 @@ PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, OPT, IS_EQUAL, HOOKS ) RESULT( PP_SET_ERR_SUCCESS( RET ) ! Check if the keys are equal (the check depends on the options) - PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_EQUAL_TO( KEY2, OPT, IS_EQUAL, HOOKS ) + PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_EQUAL_TO( KEY2, CACHE_OPT, IS_EQUAL, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -277,14 +288,12 @@ END FUNCTION KEY_EQUAL_TO !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_LOWER_THAN' -PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, OPT, IS_LOWER_THAN, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, CACHE_OPT, IS_LOWER_THAN, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - - !> Templated use + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes @@ -299,11 +308,11 @@ PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, OPT, IS_LOWER_THAN, HOOKS ) IMPLICIT NONE ! Dummy arguments - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: IS_LOWER_THAN - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + LOGICAL, INTENT(OUT) :: IS_LOWER_THAN + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -327,7 +336,7 @@ PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, OPT, IS_LOWER_THAN, HOOKS ) PP_SET_ERR_SUCCESS( RET ) ! Check if the keys are lower than (the check depends on the options) - PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_LOWER_THAN( KEY2, OPT, IS_LOWER_THAN, HOOKS ) + PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_LOWER_THAN( KEY2, CACHE_OPT, IS_LOWER_THAN, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -396,16 +405,18 @@ END FUNCTION KEY_LOWER_THAN #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ACCESS_OR_CREATE_NODE' PP_THREAD_SAFE FUNCTION ACCESS_OR_CREATE_NODE( ROOT, KEY, PAR, METADATA, ENCODING_RULES, & -& ENCODERS, INSERTED, OPT, HOOKS ) RESULT(RET) +& ENCODERS, INSERTED, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: ENCODING_RULE_COLLECTION_MOD, ONLY: ENCODING_RULE_COLLECTION_T USE :: CACHED_ENCODER_COLLECTION_MOD, ONLY: CACHED_ENCODER_COLLECTION_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A ! Symbols imported by the preprocessor for debugging purposes @@ -427,7 +438,9 @@ PP_THREAD_SAFE FUNCTION ACCESS_OR_CREATE_NODE( ROOT, KEY, PAR, METADATA, ENCODIN TYPE(ENCODING_RULE_COLLECTION_T), INTENT(IN) :: ENCODING_RULES TYPE(CACHED_ENCODER_COLLECTION_T), POINTER, INTENT(OUT) :: ENCODERS LOGICAL, INTENT(OUT) :: INSERTED - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT + TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -472,40 +485,40 @@ PP_THREAD_SAFE FUNCTION ACCESS_OR_CREATE_NODE( ROOT, KEY, PAR, METADATA, ENCODIN ! Initialization of the insertion flag INSERTED =.FALSE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( ROOT_IS_LEAF ) THEN ! Map is empty INSERTED =.TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( ROOT, CACHE_OPT, HOOKS ) INSERTION_POINT => NIL PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) NODE_INIT( ROOT, INSERTION_POINT, KEY, & -& PAR, METADATA, ENCODING_RULES, OPT, HOOKS ) +& PAR, METADATA, ENCODING_RULES, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) ENCODERS => ROOT%ENCODERS_ - PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, ROOT, CACHE_OPT, HOOKS ) INSERTION_POINT => ROOT ELSE ! Map not empty INSERTION_POINT => NIL - PP_TRYCALL(ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, OPT, FOUND, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, CACHE_OPT, FOUND, HOOKS ) IF ( .NOT.FOUND ) THEN ! If the node is not in the map then insert it INSERTED =.TRUE. - PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, INSERTION_POINT%KEY, OPT, KEY_LT, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, INSERTION_POINT%KEY, CACHE_OPT, KEY_LT, HOOKS ) IF ( KEY_LT ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( INSERTION_POINT%LEFT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( INSERTION_POINT%LEFT, CACHE_OPT, HOOKS ) PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) NODE_INIT( INSERTION_POINT%LEFT, INSERTION_POINT, & -& KEY, PAR, METADATA, ENCODING_RULES, OPT, HOOKS ) +& KEY, PAR, METADATA, ENCODING_RULES, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) ENCODERS => INSERTION_POINT%LEFT%ENCODERS_ - PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%LEFT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%LEFT, CACHE_OPT, HOOKS ) ELSE - PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) ALLOCATE_NODE( INSERTION_POINT%RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) ALLOCATE_NODE( INSERTION_POINT%RIGHT, CACHE_OPT, HOOKS ) PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) NODE_INIT( INSERTION_POINT%RIGHT, INSERTION_POINT, & -& KEY, PAR, METADATA, ENCODING_RULES, OPT, HOOKS ) +& KEY, PAR, METADATA, ENCODING_RULES, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) ENCODERS => INSERTION_POINT%RIGHT%ENCODERS_ - PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%RIGHT, CACHE_OPT, HOOKS ) ENDIF ELSE ! If the node is in the map then return the value @@ -600,11 +613,12 @@ END FUNCTION ACCESS_OR_CREATE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'DELETE_NODE' -PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, CACHE_OPT, ENCODER_OPT, FOUND, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -623,7 +637,8 @@ PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY LOGICAL, INTENT(OUT) :: FOUND - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -653,11 +668,11 @@ PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.ROOT_IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, OPT, FOUND, HOOKS ) + PP_TRYCALL(ERRFLAG_ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, CACHE_OPT, FOUND, HOOKS ) IF ( FOUND ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_REMOVE_NODE) REMOVE_NODE( ROOT, INSERTION_POINT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_REMOVE_NODE) REMOVE_NODE( ROOT, INSERTION_POINT, CACHE_OPT, ENCODER_OPT, HOOKS ) ENDIF ENDIF @@ -728,11 +743,12 @@ END FUNCTION DELETE_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'FREE_NODE' -RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION FREE_NODE( CURRENT, CACHE_OPT, ENCODER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes @@ -748,15 +764,20 @@ RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CURRENT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET + !> Local variables + LOGICAL :: NODE_IS_LEAF + !> Local error codes INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_FREE_NODE=1_JPIB_K INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_DEALLOCATE_NODE=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=3_JPIB_K ! Local variables declared by the preprocessor for debugging purposes PP_DEBUG_DECL_VARS @@ -774,16 +795,17 @@ RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) PP_SET_ERR_SUCCESS( RET ) ! Implementation - IF ( .NOT.ASSOCIATED( CURRENT, NIL ) ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, NODE_IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT.NODE_IS_LEAF ) THEN ! Deallocate left subtree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%LEFT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%LEFT, CACHE_OPT, ENCODER_OPT, HOOKS ) ! Deallocate right subtree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%RIGHT, CACHE_OPT, ENCODER_OPT, HOOKS ) ! Free memory - PP_TRYCALL(ERRFLAG_UNABLE_TO_DEALLOCATE_NODE) DEALLOCATE_NODE( CURRENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_DEALLOCATE_NODE) DEALLOCATE_NODE( CURRENT, CACHE_OPT, ENCODER_OPT, HOOKS ) ENDIF @@ -813,6 +835,8 @@ RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to free node' ) CASE (ERRFLAG_UNABLE_TO_DEALLOCATE_NODE) PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to deallocate node' ) + CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) CASE DEFAULT PP_DEBUG_PUSH_MSG_TO_FRAME( 'unhandled error' ) END SELECT @@ -859,12 +883,12 @@ END FUNCTION FREE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SEARCH_NODE' -PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, CACHE_OPT, FOUND, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -884,7 +908,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CURRENT TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT LOGICAL, INTENT(OUT) :: FOUND TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -924,7 +948,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES ! Map is empty. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( ROOT_IS_LEAF ) THEN FOUND = .FALSE. @@ -935,19 +959,19 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES SearchLoop: DO !> Handle exit conditions - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, OPT, KEY_EQ, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, CACHE_OPT, KEY_EQ, HOOKS ) IF ( IS_LEAF .OR. KEY_EQ ) THEN EXIT SearchLoop ENDIF ! Left subtree - PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, CURRENT%KEY, OPT, KEY_LT, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, CURRENT%KEY, CACHE_OPT, KEY_LT, HOOKS ) IF ( KEY_LT ) THEN !> Check if the current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) !> Depending if it si a leaf or not, move to the left or exit IF ( .NOT.IS_LEAF ) THEN @@ -963,7 +987,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES ENDIF ! Node Found - PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, OPT, KEY_EQ, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, CACHE_OPT, KEY_EQ, HOOKS ) ELSEIF ( KEY_EQ ) THEN FOUND = .TRUE. @@ -973,7 +997,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES ELSE !> Check if the current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) !> Depending if it si a leaf or not, move to the right or exit IF ( .NOT.IS_LEAF ) THEN @@ -1060,16 +1084,19 @@ END FUNCTION SEARCH_NODE #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'NODE_INIT' PP_THREAD_SAFE FUNCTION NODE_INIT( THIS, PARENT, KEY, PAR, & - METADATA, ENCODING_RULES, OPT, HOOKS ) RESULT(RET) + METADATA, ENCODING_RULES, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: ENCODING_RULE_COLLECTION_MOD, ONLY: ENCODING_RULE_COLLECTION_T USE :: CACHED_ENCODER_COLLECTION_MOD, ONLY: CACHED_ENCODER_COLLECTION_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A USE :: CACHED_ENCODER_MOD, ONLY: CACHED_ENCODER_T USE :: ENCODING_UTILS_MOD, ONLY: MAKE_ENCODER_COLLECTION @@ -1087,14 +1114,16 @@ PP_THREAD_SAFE FUNCTION NODE_INIT( THIS, PARENT, KEY, PAR, & IMPLICIT NONE ! Dummy arguments - TYPE(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: THIS - TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: PARENT - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(PARAMETRIZATION_T), INTENT(IN) :: PAR - CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA - TYPE(ENCODING_RULE_COLLECTION_T), INTENT(IN) :: ENCODING_RULES - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: THIS + TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: PARENT + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + TYPE(PARAMETRIZATION_T), INTENT(IN) :: PAR + CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA + TYPE(ENCODING_RULE_COLLECTION_T), INTENT(IN) :: ENCODING_RULES + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT + TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -1149,7 +1178,7 @@ PP_THREAD_SAFE FUNCTION NODE_INIT( THIS, PARENT, KEY, PAR, & !> Create the encoders PP_TRYCALL(ERRFLAG_UNABLE_TO_CREATE_ENCODERS) MAKE_ENCODER_COLLECTION( & -& KEY, PAR, METADATA, ENCODING_RULES, OPT, THIS%ENCODERS_, HOOKS ) +& KEY, PAR, METADATA, ENCODING_RULES, ENCODER_OPT, FILTER_OPT, THIS%ENCODERS_, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -1220,12 +1249,12 @@ END FUNCTION NODE_INIT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ALLOCATE_NODE' -PP_THREAD_SAFE FUNCTION ALLOCATE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ALLOCATE_NODE( CURRENT, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1240,7 +1269,7 @@ PP_THREAD_SAFE FUNCTION ALLOCATE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CURRENT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -1343,11 +1372,12 @@ END FUNCTION ALLOCATE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'DEALLOCATE_NODE' -PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, CACHE_OPT, ENCODER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes @@ -1363,7 +1393,8 @@ PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: X - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -1401,7 +1432,7 @@ PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, OPT, HOOKS ) RESULT(RET) PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_KEY) X%KEY%FREE( HOOKS ) IF ( ASSOCIATED(X%ENCODERS_) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_VAL) X%ENCODERS_%FREE( OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_VAL) X%ENCODERS_%FREE( ENCODER_OPT, HOOKS ) DEALLOCATE( X%ENCODERS_, STAT=DEALLOC_STATUS, ERRMSG=ERRMSG ) PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_STATUS.NE.0, ERRFLAG_UNABLE_TO_DEALLOCATE_ENCODERS ) ENDIF @@ -1489,12 +1520,12 @@ END FUNCTION DEALLOCATE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'INSERT_FIXUP' -PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -1513,7 +1544,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CUR - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -1574,7 +1605,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X, CACHE_OPT, HOOKS ) ENDIF @@ -1582,7 +1613,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X%PARENT%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT%PARENT, CACHE_OPT, HOOKS ) ENDIF @@ -1607,7 +1638,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X, CACHE_OPT, HOOKS ) ENDIF @@ -1615,7 +1646,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X%PARENT%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X%PARENT%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X%PARENT%PARENT, CACHE_OPT, HOOKS ) ENDIF @@ -1690,12 +1721,12 @@ END FUNCTION INSERT_FIXUP !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ROTATE_LEFT' -PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1711,7 +1742,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(ENCODING_CACHE_NODE_T), TARGET, INTENT(INOUT) :: X_ - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -1748,7 +1779,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Rotate. Y => X%RIGHT X%RIGHT => Y%LEFT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y%LEFT%PARENT => X @@ -1757,7 +1788,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) Y%PARENT => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT, CACHE_OPT, HOOKS ) IF ( IS_ROOT ) THEN ROOT => Y @@ -1842,12 +1873,12 @@ END FUNCTION ROTATE_LEFT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ROTATE_RIGHT' -PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1863,7 +1894,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T),POINTER, INTENT(INOUT) :: ROOT TYPE(ENCODING_CACHE_NODE_T), TARGET, INTENT(INOUT) :: X_ - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -1900,7 +1931,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Rotate. Y => X%LEFT X%LEFT => Y%RIGHT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y%RIGHT%PARENT => X @@ -1910,7 +1941,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) Y%PARENT => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT_LEAF, CACHE_OPT, HOOKS ) IF ( IS_ROOT_LEAF ) THEN ROOT => Y @@ -1992,12 +2023,12 @@ END FUNCTION ROTATE_RIGHT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'NODE_ISLEAF' -PP_THREAD_SAFE FUNCTION NODE_ISLEAF( X, ISLEAF, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION NODE_ISLEAF( X, ISLEAF, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2013,7 +2044,7 @@ PP_THREAD_SAFE FUNCTION NODE_ISLEAF( X, ISLEAF, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: X LOGICAL, INTENT(OUT) :: ISLEAF - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -2061,12 +2092,12 @@ END FUNCTION NODE_ISLEAF !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SUCCESSOR' -PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2082,7 +2113,7 @@ PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -2117,16 +2148,16 @@ PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) Y => NULL() ! Check. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) ! Search cycle. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN ! If the node has a right child then the successor is the ! minimum of the right subtree of the node. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( X%RIGHT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( X%RIGHT, Y, CACHE_OPT, HOOKS ) ELSE @@ -2137,7 +2168,7 @@ PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) SearchSuccessor: DO - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF .AND. ASSOCIATED( X_, Y%RIGHT ) ) THEN X_ => Y @@ -2219,12 +2250,12 @@ END FUNCTION SUCCESSOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'PREDECESSOR' -PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2240,7 +2271,7 @@ PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -2275,16 +2306,16 @@ PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) Y => NULL() ! Check. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) ! Search cycle. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN ! If the node has a left child then the successor is the ! minimum of the left subtree of the node. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MAXIMUM) MAXIMUM( X%LEFT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MAXIMUM) MAXIMUM( X%LEFT, Y, CACHE_OPT, HOOKS ) ELSE @@ -2295,7 +2326,7 @@ PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) SearchPredecessor: DO - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF .AND. ASSOCIATED( X_, Y%LEFT ) ) THEN X_ => Y @@ -2378,12 +2409,12 @@ END FUNCTION PREDECESSOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MINIMUM' -PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -2402,7 +2433,7 @@ PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -2435,7 +2466,7 @@ PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, OPT, HOOKS ) RESULT(RET) ! Search cycle. SearchMinimum: DO WHILE(.TRUE.) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y => Y%LEFT @@ -2510,12 +2541,12 @@ END FUNCTION MINIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAXIMUM' -PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -2534,7 +2565,7 @@ PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -2567,7 +2598,7 @@ PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, OPT, HOOKS ) RESULT(RET) ! Search cycle. SearchMaximum: DO WHILE(.TRUE.) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y => Y%RIGHT @@ -2641,14 +2672,14 @@ END FUNCTION MAXIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SWAP_DATA' -PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: CACHED_ENCODER_COLLECTION_MOD, ONLY: CACHED_ENCODER_COLLECTION_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2664,7 +2695,7 @@ PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE_1 TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE_2 - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -2692,7 +2723,7 @@ PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, OPT, HOOKS ) RESULT(RET) PP_SET_ERR_SUCCESS( RET ) ! Swapping keys between two nodes - PP_TRYCALL(ERRFLAG_SWAP_KEYS) NODE_1%KEY%SWAP_DATA( NODE_2%KEY, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_SWAP_KEYS) NODE_1%KEY%SWAP_DATA( NODE_2%KEY, CACHE_OPT, HOOKS ) ! Swapping values between two nodes TMP => NODE_1%ENCODERS_ @@ -2764,13 +2795,14 @@ END FUNCTION SWAP_DATA !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'REMOVE_NODE' -PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, CACHE_OPT, ENCODER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2786,7 +2818,8 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: Z - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -2826,19 +2859,19 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) Y => NULL() ! Remove the node - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF_LEFT, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF_RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF_LEFT, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF_RIGHT, CACHE_OPT, HOOKS ) IF ( IS_LEAF_LEFT .OR. IS_LEAF_RIGHT ) THEN Y => Z ELSE - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SUCESSOR) SUCCESSOR( Z, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SUCESSOR) SUCCESSOR( Z, Y, CACHE_OPT, HOOKS ) ENDIF - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN X => Y%LEFT @@ -2858,7 +2891,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) ELSE - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN X%PARENT => Y%PARENT @@ -2867,7 +2900,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) ENDIF - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%PARENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%PARENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( IS_LEAF ) THEN ROOT => X @@ -2892,7 +2925,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) IF ( .NOT.ASSOCIATED( Z, Y ) ) THEN ! Copy data. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SWAP_DATA) SWAP_DATA( Y, Z, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SWAP_DATA) SWAP_DATA( Y, Z, CACHE_OPT, HOOKS ) ENDIF @@ -2901,14 +2934,14 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) IF ( .NOT.Y%RED ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_FIXUP) REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_FIXUP) REMOVE_NODE_FIXUP( ROOT, X, CACHE_OPT, HOOKS ) ENDIF ENDIF ! Free memory. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_DEALLOCATE_NODE) DEALLOCATE_NODE( Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_DEALLOCATE_NODE) DEALLOCATE_NODE( Y, CACHE_OPT, ENCODER_OPT, HOOKS ) Y => NULL() ! Trace end of procedure (on success) @@ -2983,12 +3016,12 @@ END FUNCTION REMOVE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'REMOVE_NODE_FIXUP' -PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3004,7 +3037,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: X - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -3051,14 +3084,14 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) X%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, CACHE_OPT, HOOKS ) W => X%PARENT%RIGHT ENDIF ! Check if current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) IF ( ( .NOT.W%LEFT%RED ) .AND. ( .NOT.W%RIGHT%RED ) ) THEN @@ -3074,7 +3107,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, W, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, W, CACHE_OPT, HOOKS ) W => X%PARENT%RIGHT @@ -3086,7 +3119,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%RIGHT%RED = .FALSE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, CACHE_OPT, HOOKS ) X => ROOT @@ -3102,14 +3135,14 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) X%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, X%PARENT, CACHE_OPT, HOOKS ) W => X%PARENT%LEFT ENDIF ! Check if current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) IF ( .NOT.W%RIGHT%RED .AND. .NOT.W%LEFT%RED ) THEN @@ -3126,7 +3159,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, W, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, W, CACHE_OPT, HOOKS ) W => X%PARENT%LEFT @@ -3138,7 +3171,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%LEFT%RED = .FALSE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT, CACHE_OPT, HOOKS ) X => ROOT @@ -3221,12 +3254,12 @@ END FUNCTION REMOVE_NODE_FIXUP !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'LIST_NODE' -RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3245,7 +3278,7 @@ RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RES INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT CHARACTER(LEN=*), INTENT(IN) :: PREFIX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -3279,10 +3312,10 @@ RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RES PP_SET_ERR_SUCCESS( RET ) ! First node in the list. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) LIST_NODE( ROOT, CURRENT%LEFT, CNT, UNIT, PREFIX, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) LIST_NODE( ROOT, CURRENT%LEFT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) CNT = CNT + 1 WRITE(CKEY,*,IOSTAT=WRITE_STATUS) CURRENT%KEY @@ -3293,7 +3326,7 @@ RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RES PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) LIST_NODE( ROOT, CURRENT%RIGHT, CNT, UNIT, PREFIX,OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) LIST_NODE( ROOT, CURRENT%RIGHT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) ENDIF @@ -3362,12 +3395,12 @@ END FUNCTION LIST_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'FUNCTION_NODE' -RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3384,7 +3417,7 @@ RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, OPT, HOOKS ) RESULT( TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT PROCEDURE(FUNCTION_ENCODING_CACHE_IF), POINTER, INTENT(IN) :: PFUNCTION - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -3417,12 +3450,12 @@ RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, OPT, HOOKS ) RESULT( PP_SET_ERR_SUCCESS( RET ) ! First node in the list. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%LEFT, PFUNCTION, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTION_ERROR) PFUNCTION( CURRENT%KEY, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%RIGHT, PFUNCTION, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%LEFT, PFUNCTION, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTION_ERROR) PFUNCTION( CURRENT%KEY, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%RIGHT, PFUNCTION, CACHE_OPT, HOOKS ) ENDIF @@ -3491,12 +3524,12 @@ END FUNCTION FUNCTION_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'FUNCTOR_NODE' -RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3513,7 +3546,7 @@ RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, OPT, HOOKS ) RESULT(RET TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT CLASS(FUNCTOR_ENCODING_CACHE_A), POINTER, INTENT(IN) :: FUNCTOR - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -3546,12 +3579,12 @@ RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, OPT, HOOKS ) RESULT(RET PP_SET_ERR_SUCCESS( RET ) ! First node in the list. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%LEFT, FUNCTOR, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTOR_ERROR) FUNCTOR%APPLY( CURRENT%KEY, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%RIGHT, FUNCTOR, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%LEFT, FUNCTOR, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTOR_ERROR) FUNCTOR%APPLY( CURRENT%KEY, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%RIGHT, FUNCTOR, CACHE_OPT, HOOKS ) ENDIF @@ -3608,23 +3641,28 @@ END FUNCTION FUNCTOR_NODE #undef PP_PROCEDURE_TYPE + + + + +!> @brief Prints all keys in the subtree pointed to by the current node. !> -!> @brief Renumber nodes in a Red Black tree. -!> -!> This subroutine recursively renumbers nodes in a Red Black tree rooted at the specified node. +!> This subroutine recursively prints all keys in the subtree pointed to by the current node. !> -!> @param [inout] ROOT The root node of the Red Black tree. -!> @param [inout] IDX The index used for renumbering nodes. +!> @param [in] ROOT Pointer to the root node of the subtree. +!> @param [in] CURRENT Pointer to the current node in the subtree. +!> @param [in] FUNCTION Function to be called for each node !> -!> @note This subroutine assumes that the Red Black tree structure is properly initialized. +!> @note This subroutine assumes that the subtree pointed to by the current node is properly initialized. !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' -#define PP_PROCEDURE_NAME 'RENUMBER_NODE' -RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) +#define PP_PROCEDURE_NAME 'DUMP_NODE' +RECURSIVE FUNCTION DUMP_NODE( ROOT, CURRENT, DUMP_PATH, CNT, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes @@ -3639,20 +3677,27 @@ RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) IMPLICIT NONE ! Dummy arguments - TYPE(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: ROOT - INTEGER(KIND=JPIB_K), INTENT(INOUT) :: IDX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT + TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT + CHARACTER(LEN=*), INTENT(IN) :: DUMP_PATH + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET !> Local variables + CHARACTER(LEN=128) :: CKEY LOGICAL :: IS_LEAF + INTEGER(KIND=JPIB_K) :: WRITE_STATUS !> Local error codes INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=1_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE=3_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_CALL_MAP_FUNCTOR_ERROR=4_JPIB_K ! Local variables declared by the preprocessor for debugging purposes PP_DEBUG_DECL_VARS @@ -3669,21 +3714,16 @@ RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - ! Renumber left subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, OPT, HOOKS ) - IF ( .NOT. IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%LEFT, IDX, OPT, HOOKS ) - ENDIF + ! First node in the list. + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT.IS_LEAF ) THEN - ! Renumber right subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, OPT, HOOKS ) - IF ( .NOT. IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%RIGHT, IDX, OPT, HOOKS ) - ENDIF + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) DUMP_NODE( ROOT, CURRENT%LEFT, DUMP_PATH, CNT, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) + CNT = CNT + 1 + PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTOR_ERROR) CURRENT%ENCODERS_%DUMP( DUMP_PATH, CNT, ENCODER_OPTIONS, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) DUMP_NODE( ROOT, CURRENT%RIGHT, DUMP_PATH, CNT, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) - ! Renumber the current node - IDX = IDX + 1 - ROOT%IDX = IDX + ENDIF ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -3709,8 +3749,12 @@ RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) SELECT CASE(ERRIDX) CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) - CASE (ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call renumber node' ) + CASE (ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call left subtree' ) + CASE (ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call the map function' ) + CASE (ERRFLAG_CALL_MAP_FUNCTOR_ERROR) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'erro calling the functo' ) CASE DEFAULT PP_DEBUG_PUSH_MSG_TO_FRAME( 'unhandled error' ) END SELECT @@ -3729,29 +3773,28 @@ RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) ! Exit point (on error) RETURN -END FUNCTION RENUMBER_NODE +END FUNCTION DUMP_NODE #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE - -!> -!> @brief Renumber writes node connectivity in a Red Black tree. +!> @brief Prints all keys in the subtree pointed to by the current node. !> -!> This subroutine recursively writes node connectivity in a Red Black tree rooted at the specified node. +!> This subroutine recursively prints all keys in the subtree pointed to by the current node. !> -!> @param [inout] ROOT The root node of the Red Black tree. -!> @param [inout] UNIT Unit number of the output file where keys will be printed. +!> @param [in] ROOT Pointer to the root node of the subtree. +!> @param [in] CURRENT Pointer to the current node in the subtree. +!> @param [in] FUNCTION Function to be called for each node !> -!> @note This subroutine assumes that the Red Black tree structure is properly initialized. -!> @note Connectivity is written in the dot format to be parsed with graphviz +!> @note This subroutine assumes that the subtree pointed to by the current node is properly initialized. !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' -#define PP_PROCEDURE_NAME 'NODE_WRITE_CONNECTIVITY' -RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) +#define PP_PROCEDURE_NAME 'MEMORY_SIZE_NODE' +RECURSIVE FUNCTION MEMORY_SIZE_NODE( ROOT, CURRENT, MEMORY_BYTESIZE, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes @@ -3766,22 +3809,27 @@ RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) IMPLICIT NONE ! Dummy arguments - TYPE(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: ROOT - INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT + TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: MEMORY_BYTESIZE + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS - ! Function result + !> Function result INTEGER(KIND=JPIB_K) :: RET - ! Local variables + !> Local variables + CHARACTER(LEN=128) :: CKEY LOGICAL :: IS_LEAF INTEGER(KIND=JPIB_K) :: WRITE_STATUS + INTEGER(KIND=JPIB_K) :: TMP_MEMORY_BYTESIZE - ! Local error codes + !> Local error codes INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=1_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY=2_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_WRITE_ERROR=3_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE=3_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_CALL_MAP_FUNCTOR_ERROR=4_JPIB_K ! Local variables declared by the preprocessor for debugging purposes PP_DEBUG_DECL_VARS @@ -3798,25 +3846,15 @@ RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - ! Write connectivity of the left subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, OPT, HOOKS ) + ! First node in the list. + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%LEFT, UNIT, OPT, HOOKS ) - ENDIF - ! Write connectivity of the right subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, OPT, HOOKS ) - IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%RIGHT, UNIT, OPT, HOOKS ) - ENDIF + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) MEMORY_SIZE_NODE( ROOT, CURRENT%LEFT, MEMORY_BYTESIZE, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) + PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTOR_ERROR) CURRENT%ENCODERS_%BYTESIZE( TMP_MEMORY_BYTESIZE, ENCODER_OPTIONS, HOOKS ) + MEMORY_BYTESIZE = MEMORY_BYTESIZE + TMP_MEMORY_BYTESIZE + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) MEMORY_SIZE_NODE( ROOT, CURRENT%RIGHT, MEMORY_BYTESIZE, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) - ! Write connectivity of the current node - IF ( ASSOCIATED(ROOT%PARENT) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%PARENT, IS_LEAF, OPT, HOOKS ) - IF ( .NOT. IS_LEAF ) THEN - WRITE(UNIT,'(I6.6,A,I6.6)',IOSTAT=WRITE_STATUS) ROOT%PARENT%IDX, '->', ROOT%IDX - PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) - ENDIF ENDIF ! Trace end of procedure (on success) @@ -3843,10 +3881,12 @@ RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) SELECT CASE(ERRIDX) CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) - CASE (ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call write connectivity' ) - CASE (ERRFLAG_WRITE_ERROR) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'write error' ) + CASE (ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call left subtree' ) + CASE (ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call the map function' ) + CASE (ERRFLAG_CALL_MAP_FUNCTOR_ERROR) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'erro calling the functo' ) CASE DEFAULT PP_DEBUG_PUSH_MSG_TO_FRAME( 'unhandled error' ) END SELECT @@ -3865,30 +3905,29 @@ RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) ! Exit point (on error) RETURN -END FUNCTION NODE_WRITE_CONNECTIVITY +END FUNCTION MEMORY_SIZE_NODE #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE !> -!> @brief Renumber writes nodes in a Red Black tree. +!> @brief Renumber nodes in a Red Black tree. !> -!> This subroutine recursively writes nodes in a Red Black tree rooted at the specified node. +!> This subroutine recursively renumbers nodes in a Red Black tree rooted at the specified node. !> !> @param [inout] ROOT The root node of the Red Black tree. -!> @param [inout] UNIT Unit number of the output file where keys will be printed. +!> @param [inout] IDX The index used for renumbering nodes. !> !> @note This subroutine assumes that the Red Black tree structure is properly initialized. -!> @note Nodes are written in the dot format to be parsed with graphviz !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' -#define PP_PROCEDURE_NAME 'WRITE_NODE' -RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) +#define PP_PROCEDURE_NAME 'RENUMBER_NODE' +RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3902,23 +3941,20 @@ RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) IMPLICIT NONE ! Dummy arguments - CLASS(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: ROOT - INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: ROOT + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: IDX + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS - ! Function result + !> Function result INTEGER(KIND=JPIB_K) :: RET - ! Local variables + !> Local variables LOGICAL :: IS_LEAF - INTEGER(KIND=JPIB_K) :: WRITE_STATUS - CHARACTER(LEN=128) :: CKEY - ! Local error codes + !> Local error codes INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=1_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_WRITE_NODE=2_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_WRITE_ERROR=3_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE=2_JPIB_K ! Local variables declared by the preprocessor for debugging purposes PP_DEBUG_DECL_VARS @@ -3935,31 +3971,21 @@ RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - ! Write nodes in the left subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, OPT, HOOKS ) - IF ( .NOT. ASSOCIATED( ROOT%LEFT, NIL ) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%LEFT, UNIT,OPT, HOOKS ) + ! Renumber left subtree + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT. IS_LEAF ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%LEFT, IDX, CACHE_OPT, HOOKS ) ENDIF - ! Write nodes in the right subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, OPT, HOOKS ) - IF ( .NOT. ASSOCIATED( ROOT%RIGHT, NIL ) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%RIGHT, UNIT, OPT, HOOKS ) + ! Renumber right subtree + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT. IS_LEAF ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%RIGHT, IDX, CACHE_OPT, HOOKS ) ENDIF - ! Write the current key - CKEY = REPEAT( ' ', 128 ) - WRITE(CKEY,*,IOSTAT=WRITE_STATUS) ROOT%KEY - PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) - - ! Write the current node - IF ( ROOT%RED ) THEN - WRITE(UNIT,'(I6.6,A,I8.8,A)', IOSTAT=WRITE_STATUS) ROOT%IDX, ' [ label="', TRIM(ADJUSTL(CKEY)) ,'", fillcolor=red]' - PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) - ELSE - WRITE(UNIT,'(I6.6,A,I8.8,A)', IOSTAT=WRITE_STATUS) ROOT%IDX, ' [ label="', TRIM(ADJUSTL(CKEY)) ,'", fillcolor=black]' - PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) - ENDIF + ! Renumber the current node + IDX = IDX + 1 + ROOT%IDX = IDX ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -3985,10 +4011,8 @@ RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) SELECT CASE(ERRIDX) CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) - CASE (ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call map write node' ) - CASE (ERRFLAG_WRITE_ERROR) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'write error' ) + CASE (ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call renumber node' ) CASE DEFAULT PP_DEBUG_PUSH_MSG_TO_FRAME( 'unhandled error' ) END SELECT @@ -4007,21 +4031,30 @@ RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) ! Exit point (on error) RETURN -END FUNCTION WRITE_NODE +END FUNCTION RENUMBER_NODE #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE - +!> +!> @brief Renumber writes node connectivity in a Red Black tree. +!> +!> This subroutine recursively writes node connectivity in a Red Black tree rooted at the specified node. +!> +!> @param [inout] ROOT The root node of the Red Black tree. +!> @param [inout] UNIT Unit number of the output file where keys will be printed. +!> +!> @note This subroutine assumes that the Red Black tree structure is properly initialized. +!> @note Connectivity is written in the dot format to be parsed with graphviz +!> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' -#define PP_PROCEDURE_NAME 'GET_SORTED_KEYS_INT_NODE' -RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RESULT(RET) +#define PP_PROCEDURE_NAME 'NODE_WRITE_CONNECTIVITY' +RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4035,24 +4068,22 @@ RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RE IMPLICIT NONE ! Dummy arguments - TYPE(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE - TYPE(FORTRAN_MESSAGE_T), DIMENSION(:), INTENT(INOUT) :: SORTED_KEYS - INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: ROOT + INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET ! Local variables - TYPE(ENCODING_CACHE_NODE_T), POINTER :: Y - TYPE(ENCODING_CACHE_NODE_T), POINTER :: PREV LOGICAL :: IS_LEAF + INTEGER(KIND=JPIB_K) :: WRITE_STATUS ! Local error codes INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=1_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE=2_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_OUT_OF_BOUNDS=3_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_WRITE_ERROR=3_JPIB_K ! Local variables declared by the preprocessor for debugging purposes PP_DEBUG_DECL_VARS @@ -4069,24 +4100,173 @@ RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RE ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - ! Remove the map if it is not empty. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( NODE, IS_LEAF, OPT, HOOKS ) - IF ( .NOT. IS_LEAF ) THEN - - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%LEFT, SORTED_KEYS, CNT, OPT, HOOKS ) - - CNT = CNT + 1 - PP_DEBUG_CRITICAL_COND_THROW( CNT.GT.SIZE(SORTED_KEYS), ERRFLAG_OUT_OF_BOUNDS ) - SORTED_KEYS(CNT) = NODE%KEY - - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%RIGHT, SORTED_KEYS, CNT, OPT, HOOKS ) - + ! Write connectivity of the left subtree + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT.IS_LEAF ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%LEFT, UNIT, CACHE_OPT, HOOKS ) ENDIF - ! Trace end of procedure (on success) - PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + ! Write connectivity of the right subtree + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT.IS_LEAF ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%RIGHT, UNIT, CACHE_OPT, HOOKS ) + ENDIF - ! Exit point on success + ! Write connectivity of the current node + IF ( ASSOCIATED(ROOT%PARENT) ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%PARENT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT. IS_LEAF ) THEN + WRITE(UNIT,'(I6.6,A,I6.6)',IOSTAT=WRITE_STATUS) ROOT%PARENT%IDX, '->', ROOT%IDX + PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) + ENDIF + ENDIF + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) + CASE (ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call write connectivity' ) + CASE (ERRFLAG_WRITE_ERROR) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'write error' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION NODE_WRITE_CONNECTIVITY +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +!> +!> @brief Renumber writes nodes in a Red Black tree. +!> +!> This subroutine recursively writes nodes in a Red Black tree rooted at the specified node. +!> +!> @param [inout] ROOT The root node of the Red Black tree. +!> @param [inout] UNIT Unit number of the output file where keys will be printed. +!> +!> @note This subroutine assumes that the Red Black tree structure is properly initialized. +!> @note Nodes are written in the dot format to be parsed with graphviz +!> +#define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' +#define PP_PROCEDURE_NAME 'WRITE_NODE' +RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, CACHE_OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_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(ENCODING_CACHE_NODE_T), INTENT(INOUT) :: ROOT + INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + ! Function result + INTEGER(KIND=JPIB_K) :: RET + + ! Local variables + LOGICAL :: IS_LEAF + INTEGER(KIND=JPIB_K) :: WRITE_STATUS + CHARACTER(LEN=128) :: CKEY + + ! Local error codes + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=1_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_WRITE_NODE=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_WRITE_ERROR=3_JPIB_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 ) + + ! Write nodes in the left subtree + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT. ASSOCIATED( ROOT%LEFT, NIL ) ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%LEFT, UNIT, CACHE_OPT, HOOKS ) + ENDIF + + ! Write nodes in the right subtree + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT. ASSOCIATED( ROOT%RIGHT, NIL ) ) THEN + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%RIGHT, UNIT, CACHE_OPT, HOOKS ) + ENDIF + + ! Write the current key + CKEY = REPEAT( ' ', 128 ) + WRITE(CKEY,*,IOSTAT=WRITE_STATUS) ROOT%KEY + PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) + + ! Write the current node + IF ( ROOT%RED ) THEN + WRITE(UNIT,'(I6.6,A,I8.8,A)', IOSTAT=WRITE_STATUS) ROOT%IDX, ' [ label="', TRIM(ADJUSTL(CKEY)) ,'", fillcolor=red]' + PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) + ELSE + WRITE(UNIT,'(I6.6,A,I8.8,A)', IOSTAT=WRITE_STATUS) ROOT%IDX, ' [ label="', TRIM(ADJUSTL(CKEY)) ,'", fillcolor=black]' + PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) + ENDIF + + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() + + ! Exit point on success RETURN ! Error handler @@ -4095,41 +4275,231 @@ RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RE ! Initialization of bad path return value PP_SET_ERR_FAILURE( RET ) -#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) -!$omp critical(ERROR_HANDLER) +#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) +!$omp critical(ERROR_HANDLER) + + BLOCK + + ! Error handling variables + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) + CASE (ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call map write node' ) + CASE (ERRFLAG_WRITE_ERROR) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'write error' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION WRITE_NODE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + +#define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' +#define PP_PROCEDURE_NAME 'GET_SORTED_KEYS_INT_NODE' +RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_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(ENCODING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE + TYPE(FORTRAN_MESSAGE_T), DIMENSION(:), INTENT(INOUT) :: SORTED_KEYS + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + ! Function result + INTEGER(KIND=JPIB_K) :: RET + + ! Local variables + TYPE(ENCODING_CACHE_NODE_T), POINTER :: Y + TYPE(ENCODING_CACHE_NODE_T), POINTER :: PREV + LOGICAL :: IS_LEAF + + ! Local error codes + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_ISLEAF=1_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE=2_JPIB_K + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_OUT_OF_BOUNDS=3_JPIB_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 ) + + ! Remove the map if it is not empty. + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( NODE, IS_LEAF, CACHE_OPT, HOOKS ) + IF ( .NOT. IS_LEAF ) THEN + + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%LEFT, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) + + CNT = CNT + 1 + PP_DEBUG_CRITICAL_COND_THROW( CNT.GT.SIZE(SORTED_KEYS), ERRFLAG_OUT_OF_BOUNDS ) + SORTED_KEYS(CNT) = NODE%KEY + + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%RIGHT, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) + + ENDIF + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) + CASE (ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call map get sorted keys node' ) + CASE (ERRFLAG_OUT_OF_BOUNDS) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'out of bounds' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION GET_SORTED_KEYS_NODE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + +!> +!> @brief Initializes a map structure. +!> +!> This subroutine initializes the given map structure. +!> It sets up the necessary components to prepare the map for use. +!> +!> @param [inout] ENCODERS_MAP The map structure to be initialized. +!> +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'ENCODING_CACHE_INIT' +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_INIT( ENCODERS_MAP, CACHE_OPT, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_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(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + ! Function result + INTEGER(KIND=JPIB_K) :: RET - BLOCK + ! Local variables declared by the preprocessor for debugging purposes + PP_DEBUG_DECL_VARS - ! Error handling variables - PP_DEBUG_PUSH_FRAME() + ! Local variables declared by the preprocessor for logging purposes + PP_LOG_DECL_VARS - ! Handle different errors - SELECT CASE(ERRIDX) - CASE (ERRFLAG_UNABLE_TO_CALL_ISLEAF) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call isleaf' ) - CASE (ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call map get sorted keys node' ) - CASE (ERRFLAG_OUT_OF_BOUNDS) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'out of bounds' ) - CASE DEFAULT - PP_DEBUG_PUSH_MSG_TO_FRAME( 'unhandled error' ) - END SELECT + ! Local variables declared by the preprocessor for tracing purposes + PP_TRACE_DECL_VARS - ! Trace end of procedure (on error) - PP_TRACE_EXIT_PROCEDURE_ON_ERROR() + ! Trace begin of procedure + PP_TRACE_ENTER_PROCEDURE() - ! Write the error message and stop the program - PP_DEBUG_ABORT() + ! Initialization of good path return value + PP_SET_ERR_SUCCESS( RET ) - END BLOCK + ! Map initialization. + ENCODERS_MAP%ROOT => NIL + ENCODERS_MAP%SIZE_ = 0 -!$omp end critical(ERROR_HANDLER) -#endif + ! Trace end of procedure (on success) + PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() - ! Exit point (on error) + ! Exit point on success RETURN -END FUNCTION GET_SORTED_KEYS_NODE +END FUNCTION ENCODING_CACHE_INIT #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE @@ -4145,13 +4515,13 @@ END FUNCTION GET_SORTED_KEYS_NODE !> @param [inout] ENCODERS_MAP The map structure to be initialized. !> #define PP_PROCEDURE_TYPE 'FUNCTION' -#define PP_PROCEDURE_NAME 'ENCODING_CACHE_INIT' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_INIT( ENCODERS_MAP, OPT, HOOKS ) RESULT(RET) +#define PP_PROCEDURE_NAME 'ENCODING_CACHE_SIZE' +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_SIZE( ENCODERS_MAP, SZ, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4166,7 +4536,8 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_INIT( ENCODERS_MAP, OPT, HOOKS ) RESULT(R ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + INTEGER(KIND=JPIB_K), INTENT(OUT) :: SZ + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4188,8 +4559,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_INIT( ENCODERS_MAP, OPT, HOOKS ) RESULT(R PP_SET_ERR_SUCCESS( RET ) ! Map initialization. - ENCODERS_MAP%ROOT => NIL - ENCODERS_MAP%SIZE = 0 + SZ = ENCODERS_MAP%SIZE_ ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -4197,7 +4567,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_INIT( ENCODERS_MAP, OPT, HOOKS ) RESULT(R ! Exit point on success RETURN -END FUNCTION ENCODING_CACHE_INIT +END FUNCTION ENCODING_CACHE_SIZE #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE @@ -4211,11 +4581,12 @@ END FUNCTION ENCODING_CACHE_INIT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_FREE' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_FREE( ENCODERS_MAP, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_FREE( ENCODERS_MAP, CACHE_OPT, ENCODER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes @@ -4231,7 +4602,8 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_FREE( ENCODERS_MAP, OPT, HOOKS ) RESULT(R ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4257,15 +4629,15 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_FREE( ENCODERS_MAP, OPT, HOOKS ) RESULT(R PP_SET_ERR_SUCCESS( RET ) ! Remove the map if it is not empty. - IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN + IF ( ENCODERS_MAP%SIZE_ .GT. 0 ) THEN ! Recursive deletion of the tree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FREE) FREE_NODE( ENCODERS_MAP%ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FREE) FREE_NODE( ENCODERS_MAP%ROOT, CACHE_OPT, ENCODER_OPT, HOOKS ) ENDIF ! Reset the initial condition. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_INIT) ENCODERS_MAP%INIT( OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_INIT) ENCODERS_MAP%INIT( CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -4325,12 +4697,13 @@ END FUNCTION ENCODING_CACHE_FREE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_MINIMUM' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MINIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MINIMUM( ENCODERS_MAP, KEY, & +& CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -4347,10 +4720,10 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MINIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) IMPLICIT NONE ! Dummy arguments - CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4377,10 +4750,11 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MINIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) PP_SET_ERR_SUCCESS( RET ) ! Remove the map if it is not empty. - IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN + IF ( ENCODERS_MAP%SIZE_ .GT. 0 ) THEN ! Recursive deletion of the tree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( ENCODERS_MAP%ROOT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( ENCODERS_MAP%ROOT, Y, & +& CACHE_OPT, HOOKS ) KEY = Y%KEY @@ -4442,12 +4816,13 @@ END FUNCTION ENCODING_CACHE_MINIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_MAXIMUM' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, & +& CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -4466,7 +4841,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4494,10 +4869,10 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) PP_SET_ERR_SUCCESS( RET ) ! Remove the map if it is not empty. - IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN + IF ( ENCODERS_MAP%SIZE_ .GT. 0 ) THEN ! Recursive deletion of the tree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MAXIMUM( ENCODERS_MAP%ROOT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MAXIMUM( ENCODERS_MAP%ROOT, Y, CACHE_OPT, HOOKS ) KEY = Y%KEY @@ -4559,13 +4934,13 @@ END FUNCTION ENCODING_CACHE_MAXIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_GET_SORTED_KEYS' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEYS, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEYS, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4580,7 +4955,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEY ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP TYPE(FORTRAN_MESSAGE_T), DIMENSION(:), INTENT(INOUT) :: SORTED_KEYS - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4611,14 +4986,14 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEY ! Error handing PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(ENCODERS_MAP%ROOT), ERRFLAG_NOT_INITIALIZED ) - PP_DEBUG_CRITICAL_COND_THROW( ENCODERS_MAP%SIZE .NE. SIZE(SORTED_KEYS), ERRFLAG_WRONG_SIZE ) + PP_DEBUG_CRITICAL_COND_THROW( ENCODERS_MAP%SIZE_ .NE. SIZE(SORTED_KEYS), ERRFLAG_WRONG_SIZE ) ! Remove the map if it is not empty. - IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN + IF ( ENCODERS_MAP%SIZE_ .GT. 0 ) THEN ! Recursive deletion of the tree. CNT = 0 - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( ENCODERS_MAP%ROOT, SORTED_KEYS, CNT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( ENCODERS_MAP%ROOT, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) ENDIF ! Trace end of procedure (on success) @@ -4685,7 +5060,7 @@ END FUNCTION ENCODING_CACHE_GET_SORTED_KEYS #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_ACCESS_OR_CREATE' PP_THREAD_SAFE FUNCTION ENCODING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, METADATA, ENCODING_RULES, & -& ENCODERS, OPT, HOOKS ) RESULT(RET) +& ENCODERS, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K @@ -4697,6 +5072,8 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, METADAT USE :: CACHED_ENCODER_COLLECTION_MOD, ONLY: CACHED_ENCODER_COLLECTION_T USE :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4716,7 +5093,9 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, METADAT CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA TYPE(ENCODING_RULE_COLLECTION_T), INTENT(IN) :: ENCODING_RULES TYPE(CACHED_ENCODER_COLLECTION_T), POINTER, INTENT(OUT) :: ENCODERS - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT + TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4745,11 +5124,11 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, METADAT ! Call the routine to insert a node in the map PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_INSERT_NODE) ACCESS_OR_CREATE_NODE( THIS%ROOT, KEY, PAR, & -& METADATA, ENCODING_RULES, ENCODERS, INSERTED, OPT, HOOKS ) +& METADATA, ENCODING_RULES, ENCODERS, INSERTED, CACHE_OPT, ENCODER_OPT, FILTER_OPT, HOOKS ) ! Update the number of elements in the map IF ( INSERTED ) THEN - THIS%SIZE = THIS%SIZE + 1 + THIS%SIZE_ = THIS%SIZE_ + 1 ENDIF ! Trace end of procedure (on success) @@ -4813,13 +5192,13 @@ END FUNCTION ENCODING_CACHE_ACCESS_OR_CREATE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_MATCH' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MATCH( THIS, KEY, CACHE_OPT, LMATCH, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4835,7 +5214,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RE ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: THIS TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT LOGICAL, INTENT(OUT) :: LMATCH TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -4865,7 +5244,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RE ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( ROOT_IS_LEAF ) THEN LMATCH = .FALSE. @@ -4874,7 +5253,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RE ! Search the node in the map SEARCHED_NODE => NIL - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, OPT, LMATCH, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, CACHE_OPT, LMATCH, HOOKS ) ENDIF ! Trace end of procedure (on success) @@ -4938,13 +5317,14 @@ END FUNCTION ENCODING_CACHE_MATCH !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_REMOVE' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_REMOVE( THIS, KEY, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_REMOVE( THIS, KEY, CACHE_OPT, ENCODER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4960,7 +5340,8 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_REMOVE( THIS, KEY, OPT, HOOKS ) RESULT(RE ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: THIS TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4992,18 +5373,18 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_REMOVE( THIS, KEY, OPT, HOOKS ) RESULT(RE ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( ROOT_IS_LEAF, ERRFLAG_MAP_IS_EMPTY ) ! Search the node in the map SEARCHED_NODE => NIL - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, OPT, LMATCH, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, CACHE_OPT, LMATCH, HOOKS ) !> If node is found then removve it IF ( LMATCH ) THEN !> Remove the node from the map - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_NODE) REMOVE_NODE( THIS%ROOT, SEARCHED_NODE, OPT, HOOKS ) - THIS%SIZE = THIS%SIZE - 1 + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_NODE) REMOVE_NODE( THIS%ROOT, SEARCHED_NODE, CACHE_OPT, ENCODER_OPT, HOOKS ) + THIS%SIZE_ = THIS%SIZE_ - 1 ENDIF @@ -5072,12 +5453,12 @@ END FUNCTION ENCODING_CACHE_REMOVE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_LIST' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_LIST( THIS, UNIT, PREFIX, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_LIST( THIS, UNIT, PREFIX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5094,7 +5475,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_LIST( THIS, UNIT, PREFIX, OPT, HOOKS ) RE CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: THIS INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT CHARACTER(LEN=*), INTENT(IN) :: PREFIX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -5123,7 +5504,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_LIST( THIS, UNIT, PREFIX, OPT, HOOKS ) RE ! Call the recursive writing CNT = 0_JPIB_K - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LIST_NODE) LIST_NODE( THIS%ROOT, THIS%ROOT, CNT, UNIT, PREFIX, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LIST_NODE) LIST_NODE( THIS%ROOT, THIS%ROOT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -5185,12 +5566,12 @@ END FUNCTION ENCODING_CACHE_LIST !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_APPLY_FUNCTION' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5206,7 +5587,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, OPT, HOOK ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: THIS PROCEDURE(FUNCTION_ENCODING_CACHE_IF), POINTER, INTENT(IN) :: FUNCTION - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -5231,7 +5612,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, OPT, HOOK PP_SET_ERR_SUCCESS( RET ) PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FUNCTION_NODE) FUNCTION_NODE( THIS%ROOT, & -& THIS%ROOT, FUNCTION, OPT, HOOKS ) +& THIS%ROOT, FUNCTION, CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -5292,12 +5673,12 @@ END FUNCTION ENCODING_CACHE_APPLY_FUNCTION !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_APPLY_FUNCTOR' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5313,7 +5694,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, OPT, HOOKS ! Dummy arguments CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: THIS CLASS(FUNCTOR_ENCODING_CACHE_A), POINTER, INTENT(IN) :: FUNCTOR - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -5338,7 +5719,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, OPT, HOOKS PP_SET_ERR_SUCCESS( RET ) PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE) FUNCTOR_NODE( THIS%ROOT, & -& THIS%ROOT, FUNCTOR, OPT, HOOKS ) +& THIS%ROOT, FUNCTOR, CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -5386,6 +5767,220 @@ END FUNCTION ENCODING_CACHE_APPLY_FUNCTOR #undef PP_PROCEDURE_NAME #undef PP_PROCEDURE_TYPE + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'ENCODING_CACHE_DUMP' +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_DUMP( THIS, DUMP_PATH, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_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(ENCODING_CACHE_T), INTENT(INOUT) :: THIS + CHARACTER(LEN=*), INTENT(IN) :: DUMP_PATH + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + ! Function result + INTEGER(KIND=JPIB_K) :: RET + + ! Local variables + INTEGER(KIND=JPIB_K) :: CNT + + ! Local error codes + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE=1_JPIB_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 ) + + ! Counter initialization + CNT = 0_JPIB_K + + ! Recursive call the dump procedure + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE) DUMP_NODE( THIS%ROOT, & +& THIS%ROOT, DUMP_PATH, CNT, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call map list node' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION ENCODING_CACHE_DUMP +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + +#define PP_PROCEDURE_TYPE 'FUNCTION' +#define PP_PROCEDURE_NAME 'ENCODING_CACHE_BYTESIZE' +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_BYTESIZE( THIS, MEMORY_BYTESIZE, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) RESULT(RET) + + ! Symbols imported from other modules within the project. + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_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(ENCODING_CACHE_T), INTENT(INOUT) :: THIS + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: MEMORY_BYTESIZE + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + + ! Function result + INTEGER(KIND=JPIB_K) :: RET + + ! Local error codes + INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE=1_JPIB_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 ) + + ! Set the memory bytesize to zero + MEMORY_BYTESIZE = 0_JPIB_K + + ! Recursive call the dump procedure + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE) MEMORY_SIZE_NODE( THIS%ROOT, & +& THIS%ROOT, MEMORY_BYTESIZE, CACHE_OPT, ENCODER_OPTIONS, HOOKS ) + + ! 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 + PP_DEBUG_PUSH_FRAME() + + ! Handle different errors + SELECT CASE(ERRIDX) + CASE (ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE) + PP_DEBUG_PUSH_MSG_TO_FRAME( 'unable to call map list node' ) + CASE DEFAULT + PP_DEBUG_PUSH_MSG_TO_FRAME( '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() + + END BLOCK + +!$omp end critical(ERROR_HANDLER) +#endif + + ! Exit point (on error) + RETURN + +END FUNCTION ENCODING_CACHE_BYTESIZE +#undef PP_PROCEDURE_NAME +#undef PP_PROCEDURE_TYPE + + + + + + !> !> @briefPrint the map. !> @@ -5400,12 +5995,12 @@ END FUNCTION ENCODING_CACHE_APPLY_FUNCTOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ENCODING_CACHE_PRINT' -PP_THREAD_SAFE FUNCTION ENCODING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ENCODING_CACHE_PRINT( THIS, NAME, IDX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5422,7 +6017,7 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESU CLASS(ENCODING_CACHE_T), INTENT(INOUT) :: THIS CHARACTER(LEN=*), INTENT(IN) :: NAME INTEGER(KIND=JPIB_K), INTENT(IN) :: IDX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -5461,11 +6056,11 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESU PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) UNIT = 0 - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( THIS%ROOT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( THIS%ROOT, UNIT, CACHE_OPT, HOOKS ) UNIT=131 - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. ROOT_IS_LEAF ) THEN OPEN(unit=unit, file=TRIM(FNAME), action='write',IOSTAT=WRITE_STATUS ) PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) @@ -5479,14 +6074,14 @@ PP_THREAD_SAFE FUNCTION ENCODING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESU PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '// Nodes' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( THIS%ROOT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( THIS%ROOT, UNIT, CACHE_OPT, HOOKS ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '// Connectivity' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( THIS%ROOT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( THIS%ROOT, UNIT, CACHE_OPT, HOOKS ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '}' diff --git a/src/multiom/encoding-rules/encoding_utils_mod.F90 b/src/multiom/encoding-rules/encoding_utils_mod.F90 index b2936185..cbc1945e 100644 --- a/src/multiom/encoding-rules/encoding_utils_mod.F90 +++ b/src/multiom/encoding-rules/encoding_utils_mod.F90 @@ -38,12 +38,13 @@ MODULE ENCODING_UTILS_MOD #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAKE_ENCODER_COLLECTION' PP_THREAD_SAFE FUNCTION MAKE_ENCODER_COLLECTION( MSG, PAR, & - METADATA, ENCODING_RULES, OPT, ENCODERS_COLLECTION, HOOKS ) RESULT(RET) + METADATA, ENCODING_RULES, ENCODER_OPTIONS, FILTER_OPTIONS, ENCODERS_COLLECTION, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: ENCODING_RULE_COLLECTION_MOD, ONLY: ENCODING_RULE_COLLECTION_T @@ -67,7 +68,8 @@ PP_THREAD_SAFE FUNCTION MAKE_ENCODER_COLLECTION( MSG, PAR, & TYPE(PARAMETRIZATION_T), INTENT(IN) :: PAR CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA TYPE(ENCODING_RULE_COLLECTION_T), INTENT(IN) :: ENCODING_RULES - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPTIONS + TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS TYPE(CACHED_ENCODER_COLLECTION_T), INTENT(OUT) :: ENCODERS_COLLECTION TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -106,20 +108,20 @@ PP_THREAD_SAFE FUNCTION MAKE_ENCODER_COLLECTION( MSG, PAR, & !> Reset the encoder if needed IF ( IS_INITIALIZED ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RESET) ENCODERS_COLLECTION%FREE( OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RESET) ENCODERS_COLLECTION%FREE( ENCODER_OPTIONS, HOOKS ) ENDIF !> Get the encoders ENCODERS => NULL() PP_TRYCALL(ERRFLAG_UNABLE_TO_MATCH_RULE) ENCODING_RULES%MATCH( & -& MSG, PAR, METADATA, ENCODERS, OPT, HOOKS ) +& MSG, PAR, METADATA, ENCODERS, ENCODER_OPTIONS, HOOKS ) !> Check if the encoders are not empty PP_DEBUG_CRITICAL_COND_THROW( .NOT. ASSOCIATED(ENCODERS), ERRFLAG_ENCODERS_NOT_ASSOCIATED ) !> Encoder initialization PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_ENCODERS) ENCODERS_COLLECTION%INIT( & -& MSG, PAR, METADATA, ENCODERS, OPT, HOOKS ) +& MSG, PAR, METADATA, ENCODERS, ENCODER_OPTIONS, HOOKS ) ENCODERS => NULL() ! Trace end of procedure (on success) diff --git a/src/multiom/mapping-rules/CMakeLists.txt b/src/multiom/mapping-rules/CMakeLists.txt index f609b944..28fad5a6 100644 --- a/src/multiom/mapping-rules/CMakeLists.txt +++ b/src/multiom/mapping-rules/CMakeLists.txt @@ -15,6 +15,7 @@ set( MULTIOM_MAPPING_RULES_MAIN_SOURCES ${MULTIOM_MAPPING_RULES_DIR}/cached_mapper_mod.F90 ${MULTIOM_MAPPING_RULES_DIR}/mapping_cache_mod.F90 ${MULTIOM_MAPPING_RULES_DIR}/mapping_utils_mod.F90 + ${MULTIOM_MAPPING_RULES_DIR}/mapping_options_mod.F90 ) # Collect source files in module2 diff --git a/src/multiom/mapping-rules/cached_mapper_collection_mod.F90 b/src/multiom/mapping-rules/cached_mapper_collection_mod.F90 index 22407a61..219b9b86 100644 --- a/src/multiom/mapping-rules/cached_mapper_collection_mod.F90 +++ b/src/multiom/mapping-rules/cached_mapper_collection_mod.F90 @@ -358,11 +358,12 @@ END FUNCTION CACHED_MAPPER_COLLECTION_EVAL #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME ' CACHED_MAPPER_COLLECTION_FREE' -PP_THREAD_SAFE FUNCTION CACHED_MAPPER_COLLECTION_FREE( THIS, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION CACHED_MAPPER_COLLECTION_FREE( THIS, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -377,6 +378,7 @@ PP_THREAD_SAFE FUNCTION CACHED_MAPPER_COLLECTION_FREE( THIS, HOOKS ) RESULT(RET !> Dummy arguments CLASS(CACHED_MAPPER_COLLECTION_T), INTENT(INOUT) :: THIS + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -409,7 +411,7 @@ PP_THREAD_SAFE FUNCTION CACHED_MAPPER_COLLECTION_FREE( THIS, HOOKS ) RESULT(RET ! Reset the object IF ( ASSOCIATED(THIS%MAPPER_) ) THEN DO I = 1, SIZE(THIS%MAPPER_) - PP_TRYCALL(ERRFLAG_FREE_CACHED_MAPPER) THIS%MAPPER_(I)%FREE( HOOKS ) + PP_TRYCALL(ERRFLAG_FREE_CACHED_MAPPER) THIS%MAPPER_(I)%FREE( MAPPING_OPT, HOOKS ) ENDDO DEALLOCATE( THIS%MAPPER_, STAT=DEALLOC_ERROR, ERRMSG=ERRMSG ) PP_DEBUG_CRITICAL_COND_THROW( DEALLOC_ERROR.NE.0, ERRFLAG_FREE_CACHED_MAPPER ) diff --git a/src/multiom/mapping-rules/cached_mapper_mod.F90 b/src/multiom/mapping-rules/cached_mapper_mod.F90 index 523ad1c7..3e0895e0 100644 --- a/src/multiom/mapping-rules/cached_mapper_mod.F90 +++ b/src/multiom/mapping-rules/cached_mapper_mod.F90 @@ -172,11 +172,12 @@ END FUNCTION CASHED_MAPPER_INIT_COPY #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'CASHED_MAPPER_FREE' -PP_THREAD_SAFE FUNCTION CASHED_MAPPER_FREE( THIS, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION CASHED_MAPPER_FREE( THIS, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -190,8 +191,9 @@ PP_THREAD_SAFE FUNCTION CASHED_MAPPER_FREE( THIS, HOOKS ) RESULT(RET) IMPLICIT NONE !> Dummy arguments - CLASS(CASHED_MAPPER_T), INTENT(INOUT) :: THIS - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(CASHED_MAPPER_T), INTENT(INOUT) :: THIS + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET diff --git a/src/multiom/mapping-rules/mapping_cache_mod.F90 b/src/multiom/mapping-rules/mapping_cache_mod.F90 index cb962c90..f2e76268 100644 --- a/src/multiom/mapping-rules/mapping_cache_mod.F90 +++ b/src/multiom/mapping-rules/mapping_cache_mod.F90 @@ -41,16 +41,16 @@ MODULE MAPPING_CACHE_MOD INTERFACE - PP_THREAD_SAFE FUNCTION FUNCTION_MAPPING_CACHE_IF( KEY, OPT, HOOKS ) RESULT(RET) + PP_THREAD_SAFE FUNCTION FUNCTION_MAPPING_CACHE_IF( KEY, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T IMPLICIT NONE - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS INTEGER(KIND=JPIB_K) :: RET END FUNCTION FUNCTION_MAPPING_CACHE_IF END INTERFACE @@ -61,18 +61,18 @@ END FUNCTION FUNCTION_MAPPING_CACHE_IF END TYPE ABSTRACT INTERFACE - PP_THREAD_SAFE FUNCTION FUNCTOR_MAPPING_CACHE_IF( THIS, KEY, OPT, HOOKS ) RESULT(RET) + PP_THREAD_SAFE FUNCTION FUNCTOR_MAPPING_CACHE_IF( THIS, KEY, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T IMPORT :: FUNCTOR_MAPPING_CACHE_A IMPLICIT NONE CLASS(FUNCTOR_MAPPING_CACHE_A), INTENT(INOUT) :: THIS - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS INTEGER(KIND=JPIB_K) :: RET END FUNCTION FUNCTOR_MAPPING_CACHE_IF END INTERFACE @@ -161,12 +161,13 @@ END FUNCTION FUNCTOR_MAPPING_CACHE_IF !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_EQUAL_TO' -PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, OPT, IS_EQUAL, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, CACHE_OPTION, IS_EQUAL, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -183,11 +184,11 @@ PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, OPT, IS_EQUAL, HOOKS ) RESULT( IMPLICIT NONE ! Dummy arguments - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: IS_EQUAL - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPTION + LOGICAL, INTENT(OUT) :: IS_EQUAL + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -211,7 +212,8 @@ PP_THREAD_SAFE FUNCTION KEY_EQUAL_TO( KEY1, KEY2, OPT, IS_EQUAL, HOOKS ) RESULT( PP_SET_ERR_SUCCESS( RET ) ! Check if the keys are equal (the check depends on the options) - PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_EQUAL_TO( KEY2, OPT, IS_EQUAL, HOOKS ) + PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_EQUAL_TO( & +& KEY2, CACHE_OPTION, IS_EQUAL, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -279,12 +281,13 @@ END FUNCTION KEY_EQUAL_TO !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'KEY_LOWER_THAN' -PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, OPT, IS_LOWER_THAN, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, CACHE_OPTION, IS_LOWER_THAN, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -301,11 +304,11 @@ PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, OPT, IS_LOWER_THAN, HOOKS ) IMPLICIT NONE ! Dummy arguments - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: IS_LOWER_THAN - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY1 + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY2 + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPTION + LOGICAL, INTENT(OUT) :: IS_LOWER_THAN + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -329,7 +332,8 @@ PP_THREAD_SAFE FUNCTION KEY_LOWER_THAN( KEY1, KEY2, OPT, IS_LOWER_THAN, HOOKS ) PP_SET_ERR_SUCCESS( RET ) ! Check if the keys are lower than (the check depends on the options) - PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_LOWER_THAN( KEY2, OPT, IS_LOWER_THAN, HOOKS ) + PP_TRYCALL(ERRFLAG_COMPARE_ERROR) KEY1%IS_LOWER_THAN( & +& KEY2, CACHE_OPTION, IS_LOWER_THAN, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -398,12 +402,13 @@ END FUNCTION KEY_LOWER_THAN #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ACCESS_OR_CREATE_NODE' PP_THREAD_SAFE FUNCTION ACCESS_OR_CREATE_NODE( ROOT, KEY, PAR, MAPPING_RULES, & -& MAPPERS, INSERTED, OPT, FILTER_OPT, HOOKS ) RESULT(RET) +& MAPPERS, INSERTED, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T @@ -428,7 +433,8 @@ PP_THREAD_SAFE FUNCTION ACCESS_OR_CREATE_NODE( ROOT, KEY, PAR, MAPPING_RULES, & TYPE(MAPPING_RULES_COLLECTION_T), INTENT(IN) :: MAPPING_RULES TYPE(CACHED_MAPPER_COLLECTION_T), POINTER, INTENT(OUT) :: MAPPERS LOGICAL, INTENT(OUT) :: INSERTED - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -473,41 +479,41 @@ PP_THREAD_SAFE FUNCTION ACCESS_OR_CREATE_NODE( ROOT, KEY, PAR, MAPPING_RULES, & INSERTED =.FALSE. NULLIFY(MAPPERS) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( ROOT_IS_LEAF ) THEN ! Map is empty INSERTED =.TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( ROOT, CACHE_OPT, HOOKS ) INSERTION_POINT => NIL PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) NODE_INIT( ROOT, INSERTION_POINT, KEY, & -& PAR, MAPPING_RULES, OPT, FILTER_OPT, HOOKS ) +& PAR, MAPPING_RULES, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) MAPPERS => ROOT%MAPPERS_ - PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, ROOT, CACHE_OPT, HOOKS ) INSERTION_POINT => ROOT ! WRITE(*,*) 'Node inserted' ELSE ! Map not empty INSERTION_POINT => NIL - PP_TRYCALL(ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, OPT, FOUND, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, CACHE_OPT, FOUND, HOOKS ) IF ( .NOT.FOUND ) THEN ! If the node is not in the map then insert it INSERTED =.TRUE. - PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, INSERTION_POINT%KEY, OPT, KEY_LT, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, INSERTION_POINT%KEY, CACHE_OPT, KEY_LT, HOOKS ) IF ( KEY_LT ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( INSERTION_POINT%LEFT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) ALLOCATE_NODE( INSERTION_POINT%LEFT, CACHE_OPT, HOOKS ) PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) NODE_INIT( INSERTION_POINT%LEFT, INSERTION_POINT, & -& KEY, PAR, MAPPING_RULES, OPT, FILTER_OPT, HOOKS ) +& KEY, PAR, MAPPING_RULES, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) MAPPERS => INSERTION_POINT%LEFT%MAPPERS_ - PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%LEFT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%LEFT, CACHE_OPT, HOOKS ) ELSE - PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) ALLOCATE_NODE( INSERTION_POINT%RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_INITIALIZE_NODE) ALLOCATE_NODE( INSERTION_POINT%RIGHT, CACHE_OPT, HOOKS ) PP_TRYCALL(ERRFLAG_UNABLE_TO_ALLOCATE_NODE) NODE_INIT( INSERTION_POINT%RIGHT, INSERTION_POINT, & -& KEY, PAR, MAPPING_RULES, OPT, FILTER_OPT, HOOKS ) +& KEY, PAR, MAPPING_RULES, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) MAPPERS => INSERTION_POINT%RIGHT%MAPPERS_ - PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FIXUP_INSERT) INSERT_FIXUP( ROOT, INSERTION_POINT%RIGHT, CACHE_OPT, HOOKS ) ENDIF ! WRITE(*,*) 'Node inserted' ELSE @@ -602,13 +608,14 @@ END FUNCTION ACCESS_OR_CREATE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'DELETE_NODE' -PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, CACHE_OPT, MAPPING_OPT, FOUND, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -623,10 +630,11 @@ PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - LOGICAL, INTENT(OUT) :: FOUND - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + LOGICAL, INTENT(OUT) :: FOUND + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -655,11 +663,11 @@ PP_THREAD_SAFE FUNCTION DELETE_NODE( ROOT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.ROOT_IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, OPT, FOUND, HOOKS ) + PP_TRYCALL(ERRFLAG_ERRFLAG_UNABLE_TO_SEARCH_NODE) SEARCH_NODE( ROOT, INSERTION_POINT, KEY, CACHE_OPT, FOUND, HOOKS ) IF ( FOUND ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_REMOVE_NODE) REMOVE_NODE( ROOT, INSERTION_POINT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_REMOVE_NODE) REMOVE_NODE( ROOT, INSERTION_POINT, CACHE_OPT, MAPPING_OPT, HOOKS ) ENDIF ENDIF @@ -730,12 +738,13 @@ END FUNCTION DELETE_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'FREE_NODE' -RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION FREE_NODE( CURRENT, CACHE_OPT, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -750,7 +759,8 @@ RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CURRENT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -779,13 +789,13 @@ RECURSIVE FUNCTION FREE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) IF ( .NOT.ASSOCIATED( CURRENT, NIL ) ) THEN ! Deallocate left subtree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%LEFT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%LEFT, CACHE_OPT, MAPPING_OPT, HOOKS ) ! Deallocate right subtree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_NODE) FREE_NODE( CURRENT%RIGHT, CACHE_OPT, MAPPING_OPT, HOOKS ) ! Free memory - PP_TRYCALL(ERRFLAG_UNABLE_TO_DEALLOCATE_NODE) DEALLOCATE_NODE( CURRENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_DEALLOCATE_NODE) DEALLOCATE_NODE( CURRENT, CACHE_OPT, MAPPING_OPT, HOOKS ) ENDIF @@ -861,12 +871,12 @@ END FUNCTION FREE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SEARCH_NODE' -PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, CACHE_OPT, FOUND, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -886,7 +896,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CURRENT TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT LOGICAL, INTENT(OUT) :: FOUND TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -926,7 +936,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES ! Map is empty. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( ROOT_IS_LEAF ) THEN FOUND = .FALSE. @@ -937,19 +947,19 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES SearchLoop: DO !> Handle exit conditions - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, OPT, KEY_EQ, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, CACHE_OPT, KEY_EQ, HOOKS ) IF ( IS_LEAF .OR. KEY_EQ ) THEN EXIT SearchLoop ENDIF ! Left subtree - PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, CURRENT%KEY, OPT, KEY_LT, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_LT_FAILURE) KEY_LOWER_THAN( KEY, CURRENT%KEY, CACHE_OPT, KEY_LT, HOOKS ) IF ( KEY_LT ) THEN !> Check if the current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) !> Depending if it si a leaf or not, move to the left or exit IF ( .NOT.IS_LEAF ) THEN @@ -965,7 +975,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES ENDIF ! Node Found - PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, OPT, KEY_EQ, HOOKS ) + PP_TRYCALL(ERRFLAG_KEY_EQ_FAILURE) KEY_EQUAL_TO( KEY, CURRENT%KEY, CACHE_OPT, KEY_EQ, HOOKS ) ELSEIF ( KEY_EQ ) THEN FOUND = .TRUE. @@ -975,7 +985,7 @@ PP_THREAD_SAFE FUNCTION SEARCH_NODE( ROOT, CURRENT, KEY, OPT, FOUND, HOOKS ) RES ELSE !> Check if the current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) !> Depending if it si a leaf or not, move to the right or exit IF ( .NOT.IS_LEAF ) THEN @@ -1062,12 +1072,13 @@ END FUNCTION SEARCH_NODE #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'NODE_INIT' PP_THREAD_SAFE FUNCTION NODE_INIT( THIS, PARENT, KEY, PAR, & - MAPPING_RULES, ENCODER_OPT, FILTER_OPT, HOOKS ) RESULT(RET) + MAPPING_RULES, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -1092,7 +1103,8 @@ PP_THREAD_SAFE FUNCTION NODE_INIT( THIS, PARENT, KEY, PAR, & TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY TYPE(PARAMETRIZATION_T), INTENT(IN) :: PAR TYPE(MAPPING_RULES_COLLECTION_T), INTENT(IN) :: MAPPING_RULES - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -1148,7 +1160,7 @@ PP_THREAD_SAFE FUNCTION NODE_INIT( THIS, PARENT, KEY, PAR, & !> Initialize the mappers PP_TRYCALL(ERRFLAG_MAPPING_COLLECTION_INIT) MAKE_MAPPERS_COLLECTION( & -& KEY, PAR, MAPPING_RULES, ENCODER_OPT, FILTER_OPT, THIS%MAPPERS_, HOOKS ) +& KEY, PAR, MAPPING_RULES, MAPPING_OPT, FILTER_OPT, THIS%MAPPERS_, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -1221,12 +1233,12 @@ END FUNCTION NODE_INIT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ALLOCATE_NODE' -PP_THREAD_SAFE FUNCTION ALLOCATE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ALLOCATE_NODE( CURRENT, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1241,7 +1253,7 @@ PP_THREAD_SAFE FUNCTION ALLOCATE_NODE( CURRENT, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CURRENT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -1344,12 +1356,13 @@ END FUNCTION ALLOCATE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'DEALLOCATE_NODE' -PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, CACHE_OPT, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1364,7 +1377,8 @@ PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: X - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -1399,7 +1413,7 @@ PP_THREAD_SAFE FUNCTION DEALLOCATE_NODE( X, OPT, HOOKS ) RESULT(RET) ! Free memory of the key and payload PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_KEY) X%KEY%FREE( HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_VAL) X%MAPPERS_%FREE( HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_VAL) X%MAPPERS_%FREE( MAPPING_OPT, HOOKS ) ! Free mappers IF ( ASSOCIATED( X%MAPPERS_ ) ) THEN @@ -1485,12 +1499,12 @@ END FUNCTION DEALLOCATE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'INSERT_FIXUP' -PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -1509,7 +1523,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: CUR - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -1570,7 +1584,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X, CACHE_OPT, HOOKS ) ENDIF @@ -1578,7 +1592,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X%PARENT%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT%PARENT, CACHE_OPT, HOOKS ) ENDIF @@ -1603,7 +1617,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X, CACHE_OPT, HOOKS ) ENDIF @@ -1611,7 +1625,7 @@ PP_THREAD_SAFE FUNCTION INSERT_FIXUP( ROOT, CUR, OPT, HOOKS ) RESULT(RET) X%PARENT%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X%PARENT%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, X%PARENT%PARENT, CACHE_OPT, HOOKS ) ENDIF @@ -1686,12 +1700,12 @@ END FUNCTION INSERT_FIXUP !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ROTATE_LEFT' -PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1707,7 +1721,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(MAPPING_CACHE_NODE_T), TARGET, INTENT(INOUT) :: X_ - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -1744,7 +1758,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Rotate. Y => X%RIGHT X%RIGHT => Y%LEFT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y%LEFT%PARENT => X @@ -1753,7 +1767,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_LEFT( ROOT, X_, OPT, HOOKS ) RESULT(RET) Y%PARENT => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT, CACHE_OPT, HOOKS ) IF ( IS_ROOT ) THEN ROOT => Y @@ -1838,12 +1852,12 @@ END FUNCTION ROTATE_LEFT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'ROTATE_RIGHT' -PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -1859,7 +1873,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T),POINTER, INTENT(INOUT) :: ROOT TYPE(MAPPING_CACHE_NODE_T), TARGET, INTENT(INOUT) :: X_ - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result @@ -1896,7 +1910,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) ! Rotate. Y => X%LEFT X%LEFT => Y%RIGHT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y%RIGHT%PARENT => X @@ -1906,7 +1920,7 @@ PP_THREAD_SAFE FUNCTION ROTATE_RIGHT( ROOT, X_, OPT, HOOKS ) RESULT(RET) Y%PARENT => X%PARENT - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%PARENT, IS_ROOT_LEAF, CACHE_OPT, HOOKS ) IF ( IS_ROOT_LEAF ) THEN ROOT => Y @@ -1988,12 +2002,12 @@ END FUNCTION ROTATE_RIGHT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'NODE_ISLEAF' -PP_THREAD_SAFE FUNCTION NODE_ISLEAF( X, ISLEAF, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION NODE_ISLEAF( X, ISLEAF, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2007,10 +2021,10 @@ PP_THREAD_SAFE FUNCTION NODE_ISLEAF( X, ISLEAF, OPT, HOOKS ) RESULT(RET) IMPLICIT NONE ! Dummy arguments - TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: X - LOGICAL, INTENT(OUT) :: ISLEAF - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: X + LOGICAL, INTENT(OUT) :: ISLEAF + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -2057,12 +2071,12 @@ END FUNCTION NODE_ISLEAF !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SUCCESSOR' -PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2078,8 +2092,8 @@ PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -2113,16 +2127,16 @@ PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) Y => NULL() ! Check. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) ! Search cycle. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN ! If the node has a right child then the successor is the ! minimum of the right subtree of the node. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( X%RIGHT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( X%RIGHT, Y, CACHE_OPT, HOOKS ) ELSE @@ -2133,7 +2147,7 @@ PP_THREAD_SAFE FUNCTION SUCCESSOR( X, Y, OPT, HOOKS ) RESULT(RET) SearchSuccessor: DO - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF .AND. ASSOCIATED( X_, Y%RIGHT ) ) THEN X_ => Y @@ -2215,12 +2229,12 @@ END FUNCTION SUCCESSOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'PREDECESSOR' -PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2236,8 +2250,8 @@ PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -2271,16 +2285,16 @@ PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) Y => NULL() ! Check. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) ! Search cycle. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN ! If the node has a left child then the successor is the ! minimum of the left subtree of the node. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MAXIMUM) MAXIMUM( X%LEFT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MAXIMUM) MAXIMUM( X%LEFT, Y, CACHE_OPT, HOOKS ) ELSE @@ -2291,7 +2305,7 @@ PP_THREAD_SAFE FUNCTION PREDECESSOR( X, Y, OPT, HOOKS ) RESULT(RET) SearchPredecessor: DO - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF .AND. ASSOCIATED( X_, Y%LEFT ) ) THEN X_ => Y @@ -2374,12 +2388,12 @@ END FUNCTION PREDECESSOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MINIMUM' -PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -2398,8 +2412,8 @@ PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -2431,7 +2445,7 @@ PP_THREAD_SAFE FUNCTION MINIMUM( X, Y, OPT, HOOKS ) RESULT(RET) ! Search cycle. SearchMinimum: DO WHILE(.TRUE.) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y => Y%LEFT @@ -2506,12 +2520,12 @@ END FUNCTION MINIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAXIMUM' -PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -2530,8 +2544,8 @@ PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, OPT, HOOKS ) RESULT(RET) !> Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: X TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(OUT) :: Y - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -2563,7 +2577,7 @@ PP_THREAD_SAFE FUNCTION MAXIMUM( X, Y, OPT, HOOKS ) RESULT(RET) ! Search cycle. SearchMaximum: DO WHILE(.TRUE.) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN Y => Y%RIGHT @@ -2637,12 +2651,12 @@ END FUNCTION MAXIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'SWAP_DATA' -PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: CACHED_MAPPER_COLLECTION_MOD, ONLY: CACHED_MAPPER_COLLECTION_T @@ -2660,7 +2674,7 @@ PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE_1 TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE_2 - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -2689,7 +2703,7 @@ PP_THREAD_SAFE FUNCTION SWAP_DATA( NODE_1, NODE_2, OPT, HOOKS ) RESULT(RET) PP_SET_ERR_SUCCESS( RET ) ! Swapping keys between two nodes - PP_TRYCALL(ERRFLAG_SWAP_KEYS) NODE_1%KEY%SWAP_DATA( NODE_2%KEY, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_SWAP_KEYS) NODE_1%KEY%SWAP_DATA( NODE_2%KEY, CACHE_OPT, HOOKS ) ! Swapping values between two nodes MAPPERS => NODE_1%MAPPERS_ @@ -2763,13 +2777,14 @@ END FUNCTION SWAP_DATA !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'REMOVE_NODE' -PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, CACHE_OPT, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -2785,8 +2800,9 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: Z - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -2825,19 +2841,19 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) Y => NULL() ! Remove the node - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF_LEFT, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF_RIGHT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF_LEFT, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%RIGHT, IS_LEAF_RIGHT, CACHE_OPT, HOOKS ) IF ( IS_LEAF_LEFT .OR. IS_LEAF_RIGHT ) THEN Y => Z ELSE - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SUCESSOR) SUCCESSOR( Z, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SUCESSOR) SUCCESSOR( Z, Y, CACHE_OPT, HOOKS ) ENDIF - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN X => Y%LEFT @@ -2857,7 +2873,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) ELSE - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( X, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN X%PARENT => Y%PARENT @@ -2866,7 +2882,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) ENDIF - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%PARENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( Y%PARENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( IS_LEAF ) THEN ROOT => X @@ -2891,7 +2907,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) IF ( .NOT.ASSOCIATED( Z, Y ) ) THEN ! Copy data. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SWAP_DATA) SWAP_DATA( Y, Z, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SWAP_DATA) SWAP_DATA( Y, Z, CACHE_OPT, HOOKS ) ENDIF @@ -2900,14 +2916,14 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE( ROOT, Z, OPT, HOOKS ) RESULT(RET) IF ( .NOT.Y%RED ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_FIXUP) REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_FIXUP) REMOVE_NODE_FIXUP( ROOT, X, CACHE_OPT, HOOKS ) ENDIF ENDIF ! Free memory. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_DEALLOCATE_NODE) DEALLOCATE_NODE( Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_DEALLOCATE_NODE) DEALLOCATE_NODE( Y, CACHE_OPT, MAPPING_OPT, HOOKS ) Y => NULL() ! Trace end of procedure (on success) @@ -2982,12 +2998,12 @@ END FUNCTION REMOVE_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'REMOVE_NODE_FIXUP' -PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3003,8 +3019,8 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: X - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -3050,14 +3066,14 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) X%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, CACHE_OPT, HOOKS ) W => X%PARENT%RIGHT ENDIF ! Check if current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) IF ( ( .NOT.W%LEFT%RED ) .AND. ( .NOT.W%RIGHT%RED ) ) THEN @@ -3073,7 +3089,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, W, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, W, CACHE_OPT, HOOKS ) W => X%PARENT%RIGHT @@ -3085,7 +3101,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%RIGHT%RED = .FALSE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT(ROOT, X%PARENT, CACHE_OPT, HOOKS ) X => ROOT @@ -3101,14 +3117,14 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) X%PARENT%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT(ROOT, X%PARENT, CACHE_OPT, HOOKS ) W => X%PARENT%LEFT ENDIF ! Check if current node is a leaf - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( W, IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( IS_LEAF, ERRFLAG_NODE_IS_LEAF ) IF ( .NOT.W%RIGHT%RED .AND. .NOT.W%LEFT%RED ) THEN @@ -3125,7 +3141,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%RED = .TRUE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, W, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_LEFT) ROTATE_LEFT( ROOT, W, CACHE_OPT, HOOKS ) W => X%PARENT%LEFT @@ -3137,7 +3153,7 @@ PP_THREAD_SAFE FUNCTION REMOVE_NODE_FIXUP( ROOT, X, OPT, HOOKS ) RESULT(RET) W%LEFT%RED = .FALSE. - PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_ROTATE_RIGHT) ROTATE_RIGHT( ROOT, X%PARENT, CACHE_OPT, HOOKS ) X => ROOT @@ -3220,12 +3236,12 @@ END FUNCTION REMOVE_NODE_FIXUP !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'LIST_NODE' -RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3241,11 +3257,11 @@ RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RES ! Dummy arguments TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT - INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT - INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT - CHARACTER(LEN=*), INTENT(IN) :: PREFIX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT + INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT + CHARACTER(LEN=*), INTENT(IN) :: PREFIX + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -3278,10 +3294,10 @@ RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RES PP_SET_ERR_SUCCESS( RET ) ! First node in the list. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) LIST_NODE( ROOT, CURRENT%LEFT, CNT, UNIT, PREFIX, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) LIST_NODE( ROOT, CURRENT%LEFT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) CNT = CNT + 1 WRITE(CKEY,*,IOSTAT=WRITE_STATUS) CURRENT%KEY @@ -3292,7 +3308,7 @@ RECURSIVE FUNCTION LIST_NODE( ROOT, CURRENT, CNT, UNIT, PREFIX, OPT, HOOKS ) RES PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) LIST_NODE( ROOT, CURRENT%RIGHT, CNT, UNIT, PREFIX,OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) LIST_NODE( ROOT, CURRENT%RIGHT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) ENDIF @@ -3361,12 +3377,12 @@ END FUNCTION LIST_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'FUNCTION_NODE' -RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3383,8 +3399,8 @@ RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, OPT, HOOKS ) RESULT( TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT PROCEDURE(FUNCTION_MAPPING_CACHE_IF), POINTER, INTENT(IN) :: PFUNCTION - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -3416,12 +3432,12 @@ RECURSIVE FUNCTION FUNCTION_NODE( ROOT, CURRENT, PFUNCTION, OPT, HOOKS ) RESULT( PP_SET_ERR_SUCCESS( RET ) ! First node in the list. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%LEFT, PFUNCTION, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTION_ERROR) PFUNCTION( CURRENT%KEY, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%RIGHT, PFUNCTION, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%LEFT, PFUNCTION, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTION_ERROR) PFUNCTION( CURRENT%KEY, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTION_NODE( ROOT, CURRENT%RIGHT, PFUNCTION, CACHE_OPT, HOOKS ) ENDIF @@ -3490,12 +3506,12 @@ END FUNCTION FUNCTION_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'FUNCTOR_NODE' -RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3512,8 +3528,8 @@ RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, OPT, HOOKS ) RESULT(RET TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: ROOT TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(IN) :: CURRENT CLASS(FUNCTOR_MAPPING_CACHE_A), POINTER, INTENT(IN) :: FUNCTOR - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -3545,12 +3561,12 @@ RECURSIVE FUNCTION FUNCTOR_NODE( ROOT, CURRENT, FUNCTOR, OPT, HOOKS ) RESULT(RET PP_SET_ERR_SUCCESS( RET ) ! First node in the list. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( CURRENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%LEFT, FUNCTOR, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTOR_ERROR) FUNCTOR%APPLY( CURRENT%KEY, OPT, HOOKS ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%RIGHT, FUNCTOR, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LEFT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%LEFT, FUNCTOR, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_CALL_MAP_FUNCTOR_ERROR) FUNCTOR%APPLY( CURRENT%KEY, CACHE_OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RIGHT_SUBTREE) FUNCTOR_NODE( ROOT, CURRENT%RIGHT, FUNCTOR, CACHE_OPT, HOOKS ) ENDIF @@ -3619,12 +3635,12 @@ END FUNCTION FUNCTOR_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'RENUMBER_NODE' -RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3638,10 +3654,10 @@ RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) IMPLICIT NONE ! Dummy arguments - TYPE(MAPPING_CACHE_NODE_T), INTENT(INOUT) :: ROOT - INTEGER(KIND=JPIB_K), INTENT(INOUT) :: IDX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(MAPPING_CACHE_NODE_T), INTENT(INOUT) :: ROOT + INTEGER(KIND=JPIB_K), INTENT(INOUT) :: IDX + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS !> Function result INTEGER(KIND=JPIB_K) :: RET @@ -3669,15 +3685,15 @@ RECURSIVE FUNCTION RENUMBER_NODE( ROOT, IDX, OPT, HOOKS ) RESULT(RET) PP_SET_ERR_SUCCESS( RET ) ! Renumber left subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%LEFT, IDX, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%LEFT, IDX, CACHE_OPT, HOOKS ) ENDIF ! Renumber right subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%RIGHT, IDX, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( ROOT%RIGHT, IDX, CACHE_OPT, HOOKS ) ENDIF ! Renumber the current node @@ -3746,12 +3762,12 @@ END FUNCTION RENUMBER_NODE !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'NODE_WRITE_CONNECTIVITY' -RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3765,10 +3781,10 @@ RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) IMPLICIT NONE ! Dummy arguments - TYPE(MAPPING_CACHE_NODE_T), INTENT(INOUT) :: ROOT - INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(MAPPING_CACHE_NODE_T), INTENT(INOUT) :: ROOT + INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -3798,20 +3814,20 @@ RECURSIVE FUNCTION NODE_WRITE_CONNECTIVITY( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) PP_SET_ERR_SUCCESS( RET ) ! Write connectivity of the left subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%LEFT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%LEFT, UNIT, CACHE_OPT, HOOKS ) ENDIF ! Write connectivity of the right subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT.IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%RIGHT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( ROOT%RIGHT, UNIT, CACHE_OPT, HOOKS ) ENDIF ! Write connectivity of the current node IF ( ASSOCIATED(ROOT%PARENT) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%PARENT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%PARENT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. IS_LEAF ) THEN WRITE(UNIT,'(I6.6,A,I6.6)',IOSTAT=WRITE_STATUS) ROOT%PARENT%IDX, '->', ROOT%IDX PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS.NE.0, ERRFLAG_WRITE_ERROR ) @@ -3882,12 +3898,12 @@ END FUNCTION NODE_WRITE_CONNECTIVITY !> #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'WRITE_NODE' -RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -3902,9 +3918,9 @@ RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) ! Dummy arguments CLASS(MAPPING_CACHE_NODE_T), INTENT(INOUT) :: ROOT - INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -3935,15 +3951,15 @@ RECURSIVE FUNCTION WRITE_NODE( ROOT, UNIT, OPT, HOOKS ) RESULT(RET) PP_SET_ERR_SUCCESS( RET ) ! Write nodes in the left subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%LEFT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. ASSOCIATED( ROOT%LEFT, NIL ) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%LEFT, UNIT,OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%LEFT, UNIT,CACHE_OPT, HOOKS ) ENDIF ! Write nodes in the right subtree - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( ROOT%RIGHT, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. ASSOCIATED( ROOT%RIGHT, NIL ) ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%RIGHT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( ROOT%RIGHT, UNIT, CACHE_OPT, HOOKS ) ENDIF ! Write the current key @@ -4014,13 +4030,13 @@ END FUNCTION WRITE_NODE #define PP_PROCEDURE_TYPE 'RECURSIVE FUNCTION' #define PP_PROCEDURE_NAME 'GET_SORTED_KEYS_INT_NODE' -RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RESULT(RET) +RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4034,10 +4050,10 @@ RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RE IMPLICIT NONE ! Dummy arguments - TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE + TYPE(MAPPING_CACHE_NODE_T), POINTER, INTENT(INOUT) :: NODE TYPE(FORTRAN_MESSAGE_T), DIMENSION(:), INTENT(INOUT) :: SORTED_KEYS INTEGER(KIND=JPIB_K), INTENT(INOUT) :: CNT - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4069,16 +4085,16 @@ RECURSIVE FUNCTION GET_SORTED_KEYS_NODE( NODE, SORTED_KEYS, CNT, OPT, HOOKS ) RE PP_SET_ERR_SUCCESS( RET ) ! Remove the map if it is not empty. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( NODE, IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( NODE, IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. IS_LEAF ) THEN - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%LEFT, SORTED_KEYS, CNT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%LEFT, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) CNT = CNT + 1 PP_DEBUG_CRITICAL_COND_THROW( CNT.GT.SIZE(SORTED_KEYS), ERRFLAG_OUT_OF_BOUNDS ) SORTED_KEYS(CNT) = NODE%KEY - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%RIGHT, SORTED_KEYS, CNT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( NODE%RIGHT, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) ENDIF @@ -4145,12 +4161,12 @@ END FUNCTION GET_SORTED_KEYS_NODE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_INIT' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_INIT( ENCODERS_MAP, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_INIT( ENCODERS_MAP, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4164,9 +4180,9 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_INIT( ENCODERS_MAP, OPT, HOOKS ) RESULT(RE IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4210,12 +4226,13 @@ END FUNCTION MAPPING_CACHE_INIT !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_FREE' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_FREE( ENCODERS_MAP, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_FREE( ENCODERS_MAP, CACHE_OPT, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4229,9 +4246,10 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_FREE( ENCODERS_MAP, OPT, HOOKS ) RESULT(RE IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4259,12 +4277,12 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_FREE( ENCODERS_MAP, OPT, HOOKS ) RESULT(RE IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN ! Recursive deletion of the tree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FREE) FREE_NODE( ENCODERS_MAP%ROOT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FREE) FREE_NODE( ENCODERS_MAP%ROOT, CACHE_OPT, MAPPING_OPT, HOOKS ) ENDIF ! Reset the initial condition. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_INIT) ENCODERS_MAP%INIT( OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_INIT) ENCODERS_MAP%INIT( CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -4324,12 +4342,12 @@ END FUNCTION MAPPING_CACHE_FREE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_MINIMUM' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MINIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MINIMUM( ENCODERS_MAP, KEY, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -4346,10 +4364,10 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MINIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) R IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4379,7 +4397,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MINIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) R IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN ! Recursive deletion of the tree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( ENCODERS_MAP%ROOT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MINIMUM( ENCODERS_MAP%ROOT, Y, CACHE_OPT, HOOKS ) KEY = Y%KEY @@ -4441,12 +4459,13 @@ END FUNCTION MAPPING_CACHE_MINIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_MAXIMUM' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T !> Templated use USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -4463,10 +4482,10 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) R IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP - TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + TYPE(FORTRAN_MESSAGE_T), INTENT(OUT) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4496,7 +4515,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MAXIMUM( ENCODERS_MAP, KEY, OPT, HOOKS ) R IF ( ENCODERS_MAP%SIZE .GT. 0 ) THEN ! Recursive deletion of the tree. - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MAXIMUM( ENCODERS_MAP%ROOT, Y, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_MINIMUM) MAXIMUM( ENCODERS_MAP%ROOT, Y, CACHE_OPT, HOOKS ) KEY = Y%KEY @@ -4558,13 +4577,13 @@ END FUNCTION MAPPING_CACHE_MAXIMUM !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_GET_SORTED_KEYS' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEYS, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEYS, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4577,9 +4596,9 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEYS IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: ENCODERS_MAP TYPE(FORTRAN_MESSAGE_T), DIMENSION(:), INTENT(INOUT) :: SORTED_KEYS - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result @@ -4617,7 +4636,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_GET_SORTED_KEYS( ENCODERS_MAP, SORTED_KEYS ! Recursive deletion of the tree. CNT = 0 - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( ENCODERS_MAP%ROOT, SORTED_KEYS, CNT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_GET_SORTED_KEYS_NODE) GET_SORTED_KEYS_NODE( ENCODERS_MAP%ROOT, SORTED_KEYS, CNT, CACHE_OPT, HOOKS ) ENDIF ! Trace end of procedure (on success) @@ -4684,7 +4703,7 @@ END FUNCTION MAPPING_CACHE_GET_SORTED_KEYS #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_ACCESS_OR_CREATE' PP_THREAD_SAFE FUNCTION MAPPING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, MAPPING_RULES, & -& MAPPERS, OPT, FILTER_OPT, HOOKS ) RESULT(RET) +& MAPPERS, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K @@ -4693,7 +4712,8 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, MAPPING_ USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: CACHED_MAPPER_COLLECTION_MOD, ONLY: CACHED_MAPPER_COLLECTION_T USE :: MAPPING_RULES_COLLECTION_MOD, ONLY: MAPPING_RULES_COLLECTION_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes @@ -4713,7 +4733,8 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, MAPPING_ TYPE(PARAMETRIZATION_T), INTENT(IN) :: PAR TYPE(MAPPING_RULES_COLLECTION_T), INTENT(IN) :: MAPPING_RULES TYPE(CACHED_MAPPER_COLLECTION_T), POINTER, INTENT(OUT) :: MAPPERS - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -4743,7 +4764,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_ACCESS_OR_CREATE( THIS, KEY, PAR, MAPPING_ ! Call the routine to insert a node in the map PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_INSERT_NODE) ACCESS_OR_CREATE_NODE( THIS%ROOT, KEY, PAR, & -& MAPPING_RULES, MAPPERS, INSERTED, OPT, FILTER_OPT, HOOKS ) +& MAPPING_RULES, MAPPERS, INSERTED, CACHE_OPT, MAPPING_OPT, FILTER_OPT, HOOKS ) ! Update the number of elements in the map IF ( INSERTED ) THEN @@ -4811,13 +4832,13 @@ END FUNCTION MAPPING_CACHE_ACCESS_OR_CREATE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_MATCH' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MATCH( THIS, KEY, CACHE_OPT, LMATCH, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4831,11 +4852,11 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RES IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - LOGICAL, INTENT(OUT) :: LMATCH - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + LOGICAL, INTENT(OUT) :: LMATCH + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4863,7 +4884,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RES ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( ROOT_IS_LEAF ) THEN LMATCH = .FALSE. @@ -4872,7 +4893,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_MATCH( THIS, KEY, OPT, LMATCH, HOOKS ) RES ! Search the node in the map SEARCHED_NODE => NIL - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, OPT, LMATCH, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, CACHE_OPT, LMATCH, HOOKS ) ENDIF ! Trace end of procedure (on success) @@ -4936,13 +4957,14 @@ END FUNCTION MAPPING_CACHE_MATCH !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_REMOVE' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_REMOVE( THIS, KEY, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_REMOVE( THIS, KEY, CACHE_OPT, MAPPING_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T + USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -4956,10 +4978,11 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_REMOVE( THIS, KEY, OPT, HOOKS ) RESULT(RET IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS - TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS + TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: KEY + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -4990,17 +5013,17 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_REMOVE( THIS, KEY, OPT, HOOKS ) RESULT(RET ! Initialization of good path return value PP_SET_ERR_SUCCESS( RET ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( ROOT_IS_LEAF, ERRFLAG_MAP_IS_EMPTY ) ! Search the node in the map SEARCHED_NODE => NIL - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, OPT, LMATCH, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_SEARCH) SEARCH_NODE( THIS%ROOT, SEARCHED_NODE, KEY, CACHE_OPT, LMATCH, HOOKS ) !> If node is found then removve it IF ( LMATCH ) THEN !> Remove the node from the map - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_NODE) REMOVE_NODE( THIS%ROOT, SEARCHED_NODE, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_REMOVE_NODE) REMOVE_NODE( THIS%ROOT, SEARCHED_NODE, CACHE_OPT, MAPPING_OPT, HOOKS ) THIS%SIZE = THIS%SIZE - 1 ENDIF @@ -5070,12 +5093,12 @@ END FUNCTION MAPPING_CACHE_REMOVE !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_LIST' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_LIST( THIS, UNIT, PREFIX, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_LIST( THIS, UNIT, PREFIX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5089,11 +5112,11 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_LIST( THIS, UNIT, PREFIX, OPT, HOOKS ) RES IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS - INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT - CHARACTER(LEN=*), INTENT(IN) :: PREFIX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS + INTEGER(KIND=JPIB_K), INTENT(IN) :: UNIT + CHARACTER(LEN=*), INTENT(IN) :: PREFIX + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -5121,7 +5144,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_LIST( THIS, UNIT, PREFIX, OPT, HOOKS ) RES ! Call the recursive writing CNT = 0_JPIB_K - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LIST_NODE) LIST_NODE( THIS%ROOT, THIS%ROOT, CNT, UNIT, PREFIX, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_LIST_NODE) LIST_NODE( THIS%ROOT, THIS%ROOT, CNT, UNIT, PREFIX, CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -5183,12 +5206,12 @@ END FUNCTION MAPPING_CACHE_LIST !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_APPLY_FUNCTION' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5204,8 +5227,8 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, OPT, HOOKS ! Dummy arguments CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS PROCEDURE(FUNCTION_MAPPING_CACHE_IF), POINTER, INTENT(IN) :: FUNCTION - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -5229,7 +5252,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTION( THIS, FUNCTION, OPT, HOOKS PP_SET_ERR_SUCCESS( RET ) PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FUNCTION_NODE) FUNCTION_NODE( THIS%ROOT, & -& THIS%ROOT, FUNCTION, OPT, HOOKS ) +& THIS%ROOT, FUNCTION, CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -5290,12 +5313,12 @@ END FUNCTION MAPPING_CACHE_APPLY_FUNCTION !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_APPLY_FUNCTOR' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5311,8 +5334,8 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, OPT, HOOKS ) ! Dummy arguments CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS CLASS(FUNCTOR_MAPPING_CACHE_A), POINTER, INTENT(IN) :: FUNCTOR - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -5336,7 +5359,7 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_APPLY_FUNCTOR( THIS, FUNCTOR, OPT, HOOKS ) PP_SET_ERR_SUCCESS( RET ) PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_FUNCTOR_NODE) FUNCTOR_NODE( THIS%ROOT, & -& THIS%ROOT, FUNCTOR, OPT, HOOKS ) +& THIS%ROOT, FUNCTOR, CACHE_OPT, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -5398,12 +5421,12 @@ END FUNCTION MAPPING_CACHE_APPLY_FUNCTOR !> #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAPPING_CACHE_PRINT' -PP_THREAD_SAFE FUNCTION MAPPING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESULT(RET) +PP_THREAD_SAFE FUNCTION MAPPING_CACHE_PRINT( THIS, NAME, IDX, CACHE_OPT, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K + USE :: HOOKS_MOD, ONLY: HOOKS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -5417,11 +5440,11 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESUL IMPLICIT NONE ! Dummy arguments - CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS - CHARACTER(LEN=*), INTENT(IN) :: NAME - INTEGER(KIND=JPIB_K), INTENT(IN) :: IDX - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT - TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS + CLASS(MAPPING_CACHE_T), INTENT(INOUT) :: THIS + CHARACTER(LEN=*), INTENT(IN) :: NAME + INTEGER(KIND=JPIB_K), INTENT(IN) :: IDX + TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPT + TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS ! Function result INTEGER(KIND=JPIB_K) :: RET @@ -5459,11 +5482,11 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESUL PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) UNIT = 0 - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( THIS%ROOT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_RENUMBER_NODE) RENUMBER_NODE( THIS%ROOT, UNIT, CACHE_OPT, HOOKS ) UNIT=131 - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_ISLEAF) NODE_ISLEAF( THIS%ROOT, ROOT_IS_LEAF, CACHE_OPT, HOOKS ) IF ( .NOT. ROOT_IS_LEAF ) THEN OPEN(unit=unit, file=TRIM(FNAME), action='write',IOSTAT=WRITE_STATUS ) PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) @@ -5477,14 +5500,14 @@ PP_THREAD_SAFE FUNCTION MAPPING_CACHE_PRINT( THIS, NAME, IDX, OPT, HOOKS ) RESUL PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '// Nodes' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( THIS%ROOT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_NODE) WRITE_NODE( THIS%ROOT, UNIT, CACHE_OPT, HOOKS ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '// Connectivity' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) - PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( THIS%ROOT, UNIT, OPT, HOOKS ) + PP_TRYCALL(ERRFLAG_UNABLE_TO_CALL_WRITE_CONNECTIVITY) NODE_WRITE_CONNECTIVITY( THIS%ROOT, UNIT, CACHE_OPT, HOOKS ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '' PP_DEBUG_CRITICAL_COND_THROW( WRITE_STATUS .NE. 0, ERRFLAG_UNABLE_TO_WRITE_FILE ) WRITE(UNIT,'(A)',IOSTAT=WRITE_STATUS) '}' diff --git a/src/multiom/mapping-rules/mapping_options_mod.F90 b/src/multiom/mapping-rules/mapping_options_mod.F90 new file mode 100644 index 00000000..4828c275 --- /dev/null +++ b/src/multiom/mapping-rules/mapping_options_mod.F90 @@ -0,0 +1,43 @@ +!> @file map_mod.F90 +!> +!> @brief Module containing the implementation of a Red Black tree. +!> +!> Implementation of a Red Black tree. +!> Every routine in this file is deeply explained in the book: +!> "Introduction to Algorithms" +!> { Thomas H. Cormen, Charles E. Leiserson, Ronald L. Rivest, Clifford Stein} +!> +!> @todo improve error handling +!> +!> @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" + +! Definition of the module +#define PP_FILE_NAME 'mapping_options_mod.F90' +#define PP_SECTION_TYPE 'MODULE' +#define PP_SECTION_NAME 'MAPPING_OPTIONS_MOD' +MODULE MAPPING_OPTIONS_MOD + +IMPLICIT NONE + +!> @brief Default visibility of the module +PRIVATE + +TYPE :: MAPPING_OPTIONS_T + LOGICAL :: ENABLE_MAPPING = .FALSE. +END TYPE + +!> Whitelist of public symbols +PUBLIC :: MAPPING_OPTIONS_T + +END MODULE MAPPING_OPTIONS_MOD +#undef PP_SECTION_NAME +#undef PP_SECTION_TYPE +#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/multiom/mapping-rules/mapping_utils_mod.F90 b/src/multiom/mapping-rules/mapping_utils_mod.F90 index e29a3387..b0d449a2 100644 --- a/src/multiom/mapping-rules/mapping_utils_mod.F90 +++ b/src/multiom/mapping-rules/mapping_utils_mod.F90 @@ -39,12 +39,12 @@ MODULE MAPPING_UTILS_MOD #define PP_PROCEDURE_TYPE 'FUNCTION' #define PP_PROCEDURE_NAME 'MAKE_MAPPERS_COLLECTION' PP_THREAD_SAFE FUNCTION MAKE_MAPPERS_COLLECTION( MSG, PAR, & - MAPPING_RULES, OPT, FILTER_OPT, MAPPERS_COLLECTION, HOOKS ) RESULT(RET) + MAPPING_RULES, MAPPING_OPT, FILTER_OPT, MAPPERS_COLLECTION, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T @@ -67,7 +67,7 @@ PP_THREAD_SAFE FUNCTION MAKE_MAPPERS_COLLECTION( MSG, PAR, & TYPE(FORTRAN_MESSAGE_T), INTENT(IN) :: MSG TYPE(PARAMETRIZATION_T), INTENT(IN) :: PAR TYPE(MAPPING_RULES_COLLECTION_T), INTENT(IN) :: MAPPING_RULES - TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: OPT + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPT TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPT TYPE(CACHED_MAPPER_COLLECTION_T), INTENT(OUT) :: MAPPERS_COLLECTION TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS diff --git a/src/multiom/multiom_cached_encoder_mod.F90 b/src/multiom/multiom_cached_encoder_mod.F90 index a0b8231c..d0e10ce9 100644 --- a/src/multiom/multiom_cached_encoder_mod.F90 +++ b/src/multiom/multiom_cached_encoder_mod.F90 @@ -34,6 +34,7 @@ MODULE MULTIOM_CACHED_ENCODER_MOD USE :: ENCODING_CACHE_MOD, ONLY: ENCODING_CACHE_T USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T IMPLICIT NONE @@ -61,6 +62,7 @@ MODULE MULTIOM_CACHED_ENCODER_MOD !> Options TYPE(CACHE_OPTIONS_T) :: CACHE_OPTIONS TYPE(GRIB_ENCODER_OPTIONS_T) :: ENCODER_OPTIONS + TYPE(MAPPING_OPTIONS_T) :: MAPPING_OPTIONS TYPE(FILTER_OPTIONS_T) :: FILTER_OPTIONS CONTAINS @@ -83,7 +85,8 @@ MODULE MULTIOM_CACHED_ENCODER_MOD #define PP_PROCEDURE_NAME 'MULTIO_ENCODER_INIT' PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & & MAPPING_FNAME, ENCODER_FNAME, METADATA, & -& CACHE_OPTIONS, ENCODER_OPTIONS, FILTER_OPTIONS, HOOKS ) RESULT(RET) +& CACHE_OPTIONS, ENCODER_OPTIONS, MAPPING_OPTIONS, FILTER_OPTIONS, & +& HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K @@ -94,6 +97,11 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_NEW_CONFIGURATION_FROM_FILE USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T + ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -112,6 +120,7 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA TYPE(CACHE_OPTIONS_T), INTENT(IN) :: CACHE_OPTIONS TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPTIONS TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPTIONS TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -157,6 +166,11 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & INQUIRE( FILE=TRIM(ADJUSTL(MAPPING_FNAME)), EXIST=FEXIST ) PP_DEBUG_CRITICAL_COND_THROW( .NOT. FEXIST, ERRFLAG_MAPPING_CFG_FILE_DOES_NOT_EXIST ) + ! Copy options + THIS%ENCODER_OPTIONS = ENCODER_OPTIONS + THIS%FILTER_OPTIONS = FILTER_OPTIONS + THIS%CACHE_OPTIONS = CACHE_OPTIONS + THIS%MAPPING_OPTIONS = MAPPING_OPTIONS !> Open the configuration file PP_TRYCALL(ERRFLAG_UNABLE_TO_CLONE_METADATA) MAKE_METADATA( METADATA, THIS%METADATA, HOOKS ) @@ -195,11 +209,6 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & PP_TRYCALL(ERRFLAG_MAPPING_RULE_DELETE_ERROR) YAML_DELETE_CONFIGURATION( & & MAPPING_CONFIG, HOOKS ) - - ! Initialize the caches - PP_TRYCALL(ERRFLAG_MAPPING_CACHE_INIT) THIS%MAPPING_CACHE%INIT( THIS%ENCODER_OPTIONS, HOOKS ) - PP_TRYCALL(ERRFLAG_ENCODER_CACHE_INIT) THIS%ENCODER_CACHE%INIT( THIS%ENCODER_OPTIONS, HOOKS ) - ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() @@ -349,7 +358,7 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_ENCODE( THIS, & !> Encode the message MAPPER => NULL() PP_TRYCALL(ERRFLAG_MAPPING_CACHE_INIT) THIS%MAPPING_CACHE%ACCESS_OR_CREATE( MSG, PAR, & - & THIS%MAPPING_RULES, MAPPER, THIS%ENCODER_OPTIONS, THIS%FILTER_OPTIONS, HOOKS ) + & THIS%MAPPING_RULES, MAPPER, THIS%CACHE_OPTIONS, THIS%MAPPING_OPTIONS, THIS%FILTER_OPTIONS, HOOKS ) PP_DEBUG_CRITICAL_COND_THROW( .NOT. ASSOCIATED(MAPPER), ERRFLAG_MAPPING_CACHE_INIT ) !> Read the size of the mappers @@ -369,7 +378,7 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_ENCODE( THIS, & !> Encode the message PP_TRYCALL(ERRFLAG_ENCODER_CACHE_INIT) THIS%ENCODER_CACHE%ACCESS_OR_CREATE( & & MAPPED_MSG, MAPPED_PAR, THIS%METADATA, THIS%ENCODER_RULES, ENCODERS, & -& THIS%ENCODER_OPTIONS, HOOKS ) +& THIS%CACHE_OPTIONS, THIS%ENCODER_OPTIONS, THIS%FILTER_OPTIONS, HOOKS ) !> Read the size of the encoders PP_TRYCALL(ERRFLAG_ENCODER_CACHE_INIT) ENCODERS%SIZE( ENCODER_SZ, THIS%ENCODER_OPTIONS, HOOKS ) @@ -614,12 +623,12 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_FREE( THIS, HOOKS ) RESULT(RET) PP_TRYCALL(ERRFLAG_METADATA_FREE) DESTROY_METADATA( THIS%METADATA, HOOKS ) ! Deallocate all the rules - PP_TRYCALL(ERRFLAG_ENCODER_CACHE_FREE) THIS%ENCODER_RULES%FREE( THIS%ENCODER_OPTIONS, HOOKS ) - PP_TRYCALL(ERRFLAG_ENCODER_RULES_FREE) THIS%ENCODER_CACHE%FREE( THIS%ENCODER_OPTIONS, HOOKS ) + PP_TRYCALL(ERRFLAG_ENCODER_CACHE_FREE) THIS%ENCODER_RULES%FREE( THIS%ENCODER_OPTIONS, HOOKS ) + PP_TRYCALL(ERRFLAG_ENCODER_RULES_FREE) THIS%ENCODER_CACHE%FREE( THIS%CACHE_OPTIONS, THIS%ENCODER_OPTIONS, HOOKS ) !> Read the intop configuration PP_TRYCALL(ERRFLAG_MAPPING_RULES_FREE) THIS%MAPPING_RULES%FREE( HOOKS ) - PP_TRYCALL(ERRFLAG_MAPPING_CACHE_FREE) THIS%MAPPING_CACHE%FREE( THIS%ENCODER_OPTIONS, HOOKS ) + PP_TRYCALL(ERRFLAG_MAPPING_CACHE_FREE) THIS%MAPPING_CACHE%FREE( THIS%CACHE_OPTIONS, THIS%MAPPING_OPTIONS, HOOKS ) ! Trace end of procedure (on success) PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS() diff --git a/src/multiom/multiom_encoder_mod.F90 b/src/multiom/multiom_encoder_mod.F90 index a9b222b4..9f963934 100644 --- a/src/multiom/multiom_encoder_mod.F90 +++ b/src/multiom/multiom_encoder_mod.F90 @@ -32,6 +32,7 @@ MODULE MULTIOM_ENCODER_MOD USE :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T IMPLICIT NONE @@ -54,6 +55,7 @@ MODULE MULTIOM_ENCODER_MOD !> Options TYPE(GRIB_ENCODER_OPTIONS_T) :: ENCODER_OPTIONS TYPE(FILTER_OPTIONS_T) :: FILTER_OPTIONS + TYPE(MAPPING_OPTIONS_T) :: MAPPING_OPTIONS CONTAINS @@ -75,7 +77,7 @@ MODULE MULTIOM_ENCODER_MOD #define PP_PROCEDURE_NAME 'MULTIO_ENCODER_INIT' PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & & MAPPING_FNAME, ENCODER_FNAME, METADATA, & -& ENCODER_OPTIONS, FILTER_OPTIONS, HOOKS ) RESULT(RET) +& ENCODER_OPTIONS, MAPPING_OPTIONS, FILTER_OPTIONS, HOOKS ) RESULT(RET) ! Symbols imported from other modules within the project. USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K @@ -86,6 +88,10 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_NEW_CONFIGURATION_FROM_FILE USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION + USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T + USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T + ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -103,6 +109,7 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_INIT( THIS, & CHARACTER(LEN=*), INTENT(IN) :: ENCODER_FNAME CLASS(METADATA_BASE_A), POINTER, INTENT(IN) :: METADATA TYPE(GRIB_ENCODER_OPTIONS_T), INTENT(IN) :: ENCODER_OPTIONS + TYPE(MAPPING_OPTIONS_T), INTENT(IN) :: MAPPING_OPTIONS TYPE(FILTER_OPTIONS_T), INTENT(IN) :: FILTER_OPTIONS TYPE(HOOKS_T), INTENT(INOUT) :: HOOKS @@ -337,7 +344,7 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_ENCODE( THIS, & !> Encode the message MAPPER => NULL() PP_TRYCALL(ERRFLAG_MAPPING_CACHE_INIT) MAKE_MAPPERS_COLLECTION( & -& MSG, PAR, THIS%MAPPING_RULES, THIS%ENCODER_OPTIONS, THIS%FILTER_OPTIONS, MAPPER, HOOKS ) +& MSG, PAR, THIS%MAPPING_RULES, THIS%MAPPING_OPTIONS, THIS%FILTER_OPTIONS, MAPPER, HOOKS ) !> Read the size of the mappers PP_TRYCALL(ERRFLAG_ENCODER_CACHE_INIT) MAPPER%SIZE( MAPPING_SZ, HOOKS) @@ -354,7 +361,7 @@ PP_THREAD_SAFE FUNCTION MULTIO_ENCODER_ENCODE( THIS, & & MSG, PAR, MAPPED_MSG, MAPPED_PAR, HOOKS ) PP_TRYCALL(ERRFLAG_ENCODER_CACHE_INIT) MAKE_ENCODER_COLLECTION( & -& MSG, PAR, THIS%METADATA, THIS%ENCODER_RULES, THIS%ENCODER_OPTIONS, ENCODERS, HOOKS ) +& MSG, PAR, THIS%METADATA, THIS%ENCODER_RULES, THIS%ENCODER_OPTIONS, THIS%FILTER_OPTIONS, ENCODERS, HOOKS ) !> Read the size of the encoders PP_TRYCALL(ERRFLAG_ENCODER_CACHE_INIT) ENCODERS%SIZE( ENCODER_SZ, THIS%ENCODER_OPTIONS, HOOKS ) diff --git a/src/multiom/test/test_read01_prog.F90 b/src/multiom/test/test_read01_prog.F90.old similarity index 100% rename from src/multiom/test/test_read01_prog.F90 rename to src/multiom/test/test_read01_prog.F90.old diff --git a/src/multiom/test/test_read02_prog.F90 b/src/multiom/test/test_read02_prog.F90.old similarity index 100% rename from src/multiom/test/test_read02_prog.F90 rename to src/multiom/test/test_read02_prog.F90.old diff --git a/src/multiom/test/test_read03_prog.F90 b/src/multiom/test/test_read03_prog.F90.old similarity index 100% rename from src/multiom/test/test_read03_prog.F90 rename to src/multiom/test/test_read03_prog.F90.old diff --git a/src/multiom/test/test_read04_prog.F90 b/src/multiom/test/test_read04_prog.F90.old similarity index 100% rename from src/multiom/test/test_read04_prog.F90 rename to src/multiom/test/test_read04_prog.F90.old diff --git a/src/multiom/test/test_read05_prog.F90 b/src/multiom/test/test_read05_prog.F90.old similarity index 100% rename from src/multiom/test/test_read05_prog.F90 rename to src/multiom/test/test_read05_prog.F90.old diff --git a/src/multiom/test/test_read06_prog.F90 b/src/multiom/test/test_read06_prog.F90.old similarity index 100% rename from src/multiom/test/test_read06_prog.F90 rename to src/multiom/test/test_read06_prog.F90.old diff --git a/src/multiom/test/test_read07_prog.F90 b/src/multiom/test/test_read07_prog.F90.old similarity index 100% rename from src/multiom/test/test_read07_prog.F90 rename to src/multiom/test/test_read07_prog.F90.old diff --git a/src/multiom/test/test_read08_prog.F90 b/src/multiom/test/test_read08_prog.F90.old similarity index 100% rename from src/multiom/test/test_read08_prog.F90 rename to src/multiom/test/test_read08_prog.F90.old diff --git a/src/multiom/test/test_read20_prog.F90 b/src/multiom/test/test_read20_prog.F90 deleted file mode 100644 index be738a6b..00000000 --- a/src/multiom/test/test_read20_prog.F90 +++ /dev/null @@ -1,255 +0,0 @@ -! 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 'test_read04_prog.F90' -#define PP_SECTION_TYPE 'PROGRAM' -#define PP_SECTION_NAME 'TEST_READ04_PROG' -#define PP_PROCEDURE_TYPE 'PROGRAM' -#define PP_PROCEDURE_NAME 'MAIN' -PROGRAM TEST_READ04_PROG - - !> Symbols imported from other modules within the project. - USE :: DATAKINDS_DEF_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_NEW_CONFIGURATION_FROM_FILE - 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 - USE :: YAML_CORE_UTILS_MOD, ONLY: YAML_DELETE_CONFIGURATION - - - USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T - USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T - - USE :: HOOKS_MOD, ONLY: HOOKS_T - USE :: ENCODING_RULES_FACTORY_MOD, ONLY: MAKE_ENCODING_RULES - USE :: ENCODING_RULES_FACTORY_MOD, ONLY: DESTROY_ENCODING_RULES - - - USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T - USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T - USE :: ENCODING_CACHE_MOD, ONLY: ENCODING_CACHE_T - USE :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A - USE :: CACHED_ENCODER_COLLECTION_MOD, ONLY: CACHED_ENCODER_COLLECTION_T - USE :: ENCODING_RULE_COLLECTION_MOD, ONLY: ENCODING_RULE_COLLECTION_T - USE :: METADATA_FACTORY_MOD, ONLY: MAKE_METADATA - - ! 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 - - !> Test encodr object - TYPE(HOOKS_T) :: HOOKS - TYPE(YAML_CONFIGURATION_T) :: CONFIG - INTEGER(KIND=JPIB_K) :: I - INTEGER(KIND=JPIB_K) :: SZ - INTEGER(KIND=JPIB_K) :: UNIT - INTEGER(KIND=JPIB_K) :: OFFSET - INTEGER(KIND=JPIB_K) :: RET - INTEGER(KIND=JPIB_K) :: LENGTH - LOGICAL :: HAS_ENCODING_RULES - TYPE(YAML_CONFIGURATIONS_T) :: ENCODING_RULES_CONFIGURATION - TYPE(ENCODING_RULE_COLLECTION_T) :: ENCODING_RULES - - - TYPE(FORTRAN_MESSAGE_T) :: MSG - TYPE(PARAMETRIZATION_T) :: PAR - TYPE(ENCODING_CACHE_T) :: ENCODING_CACHE - TYPE(CACHED_ENCODER_COLLECTION_T), POINTER :: ENCODERS - CLASS(METADATA_BASE_A), POINTER :: METADATA - TYPE(FILTER_OPTIONS_T) :: FILTER_OPT - TYPE(GRIB_ENCODER_OPTIONS_T) :: ENCODER_OPT - LOGICAL :: FEXIST - CHARACTER(LEN=256) :: FNAME - - ! Error codes - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_CFG_FILE_DOES_NOT_EXIST = 1_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_CFG_FILE = 2_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_CFG = 3_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_SECTIONS_UNDEFINED = 4_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_READ_SUBCFG = 5_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_MAKE_ENCODING_RULE = 6_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_DELETE_CONFIGURATIONS = 7_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_ENCODING_RULE_DEALLOCATION_ERROR = 8_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_ENCODING_RULE_PRINT_ERROR = 9_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_ENCODING_RULES_DEALLOCATION_ERROR = 10_JPIB_K - - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_INIT_ENCODER_CAHCE=11_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_FREE_ENCODER_CAHCE=12_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_AOC_ENCODER_CAHCE=13_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_LOCAL_SAMPLE=14_JPIB_K - INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_TO_SIZE_ENCODER_CAHCE=15_JPIB_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() - - ! Get the first command-line argument (index starts from 1) - FNAME = REPEAT(' ', 256) - IF ( COMMAND_ARGUMENT_COUNT() .EQ. 1 ) THEN - ! Get the first command-line argument (index starts from 1) - CALL GET_COMMAND_ARGUMENT(1, FNAME, LENGTH, RET ) - IF (RET .NE. 0) THEN - FNAME = 'config-rule.yaml' - END IF - ELSE - FNAME = 'config-rule.yaml' - END IF - - ! Inquire file existence - INQUIRE( FILE=TRIM(ADJUSTL(FNAME)), EXIST=FEXIST ) - PP_DEBUG_CRITICAL_COND_THROW( .NOT. FEXIST, ERRFLAG_CFG_FILE ) - - !> Set the unit and offset - UNIT = 6 - OFFSET = 1 - CALL HOOKS%DEBUG_HOOK_%INIT( ) - - !> Open the configuration file - PP_TRYCALL( ERRFLAG_LOCAL_SAMPLE ) MAKE_METADATA( METADATA, 'grib', 'sample', HOOKS ) - - !> Open the configuration file - PP_TRYCALL(ERRFLAG_CFG_FILE_DOES_NOT_EXIST) YAML_NEW_CONFIGURATION_FROM_FILE( TRIM(ADJUSTL(FNAME)), CONFIG, HOOKS ) - - !> Read the encoder configuration - PP_TRYCALL(ERRFLAG_UNABLE_TO_READ_CFG) ENCODING_RULES%INIT( CONFIG, FILTER_OPT, ENCODER_OPT, HOOKS ) - - !> Deallocate section configuration - PP_TRYCALL( ERRFLAG_ENCODING_RULE_DEALLOCATION_ERROR ) YAML_DELETE_CONFIGURATION( CONFIG, HOOKS ) - - !> Print all the rules - PP_TRYCALL( ERRFLAG_ENCODING_RULE_PRINT_ERROR ) ENCODING_RULES%PRINT( UNIT, OFFSET, ENCODER_OPT, HOOKS ) - - - !> Search the rules - MSG%PARAM=228057 - MSG%NUMBER=3 - MSG%LEVTYPE=7 - MSG%LEVELIST=80 - MSG%REPRES=2 - MSG%PACKING=1 - MSG%NUMBER=1 - - ! - ! Initialize encoder cahce - PP_TRYCALL(ERRFLAG_UNABLE_TO_INIT_ENCODER_CAHCE) ENCODING_CACHE%INIT( ENCODER_OPT, HOOKS ) - - !> Init message - WRITE(*,*) 'PUSH INTO CACHE' - - PP_TRYCALL(ERRFLAG_UNABLE_TO_AOC_ENCODER_CAHCE) ENCODING_CACHE%ACCESS_OR_CREATE( & -& MSG, PAR, METADATA, ENCODING_RULES, ENCODERS, & -& ENCODER_OPT, HOOKS ) - - WRITE(*,*) 'RE-PUSH TO CACHE' - - PP_TRYCALL(ERRFLAG_UNABLE_TO_AOC_ENCODER_CAHCE) ENCODING_CACHE%ACCESS_OR_CREATE( & -& MSG, PAR, METADATA, ENCODING_RULES, ENCODERS, & -& ENCODER_OPT, HOOKS ) - - WRITE(*,*) 'CACHE UPDATED' - - PP_TRYCALL(ERRFLAG_UNABLE_TO_SIZE_ENCODER_CAHCE) ENCODERS%SIZE( SZ, ENCODER_OPT, HOOKS ) - - !> Deallocate all the rules - WRITE(*,*) 'ENCODERS SIZE', SZ - - ! Deallocate all the rules - PP_TRYCALL(ERRFLAG_UNABLE_TO_FREE_ENCODER_CAHCE) ENCODING_CACHE%FREE( ENCODER_OPT, HOOKS ) - - ! Deallocate all the rules - PP_TRYCALL( ERRFLAG_ENCODING_RULES_DEALLOCATION_ERROR ) ENCODING_RULES%FREE( ENCODER_OPT, HOOKS ) - - !> Be sure we don't have any memory leaks - CALL HOOKS%DEBUG_HOOK_%FREE( ) - - !> Exit point (on success) - STOP 0 - -! Error handler -PP_ERROR_HANDLER - -#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING ) -!$omp critical(ERROR_HANDLER) - - BLOCK - - ! Error handling variables - PP_DEBUG_PUSH_FRAME() - - SELECT CASE(ERRIDX) - CASE (ERRFLAG_CFG_FILE_DOES_NOT_EXIST) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'The configuration file does not exist' ) - CASE (ERRFLAG_CFG_FILE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'The configuration file does not exist' ) - CASE (ERRFLAG_UNABLE_TO_READ_CFG) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to read the encoder configuration' ) - CASE (ERRFLAG_SECTIONS_UNDEFINED) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'The encoder configuration does not have the "rules" key' ) - CASE (ERRFLAG_UNABLE_TO_READ_SUBCFG) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to read the subconfigurations' ) - CASE (ERRFLAG_MAKE_ENCODING_RULE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to make the rules' ) - CASE (ERRFLAG_DELETE_CONFIGURATIONS) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to delete the configurations' ) - CASE (ERRFLAG_ENCODING_RULE_DEALLOCATION_ERROR) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to deallocate the rule' ) - CASE (ERRFLAG_ENCODING_RULE_PRINT_ERROR) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to print the rule' ) - CASE (ERRFLAG_ENCODING_RULES_DEALLOCATION_ERROR) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to deallocate the rules' ) - CASE (ERRFLAG_UNABLE_TO_INIT_ENCODER_CAHCE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to init the encoder cache' ) - CASE (ERRFLAG_UNABLE_TO_FREE_ENCODER_CAHCE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to free the encoder cache' ) - CASE (ERRFLAG_UNABLE_TO_AOC_ENCODER_CAHCE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to access or create the encoder cache' ) - CASE (ERRFLAG_LOCAL_SAMPLE) - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unable to make the sample metadata' ) - CASE DEFAULT - PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unknown error' ) - END SELECT - - ! Print the error stack - CALL HOOKS%DEBUG_HOOK_%PRINT_ERROR_STACK( 6_JPIB_K ) - - ! Free the error stack - CALL HOOKS%DEBUG_HOOK_%FREE( ) - - ! Write the error message and stop the program - PP_DEBUG_ABORT() - - END BLOCK - -!$omp end critical(ERROR_HANDLER) -#endif - - ! Exit point (on error) - STOP 1 - -END PROGRAM TEST_READ04_PROG -#undef PP_SECTION_NAME -#undef PP_SECTION_TYPE -#undef PP_FILE_NAME \ No newline at end of file diff --git a/src/multiom/test/test_read21_prog.F90 b/src/multiom/test/test_read21_prog.F90 index f3d68cfd..5a02efd6 100644 --- a/src/multiom/test/test_read21_prog.F90 +++ b/src/multiom/test/test_read21_prog.F90 @@ -17,6 +17,9 @@ PROGRAM TEST_READ04_PROG USE :: FILTER_OPTIONS_MOD, ONLY: FILTER_OPTIONS_T USE :: GRIB_ENCODER_OPTIONS_MOD, ONLY: GRIB_ENCODER_OPTIONS_T + USE :: MAPPING_OPTIONS_MOD, ONLY: MAPPING_OPTIONS_T + USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T + USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T USE :: METADATA_BASE_MOD, ONLY: METADATA_BASE_A @@ -24,7 +27,6 @@ PROGRAM TEST_READ04_PROG USE :: METADATA_FACTORY_MOD, ONLY: DESTROY_METADATA USE :: METADATA_LIST_MOD, ONLY: METADATA_LIST_T USE :: MULTIOM_CACHED_ENCODER_MOD, ONLY: MULTIOM_CACHED_ENCODERS_T - USE :: CACHE_UTILS_MOD, ONLY: CACHE_OPTIONS_T ! Symbols imported by the preprocessor for debugging purposes PP_DEBUG_USE_VARS @@ -51,9 +53,10 @@ PROGRAM TEST_READ04_PROG TYPE(MULTIOM_CACHED_ENCODERS_T) :: MULTIO_ENCODER ! Options - TYPE(CACHE_OPTIONS_T) :: CACHE_OPTIONS - TYPE(FILTER_OPTIONS_T) :: FILTER_OPTIONS + TYPE(CACHE_OPTIONS_T) :: CACHE_OPTIONS TYPE(GRIB_ENCODER_OPTIONS_T) :: ENCODER_OPTIONS + TYPE(MAPPING_OPTIONS_T) :: MAPPING_OPTIONS + TYPE(FILTER_OPTIONS_T) :: FILTER_OPTIONS ! Error flags INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNABLE_INITIALIZE_ENCODER = 1_JPIB_K @@ -105,7 +108,7 @@ PROGRAM TEST_READ04_PROG !> Create the encoder PP_TRYCALL(ERRFLAG_UNABLE_INITIALIZE_ENCODER) MULTIO_ENCODER%INIT( & & MAPPING_FNAME, ENCODER_FNAME, METADATA, & - & CACHE_OPTIONS, ENCODER_OPTIONS, FILTER_OPTIONS, & + & CACHE_OPTIONS, ENCODER_OPTIONS, MAPPING_OPTIONS, FILTER_OPTIONS, & & HOOKS ) !> Print the encoder