Skip to content

Commit d30fddd

Browse files
geier1993geier1993
committed
MUL-151: Initial extract mechanism
1 parent d03996b commit d30fddd

13 files changed

+864
-93
lines changed

‎src/multiom/api/CMakeLists.txt

+2-1
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ set( MULTIOM_API_MAIN_SOURCES
2020
${MULTIOM_API_DIR}/api_shared_data_mod.F90
2121
${MULTIOM_API_DIR}/api_encoder_wrapper_mod.F90
2222
${MULTIOM_API_DIR}/api_dictionary_wrapper_mod.F90
23+
${MULTIOM_API_DIR}/api_extract_metadata_c.cc
2324
)
2425

2526
# Collect source files in module2
@@ -36,4 +37,4 @@ foreach(source_file IN LISTS MULTIOM_API_SOURCES)
3637

3738
# Print the filename
3839
message("${OFFSET} - ${filename}")
39-
endforeach()
40+
endforeach()

‎src/multiom/api/api_dictionary_wrapper_mod.F90

+244
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ MODULE API_DICTIONARY_WRAPPER_MOD
2424
PUBLIC :: MULTIO_GRIB2_DICT_GET
2525
PUBLIC :: MULTIO_GRIB2_DICT_HAS
2626
PUBLIC :: MULTIO_GRIB2_DICT_ITERATE
27+
PUBLIC :: MULTIO_GRIB2_DICT_TO_YAML
2728

2829
CONTAINS
2930

@@ -2169,6 +2170,249 @@ END FUNCTION MULTIO_GRIB2_DICT_DESTROY_ITERATEOR
21692170

21702171

21712172

