diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index 14a494ba02..9c9ae0a793 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -39,6 +39,9 @@ module yaml_parser_mod private public :: open_and_parse_file +public :: get_num_unique_blocks +public :: get_unique_block_ids +public :: get_block_name public :: get_num_blocks public :: get_block_ids public :: get_value_from_key @@ -127,6 +130,17 @@ function get_value(file_id, key_id) bind(c) & type(c_ptr) :: key_value end function get_value +!> @brief Private c function that get the block name from a block_id in a yaml file +!! @return String containing the value obtained +function get_block(file_id, block_id) bind(c) & + result(block_name) + use iso_c_binding, only: c_ptr, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(in) :: block_id !< Block_id to get the block name for + + type(c_ptr) :: block_name +end function get_block + !> @brief Private c function that determines the value of a key in yaml_file (see yaml_parser_binding.c) !! @return c pointer with the value obtained function get_value_from_key_wrap(file_id, block_id, key_name, success) bind(c) & @@ -194,6 +208,26 @@ function is_valid_block_id(file_id, block_id) bind(c) & logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid end function is_valid_block_id +!> @brief Private c function that determines the number of unique blocks that belong to +!! a parent block with parent_block_id in the yaml file (see yaml_parser_binding.c) +!! @return Number of unique blocks +function get_num_unique_blocks_bind(file_id, parent_block_id) bind(c) & + result(nblocks) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + integer(kind=c_int) :: parent_block_id !< Id of the parent block + + integer(kind=c_int) :: nblocks +end function get_num_unique_blocks_bind + +!> @brief Private c function that gets the the ids of the unique blocks in the yaml file +!! (see yaml_parser_binding.c) +subroutine get_unique_block_ids_bind(file_id, block_ids, parent_block_id) bind(c) + use iso_c_binding, only: c_char, c_int, c_bool, c_ptr + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer(kind=c_int), intent(inout) :: block_ids(*) !< Id of the parent_block + integer(kind=c_int) :: parent_block_id !< Id of the parent block +end subroutine get_unique_block_ids_bind end interface !> @addtogroup yaml_parser_mod @@ -463,6 +497,52 @@ subroutine get_key_ids (file_id, block_id, key_ids) call get_key_ids_binding (file_id, block_id, key_ids) end subroutine get_key_ids +!> @brief Gets the number of unique blocks +!! @return The number of unique blocks +function get_num_unique_blocks(file_id, parent_block_id) & + result(nblocks) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(in), optional :: parent_block_id !< Id of the parent_block + integer :: nblocks + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, & + & "The file id in your get_num_unique_blocks call is invalid! Check your call.") + + if (.not. present(parent_block_id)) then + nblocks = get_num_unique_blocks_bind(file_id, 0) + else + if (.not. is_valid_block_id(file_id, parent_block_id)) call mpp_error(FATAL, & + & "The parent_block id in your get_block_ids call is invalid! Check your call.") + nblocks = get_num_unique_blocks_bind(file_id, parent_block_id) + endif +end function + +!> @brief Gets the ids of the unique block ids +subroutine get_unique_block_ids(file_id, block_ids, parent_block_id) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(inout) :: block_ids(:) !< Ids of each unique block + integer, intent(in), optional :: parent_block_id !< Id of the parent_block + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, & + & "The file id in your get_num_unique_blocks_ids call is invalid! Check your call.") + + if (.not. present(parent_block_id)) then + call get_unique_block_ids_bind(file_id, block_ids, 0) + else + if (.not. is_valid_block_id(file_id, parent_block_id)) call mpp_error(FATAL, & + & "The parent_block id in your get_block_ids call is invalid! Check your call.") + call get_unique_block_ids_bind(file_id, block_ids, parent_block_id) + endif +end subroutine get_unique_block_ids + +!> @brief Gets the block name form the block id +subroutine get_block_name(file_id, block_id, block_name) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(in) :: block_id !< Id of the block to get the name from + character(len=*), intent(out) :: block_name !< Name of the block + + block_name = fms_c2f_string(get_block(file_id, block_id)) +end subroutine #endif end module yaml_parser_mod !> @} diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index 28f9e15ee0..42795fbba8 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -97,6 +97,14 @@ char *get_value(int *file_id, int *key_id) return my_files.files[j].keys[*key_id].value; } +/* @brief Private c functions get gets the block name from a block id + @return String containing the value obtained */ +char *get_block(int *file_id, int *block_id) +{ + int j = *file_id; /* To minimize the typing :) */ + return my_files.files[j].keys[*block_id].parent_name; +} + /* @brief Private c function that determines they value of a key in yaml_file @return c pointer with the value obtained */ char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, int *sucess) /*, char *key_name) */ @@ -136,6 +144,82 @@ int get_num_blocks_all(int *file_id, char *block_name) return nblocks; } +/* @brief Private c function that determines the number of unique blocks (i.e diag_files, varlist, etc) + @return The number of unique blocks */ +int get_num_unique_blocks_bind(int *file_id, int *parent_block_id) +{ + int nblocks = 0; /* Number of blocks */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ + char block_names[my_files.files[j].nkeys][255]; /* Array that stores the names of the unique blocks*/ + bool found; /* True if the block name was already found (i.e it not unqiue)*/ + int k; /* For loops */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if (my_files.files[j].keys[i].parent_key == *parent_block_id ) + { + if (strcmp(my_files.files[j].keys[i].parent_name, "") == 0){ + continue; + } + found = false; + for (k = 1; k <= nblocks; k++) + { + if (strcmp(block_names[k], my_files.files[j].keys[i].parent_name) == 0) + { + found = true; + break; + } + } + + if (found) continue; + + nblocks = nblocks + 1; + strcpy(block_names[nblocks], my_files.files[j].keys[i].parent_name); + // printf("Block names: %s \n", block_names[nblocks]); + } + } + return nblocks; +} + +/* @brief Private c function that determines the ids of the unique blocks (i.e diag_files, varlist, etc) + @return The ids of the unique blocks */ +void get_unique_block_ids_bind(int *file_id, int *block_ids, int *parent_block_id) +{ + int nblocks = 0; /* Number of blocks */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ + char block_names[my_files.files[j].nkeys][255]; /* Array that stores the names of the unique blocks*/ + bool found; /* True if the block name was already found (i.e it not unqiue)*/ + int k; /* For loops */ + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if (my_files.files[j].keys[i].parent_key == *parent_block_id ) + { + if (strcmp(my_files.files[j].keys[i].parent_name, "") == 0){ + continue; + } + found = false; + for (k = 1; k <= nblocks; k++) + { + if (strcmp(block_names[k], my_files.files[j].keys[i].parent_name) == 0) + { + found = true; + break; + } + } + + if (found) continue; + + nblocks = nblocks + 1; + block_ids[nblocks - 1] = my_files.files[j].keys[i].key_number; + strcpy(block_names[nblocks], my_files.files[j].keys[i].parent_name); + //printf("Block names: %s \n", block_names[nblocks]); + } + } + return; +} /* @brief Private c function that determines the number of blocks with block_name that belong to a parent block with parent_block_id in the yaml file @return Number of blocks with block_name */ diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am index ae8c282b99..569f64e901 100644 --- a/test_fms/parser/Makefile.am +++ b/test_fms/parser/Makefile.am @@ -29,7 +29,8 @@ AM_CPPFLAGS = -I${top_srcdir}/include -I$(MODDIR) LDADD = ${top_builddir}/libFMS/libFMS.la # Build this test program. -check_PROGRAMS = parser_demo2 test_yaml_parser check_crashes parser_demo test_output_yaml +check_PROGRAMS = parser_demo2 test_yaml_parser check_crashes parser_demo test_output_yaml \ + generic_blocks # This is the source code for the test. test_yaml_parser_SOURCES = test_yaml_parser.F90 @@ -37,6 +38,7 @@ check_crashes_SOURCES = check_crashes.F90 parser_demo_SOURCES = parser_demo.F90 parser_demo2_SOURCES = parser_demo2.F90 test_output_yaml_SOURCES = test_output_yaml.F90 +generic_blocks_SOURCES = generic_blocks.F90 # Run the test program. TESTS = test_yaml_parser.sh diff --git a/test_fms/parser/generic_blocks.F90 b/test_fms/parser/generic_blocks.F90 new file mode 100644 index 0000000000..d44beb9fcb --- /dev/null +++ b/test_fms/parser/generic_blocks.F90 @@ -0,0 +1,132 @@ +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the GFDL Flexible Modeling System (FMS). +!* +!* FMS is free software: you can redistribute it and/or modify it under +!* the terms of the GNU Lesser General Public License as published by +!* the Free Software Foundation, either version 3 of the License, or (at +!* your option) any later version. +!* +!* FMS is distributed in the hope that it will be useful, but WITHOUT +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +!* for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with FMS. If not, see . +!*********************************************************************** + +!> @brief This programs tests the subroutines get_num_unique_blocks, get_unique_block_ids, and +!! get_block_name +program generic_blocks +#ifdef use_yaml + use fms_mod, only: fms_init, fms_end + use mpp_mod, only: mpp_error, FATAL + use yaml_parser_mod + + implicit none + + integer :: yaml_id !< Id of the yaml file + integer, allocatable :: field_table_ids(:) !< The Ids of the field table entries + integer, allocatable :: modlist_ids(:) !< The ids of the mods entries + integer, allocatable :: varlist_ids(:) !< The ids of the variable entries + integer, allocatable :: block_ids(:) !< The ids of the block entries + integer, allocatable :: misc_block_ids(:) !< The ids of the misc block entries + integer, allocatable :: key_ids(:) !< The ids of the keys + character(len=50) :: variable_name !< The variable name + character(len=50) :: model_type_name !< The model type + character(len=50) :: block_name !< The name of the block + character(len=50) :: key_name !< The name of the key + character(len=50) :: key_value !< The value of the key + character(len=50) :: varnames(2) !< The expected names of the variables + character(len=50) :: blocknames1(1) !< The expected names of the blocks for the first variable + character(len=50) :: blocknames2(2) !< The expected names of the blocks for the second variable + character(len=50) :: keys(5) !< The expected names of the keys + character(len=50) :: values(5) !< The expected names values of they keys + integer :: key_count !< To keep track of the expected answers + + logical :: correct_answer !< True if the answer is correct + integer :: i, j, k, l, m, n !< For do loops + + call fms_init() + varnames(1) = "sphum" + varnames(2) = "soa" + + blocknames1(1) = "profile_type" + blocknames2(1) = "chem_param" + blocknames2(2) = "profile_type" + + key_count = 0 + keys(1) = "value"; values(1) = "fixed" + keys(2) = "surface_value"; values(2) = "3.0e-06" + keys(3) = "value"; values(3) = "aerosol" + keys(4) = "value"; values(4) = "fixed" + keys(5) = "surface_value"; values(5) = "1.0e-32" + + yaml_id = open_and_parse_file("sample.yaml") + allocate(field_table_ids(get_num_blocks(yaml_id, "field_table"))) + call get_block_ids(yaml_id, "field_table", field_table_ids) + do i = 1, size(field_table_ids) + allocate(modlist_ids(get_num_blocks(yaml_id, "modlist", parent_block_id=field_table_ids(i)))) + call get_block_ids(yaml_id, "modlist", modlist_ids, field_table_ids(i)) + + do j = 1, size(modlist_ids) + call get_value_from_key(yaml_id, modlist_ids(j), "model_type", model_type_name) + print *, "Modlist::", trim(model_type_name) + if (trim(model_type_name) .ne. "atmos_mod") & + call mpp_error(FATAL, "Modlist is not the expected result") + + allocate(varlist_ids(get_num_blocks(yaml_id, "varlist", parent_block_id=modlist_ids(j)))) + call get_block_ids(yaml_id, "varlist", varlist_ids, modlist_ids(j)) + + do k = 1, size(varlist_ids) + call get_value_from_key(yaml_id, varlist_ids(k), "variable", variable_name) + print *, "Variable::", trim(variable_name) + if (trim(variable_name) .ne. varnames(k)) & + call mpp_error(FATAL, "Variable is not the expected result") + + allocate(block_ids(get_num_unique_blocks(yaml_id, parent_block_id=varlist_ids(k)))) + call get_unique_block_ids(yaml_id, block_ids, parent_block_id=varlist_ids(k)) + do l = 1, size(block_ids) + call get_block_name(yaml_id, block_ids(l), block_name) + print *, "Block_name::", trim(block_name) + + if (k == 1) then + correct_answer = trim(blocknames1(l)) .eq. trim(block_name) + else + correct_answer = trim(blocknames2(l)) .eq. trim(block_name) + endif + + if (.not. correct_answer) call mpp_error(FATAL, "blockname is not the expected result") + allocate(misc_block_ids(get_num_blocks(yaml_id, block_name, parent_block_id=varlist_ids(k)))) + call get_block_ids(yaml_id, block_name, misc_block_ids, parent_block_id=varlist_ids(k)) + do m = 1, size(misc_block_ids) + allocate(key_ids(get_nkeys(yaml_id, misc_block_ids(m)))) + call get_key_ids(yaml_id, misc_block_ids(m), key_ids) + do n = 1, size(key_ids) + key_count = key_count + 1 + call get_key_name(yaml_id, key_ids(n), key_name) + call get_key_value(yaml_id, key_ids(n), key_value) + print *, "KEY:", trim(key_name), " VALUE:", trim(key_value) + + if (trim(key_name) .ne. trim(keys(key_count))) & + call mpp_error(FATAL, "The key is not correct") + + if (trim(key_value) .ne. trim(values(key_count))) & + call mpp_error(FATAL, "The value is not correct") + enddo + deallocate(key_ids) + enddo + deallocate(misc_block_ids) + enddo + deallocate(block_ids) + print *, "---------" + enddo + deallocate(varlist_ids) + enddo + deallocate(modlist_ids) + enddo + call fms_end() +#endif +end program generic_blocks diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh index 3fb08aca25..80c386e687 100755 --- a/test_fms/parser/test_yaml_parser.sh +++ b/test_fms/parser/test_yaml_parser.sh @@ -268,4 +268,30 @@ test_expect_failure "wrong buffer size block id" ' mpirun -n 1 ./check_crashes ' +cat <<_EOF > sample.yaml +field_table: +- field_type: tracer + modlist: + - model_type: atmos_mod + varlist: + - variable: sphum + longname: specific humidity + units: kg/kg + profile_type: + - value: fixed + surface_value: 3.0e-06 + - variable: soa + longname: SOA tracer + units: mmr + convection: all + chem_param: + - value: aerosol + profile_type: + - value: fixed + surface_value: 1.0e-32 +_EOF + +test_expect_success "Generic blocks names" ' + mpirun -n 1 ./generic_blocks +' test_done