2173+
2174+
2175+
#define PP_PROCEDURE_TYPE 'FUNCTION'
2176+
#define PP_PROCEDURE_NAME 'MULTIO_GRIB2_DICT_TO_YAML'
2177+
PP_THREAD_SAFE FUNCTION MULTIO_GRIB2_DICT_TO_YAML( DICT, FNAME, LEN ) &
2178+
BIND(C,NAME='multio_grib2_dict_to_yaml_f') RESULT(RET)
2179+
2180+
!> Symbols imported from intrinsic modules.
2181+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_CHAR
2182+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT
2183+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR
2184+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_NULL_PTR
2185+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_ASSOCIATED
2186+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_LOC
2187+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_LONG_LONG
2188+
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_F_POINTER
2189+
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: INT64
2190+
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: ERROR_UNIT
2191+
USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: OUTPUT_UNIT
2192+
2193+
! Symbols imported from other modules within the project.
2194+
USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K
2195+
USE :: HOOKS_MOD, ONLY: HOOKS_T
2196+
USE :: MAP_INT64_MARS_DICT_MOD, ONLY: MAP_FUNCTION_INT64_MARS_DICT_IF
2197+
USE :: MAP_INT64_PAR_DICT_MOD, ONLY: MAP_FUNCTION_INT64_PAR_DICT_IF
2198+
USE :: MAP_INT64_REDUCED_GG_DICT_MOD, ONLY: MAP_FUNCTION_INT64_REDUCED_GG_DICT_IF
2199+
USE :: MAP_INT64_SH_DICT_MOD, ONLY: MAP_FUNCTION_INT64_SH_DICT_IF
2200+
USE :: API_SHARED_DATA_MOD, ONLY: MARS_DICT_TYPE_E
2201+
USE :: API_SHARED_DATA_MOD, ONLY: PAR_DICT_TYPE_E
2202+
USE :: API_SHARED_DATA_MOD, ONLY: REDUCED_GG_DICT_TYPE_E
2203+
USE :: API_SHARED_DATA_MOD, ONLY: SH_DICT_TYPE_E
2204+
USE :: API_SHARED_DATA_MOD, ONLY: SHARED_MARS_DICT_MAP
2205+
USE :: API_SHARED_DATA_MOD, ONLY: SHARED_PAR_DICT_MAP
2206+
USE :: API_SHARED_DATA_MOD, ONLY: SHARED_REDUCED_GG_DICT_MAP
2207+
USE :: API_SHARED_DATA_MOD, ONLY: SHARED_SH_DICT_MAP
2208+
USE :: API_SHARED_DATA_MOD, ONLY: FREE_MARS_MESSAGE
2209+
USE :: API_SHARED_DATA_MOD, ONLY: FREE_PARAMETRIZATION
2210+
USE :: API_SHARED_DATA_MOD, ONLY: FREE_REDUCED_GG_DICT
2211+
USE :: API_SHARED_DATA_MOD, ONLY: FREE_SH_DICT
2212+
USE :: API_SHARED_DATA_MOD, ONLY: EXTRACT_MARS_DICTIONARY
2213+
USE :: API_SHARED_DATA_MOD, ONLY: EXTRACT_MARS_DICTIONARY
2214+
USE :: API_SHARED_DATA_MOD, ONLY: EXTRACT_PAR_DICTIONARY
2215+
USE :: API_SHARED_DATA_MOD, ONLY: EXTRACT_REDUCED_GG_DICTIONARY
2216+
USE :: API_SHARED_DATA_MOD, ONLY: EXTRACT_SH_DICTIONARY
2217+
USE :: FORTRAN_MESSAGE_MOD, ONLY: FORTRAN_MESSAGE_T
2218+
USE :: PARAMETRIZATION_MOD, ONLY: PARAMETRIZATION_T
2219+
USE :: REPRESENTATIONS_MOD, ONLY: REDUCED_GG_T
2220+
USE :: REPRESENTATIONS_MOD, ONLY: SH_T
2221+
2222+
! Symbols imported by the preprocessor for debugging purposes
2223+
PP_DEBUG_USE_VARS
2224+
2225+
! Symbols imported by the preprocessor for logging purposes
2226+
PP_LOG_USE_VARS
2227+
2228+
! Symbols imported by the preprocessor for tracing purposes
2229+
PP_TRACE_USE_VARS
2230+
2231+
IMPLICIT NONE
2232+
2233+
!> Dummy arguments
2234+
TYPE(C_PTR), VALUE, INTENT(IN) :: DICT
2235+
TYPE(C_PTR), VALUE, INTENT(IN) :: FNAME
2236+
INTEGER(KIND=C_INT), VALUE, INTENT(IN) :: LEN
2237+
2238+
!> Function result
2239+
INTEGER(KIND=C_INT) :: RET
2240+
2241+
!> Local variables
2242+
TYPE(HOOKS_T) :: HOOKS
2243+
2244+
CHARACTER(LEN=1,KIND=C_CHAR), DIMENSION(:), POINTER :: FNAME_C
2245+
CHARACTER(LEN=1024) :: FNAME_F
2246+
INTEGER(KIND=JPIB_K) :: WRITE_STAT
2247+
INTEGER(KIND=JPIB_K) :: I
2248+
INTEGER(KIND=JPIB_K) :: UNIT
2249+
INTEGER(KIND=C_LONG_LONG), POINTER, DIMENSION(:) :: F_DICT
2250+
TYPE(FORTRAN_MESSAGE_T), POINTER :: MARS_DICT
2251+
TYPE(PARAMETRIZATION_T), POINTER :: PAR_DICT
2252+
TYPE(REDUCED_GG_T), POINTER :: REDUCED_GG_DICT
2253+
TYPE(SH_T), POINTER :: SH_DICT
2254+
2255+
!> Local error flags
2256+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_WRITE_YAML=2_JPIB_K
2257+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_OPEN_UNIT=3_JPIB_K
2258+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_DICTIONARY_NOT_ASSOCIATED =4_JPIB_K
2259+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_INVALID_LENGTH=5_JPIB_K
2260+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_FNAME_NOT_ASSOCIATED =6_JPIB_K
2261+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_EXTRACT_DICTIONARY =7_JPIB_K
2262+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_WRONG_HANDLE =8_JPIB_K
2263+
INTEGER(KIND=JPIB_K), PARAMETER :: ERRFLAG_UNKNOWN_DICTIONARY_TYPE=9_JPIB_K
2264+
2265+
! Local variables declared by the preprocessor for debugging purposes
2266+
PP_DEBUG_DECL_VARS
2267+
2268+
! Local variables declared by the preprocessor for logging purposes
2269+
PP_LOG_DECL_VARS
2270+
2271+
! Local variables declared by the preprocessor for tracing purposes
2272+
PP_TRACE_DECL_VARS
2273+
2274+
! Initialization of good path return value
2275+
PP_SET_ERR_SUCCESS( RET )
2276+
2277+
! Initialization of the hooks
2278+
CALL HOOKS%DEBUG_HOOK_%INIT( )
2279+
2280+
!> Error handling
2281+
PP_DEBUG_CRITICAL_COND_THROW( .NOT.C_ASSOCIATED(DICT), ERRFLAG_DICTIONARY_NOT_ASSOCIATED )
2282+
PP_DEBUG_CRITICAL_COND_THROW( .NOT.C_ASSOCIATED(FNAME), ERRFLAG_FNAME_NOT_ASSOCIATED )
2283+
PP_DEBUG_CRITICAL_COND_THROW( LEN .LE. 0, ERRFLAG_INVALID_LENGTH )
2284+
2285+
!> Get the size of the dictionary type
2286+
CALL C_F_POINTER( FNAME, FNAME_C, [LEN] )
2287+
2288+
! Copy the dictionary type to a fortran string
2289+
FNAME_F = REPEAT(' ', 1024)
2290+
DO I = 1, LEN
2291+
FNAME_F(I:I) = FNAME_C(I)
2292+
END DO
2293+
2294+
!TODO: Convert to lowercase
2295+
2296+
SELECT CASE( TRIM(FNAME_F) )
2297+
2298+
CASE ('stderr')
2299+
WRITE(ERROR_UNIT, *) "TO_YAML: "
2300+
UNIT = ERROR_UNIT
2301+
CASE ('stdout')
2302+
WRITE(OUTPUT_UNIT, *) "TO_YAML: "
2303+
UNIT = OUTPUT_UNIT
2304+
CASE default
2305+
OPEN(NEWUNIT=UNIT, FILE=FNAME_F, ACTION="WRITE", IOSTAT=WRITE_STAT)
2306+
2307+
PP_DEBUG_CRITICAL_COND_THROW( WRITE_STAT .NE. 0, ERRFLAG_OPEN_UNIT )
2308+
END SELECT
2309+
2310+
2311+
!> Get th fortran handle from the c handle
2312+
F_DICT => NULL()
2313+
CALL C_F_POINTER( DICT, F_DICT, [2] )
2314+
2315+
PP_DEBUG_CRITICAL_COND_THROW( .NOT.ASSOCIATED(F_DICT), ERRFLAG_DICTIONARY_NOT_ASSOCIATED )
2316+
2317+
!> Depending on the dictionary type we have to deallocate the dictionary
2318+
SELECT CASE ( F_DICT(1) )
2319+
2320+
CASE ( MARS_DICT_TYPE_E )
2321+
PP_TRYCALL(ERRFLAG_EXTRACT_DICTIONARY) EXTRACT_MARS_DICTIONARY( F_DICT, MARS_DICT, HOOKS )
2322+
PP_TRYCALL(ERRFLAG_WRITE_YAML) MARS_DICT%WRITE_TO_YAML(UNIT, 0, HOOKS)
2323+
2324+
CASE ( PAR_DICT_TYPE_E )
2325+
PP_TRYCALL(ERRFLAG_EXTRACT_DICTIONARY) EXTRACT_PAR_DICTIONARY( F_DICT, PAR_DICT, HOOKS )
2326+
PP_TRYCALL(ERRFLAG_WRITE_YAML) PAR_DICT%WRITE_TO_YAML(UNIT, 0, HOOKS)
2327+
2328+
CASE ( REDUCED_GG_DICT_TYPE_E )
2329+
PP_TRYCALL(ERRFLAG_EXTRACT_DICTIONARY) EXTRACT_REDUCED_GG_DICTIONARY( F_DICT, REDUCED_GG_DICT, HOOKS )
2330+
PP_TRYCALL(ERRFLAG_WRITE_YAML) REDUCED_GG_DICT%WRITE_TO_YAML(UNIT, 0, HOOKS)
2331+
2332+
2333+
CASE ( SH_DICT_TYPE_E )
2334+
PP_TRYCALL(ERRFLAG_EXTRACT_DICTIONARY) EXTRACT_SH_DICTIONARY( F_DICT, SH_DICT, HOOKS )
2335+
PP_TRYCALL(ERRFLAG_WRITE_YAML) SH_DICT%WRITE_TO_YAML(UNIT, 0, HOOKS)
2336+
2337+
CASE DEFAULT
2338+
PP_DEBUG_CRITICAL_THROW( ERRFLAG_WRONG_HANDLE )
2339+
2340+
END SELECT
2341+
2342+
2343+
SELECT CASE( TRIM(FNAME_F) )
2344+
CASE ('stderr')
2345+
CASE ('stdout')
2346+
CASE default
2347+
CLOSE(UNIT=UNIT)
2348+
END SELECT
2349+
2350+
2351+
!> Be sure we don't have any memory leaks
2352+
CALL HOOKS%DEBUG_HOOK_%FREE( )
2353+
2354+
! Exit point (On success)
2355+
RETURN
2356+
2357+
! Error handler
2358+
PP_ERROR_HANDLER
2359+
2360+
! Initialization of bad path return value
2361+
PP_SET_ERR_FAILURE( RET )
2362+
2363+
#if defined( PP_DEBUG_ENABLE_ERROR_HANDLING )
2364+
!$omp critical(ERROR_HANDLER)
2365+
2366+
BLOCK
2367+
2368+
! Error handling variables
2369+
PP_DEBUG_PUSH_FRAME()
2370+
2371+
SELECT CASE(ERRIDX)
2372+
CASE (ERRFLAG_WRITE_YAML)
2373+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Error writing yaml' )
2374+
CASE (ERRFLAG_OPEN_UNIT)
2375+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Error opening write to file' )
2376+
CASE (ERRFLAG_DICTIONARY_NOT_ASSOCIATED)
2377+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Dictionary not associated' )
2378+
CASE (ERRFLAG_INVALID_LENGTH)
2379+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Invalid length of fname' )
2380+
CASE (ERRFLAG_FNAME_NOT_ASSOCIATED)
2381+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'FNAME not associated' )
2382+
CASE (ERRFLAG_EXTRACT_DICTIONARY)
2383+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Can not extract dictionary' )
2384+
CASE (ERRFLAG_UNKNOWN_DICTIONARY_TYPE)
2385+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unknown dictionary type' )
2386+
CASE DEFAULT
2387+
PP_DEBUG_PUSH_MSG_TO_FRAME( 'Unknown error' )
2388+
END SELECT
2389+
2390+
! Print the error stack
2391+
! NOTE: This is important when c is calling this function. Is opens the error_unit
2392+
WRITE(ERROR_UNIT,*) ' PRINT ERROR STACK FROM: "'//__FILE__//'":', __LINE__
2393+
CALL HOOKS%DEBUG_HOOK_%PRINT_ERROR_STACK( ERROR_UNIT )
2394+
2395+
! Free the error stack
2396+
CALL HOOKS%DEBUG_HOOK_%FREE( )
2397+
2398+
! Write the error message and stop the program
2399+
PP_DEBUG_ABORT
2400+
2401+
END BLOCK
2402+
2403+
!$omp end critical(ERROR_HANDLER)
2404+
#endif
2405+
2406+
RETURN
2407+
2408+
END FUNCTION MULTIO_GRIB2_DICT_TO_YAML
2409+
#undef PP_PROCEDURE_NAME
2410+
#undef PP_PROCEDURE_TYPE
2411+
2412+
2413+
2414+
2415+
21722416
END MODULE API_DICTIONARY_WRAPPER_MOD
21732417
#undef PP_SECTION_NAME
21742418
#undef PP_SECTION_TYPE

‎src/multiom/api/api_encoder_wrapper_mod.F90

+1-72
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,6 @@ MODULE API_ENCODER_WRAPPER_MOD
2020
PUBLIC :: MULTIO_GRIB2_ENCODER_CLOSE
2121
PUBLIC :: MULTIO_GRIB2_ENCODER_ENCODE64
2222
PUBLIC :: MULTIO_GRIB2_ENCODER_ENCODE32
23-
PUBLIC :: MULTIO_GRIB2_ENCODER_EXTRACT_METADATA
2423

2524
CONTAINS
2625

@@ -417,76 +416,6 @@ END FUNCTION MULTIO_GRIB2_ENCODER_CLOSE
417416
#undef PP_PROCEDURE_TYPE
418417

419418

420-
#define PP_PROCEDURE_TYPE 'FUNCTION'
421-
#define PP_PROCEDURE_NAME 'MULTIO_GRIB2_ENCODER_EXTRACT_METADATA'
422-
PP_THREAD_SAFE FUNCTION MULTIO_GRIB2_ENCODER_EXTRACT_METADATA( MULTIO_GRIB2, GRIB_HANDLE, MARS_DICT, PAR_DICT ) &
423-
BIND(C,NAME='multio_grib2_encoder_extract_metadata') RESULT(RET)
424-
425-
!> Symbols imported from intrinsic modules.
426-
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT
427-
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR
428-
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_NULL_PTR
429-
430-
! Symbols imported from other modules within the project.
431-
USE :: DATAKINDS_DEF_MOD, ONLY: JPIB_K
432-
USE :: HOOKS_MOD, ONLY: HOOKS_T
433-
434-
! Symbols imported by the preprocessor for debugging purposes
435-
PP_DEBUG_USE_VARS
436-
437-
! Symbols imported by the preprocessor for logging purposes
438-
PP_LOG_USE_VARS
439-
440-
! Symbols imported by the preprocessor for tracing purposes
441-
PP_TRACE_USE_VARS
442-
443-
IMPLICIT NONE
444-
445-
!> Dummy arguments
446-
TYPE(C_PTR), VALUE, INTENT(IN) :: MULTIO_GRIB2
447-
TYPE(C_PTR), VALUE, INTENT(IN) :: GRIB_HANDLE
448-
TYPE(C_PTR), INTENT(INOUT) :: MARS_DICT
449-
TYPE(C_PTR), INTENT(INOUT) :: PAR_DICT
450-
451-
!> Function result
452-
INTEGER(KIND=C_INT) :: RET
453-
454-
! Local variables declared by the preprocessor for debugging purposes
455-
PP_DEBUG_DECL_VARS
456-
457-
! Local variables declared by the preprocessor for logging purposes
458-
PP_LOG_DECL_VARS
459-
460-
! Local variables declared by the preprocessor for tracing purposes
461-
PP_TRACE_DECL_VARS
462-
463-
! Trace begin of procedure
464-
PP_TRACE_ENTER_PROCEDURE()
465-
466-
! Initialization of good path return value
467-
PP_SET_ERR_SUCCESS( RET )
468-
469-
470-
! Trace end of procedure (on success)
471-
PP_TRACE_EXIT_PROCEDURE_ON_SUCCESS()
472-
473-
! Exit point (On success)
474-
RETURN
475-
476-
! Error handler
477-
PP_ERROR_HANDLER
478-
479-
! Initialization of bad path return value
480-
PP_SET_ERR_FAILURE( RET )
481-
482-
! TODO: Add error handling code here
483-
484-
RETURN
485-
486-
END FUNCTION MULTIO_GRIB2_ENCODER_EXTRACT_METADATA
487-
#undef PP_PROCEDURE_NAME
488-
#undef PP_PROCEDURE_TYPE
489-
490419

491420
#define PP_PROCEDURE_TYPE 'FUNCTION'
492421
#define PP_PROCEDURE_NAME 'MULTIO_GRIB2_ENCODER_ENCODE64'
@@ -714,4 +643,4 @@ END FUNCTION MULTIO_GRIB2_ENCODER_ENCODE32
714643
END MODULE API_ENCODER_WRAPPER_MOD
715644
#undef PP_SECTION_NAME
716645
#undef PP_SECTION_TYPE
717-
#undef PP_FILE_NAME
646+
#undef PP_FILE_NAME

0 commit comments

Comments
 (0)