From c4442ee565e8a376b6eaee724ffbf0a294bd0b56 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Fri, 8 Oct 2021 17:50:52 -0400 Subject: [PATCH 01/16] initial parser commit --- Makefile.am | 1 + configure.ac | 17 +++ libFMS/Makefile.am | 1 + parser/Makefile.am | 42 ++++++++ parser/yaml_parser.F90 | 28 +++++ parser/yaml_parser_binding.c | 152 +++++++++++++++++++++++++++ test_fms/Makefile.am | 2 +- test_fms/parser/Makefile.am | 44 ++++++++ test_fms/parser/test_yaml_parser.F90 | 23 ++++ 9 files changed, 309 insertions(+), 1 deletion(-) create mode 100644 parser/Makefile.am create mode 100644 parser/yaml_parser.F90 create mode 100644 parser/yaml_parser_binding.c create mode 100644 test_fms/parser/Makefile.am create mode 100644 test_fms/parser/test_yaml_parser.F90 diff --git a/Makefile.am b/Makefile.am index 5f414d5746..2e47df8b24 100644 --- a/Makefile.am +++ b/Makefile.am @@ -65,6 +65,7 @@ SUBDIRS = \ tracer_manager \ sat_vapor_pres \ random_numbers \ + parser \ . \ libFMS \ test_fms \ diff --git a/configure.ac b/configure.ac index b340c72510..1b393782bd 100644 --- a/configure.ac +++ b/configure.ac @@ -67,6 +67,12 @@ AC_ARG_WITH([mpi], AS_IF([test ${with_mpi:-yes} = yes], [with_mpi=yes], [with_mpi=no]) +AC_ARG_WITH([yaml], + [AS_HELP_STRING([--with-yaml], + [Build with YAML support. This option will be ignored if --disable-fortran-flag-setting is also given. (Default no)])]) +AS_IF([test ${with_yaml:-no} = no], + [with_yaml=no], + [with_yaml=yes]) AC_ARG_ENABLE([setting-flags], [AS_HELP_STRING([--enable-setting-flags], [Allow configure to set some compiler flags. Disabling this will also disable any other --with or --enable options that set flags, and will only use user-provided falgs. (Default yes)])]) @@ -122,6 +128,15 @@ if test $with_mpi = yes; then AC_CHECK_FUNC([MPI_Init], [], [AC_MSG_ERROR([Can't find the MPI C library. Set CC/LDFLAGS/LIBS])]) fi +# Require yaml +if test $with_yaml = yes; then + AC_CHECK_HEADERS([yaml.h], [], [AC_MSG_ERROR(["Can't find the libYAML C header file. Set CC/CPPFLAGS/CFLAGS"])]) + AC_SEARCH_LIBS([yaml_parser_initialize], [yaml], [], [AC_MSG_ERROR(["Can't find the libYAML C library. Set CC/LDFLAGS/LIBS"])]) + + #If the test pass, define use_yaml macro + AC_DEFINE([use_yaml], [1], [This is required to use yaml parser]) +fi + # Require netCDF AC_CHECK_HEADERS([netcdf.h], [], [AC_MSG_ERROR([Can't find the netCDF C header file. Set CPPFLAGS/CFLAGS])]) AC_SEARCH_LIBS([nc_create], [netcdf], [], [AC_MSG_ERROR([Can't find the netCDF C library. Set LDFLAGS/LIBS])]) @@ -337,6 +352,7 @@ AC_CONFIG_FILES([ random_numbers/Makefile libFMS/Makefile docs/Makefile + parser/Makefile test_fms/test_common.sh test_fms/Makefile test_fms/diag_manager/Makefile @@ -357,6 +373,7 @@ AC_CONFIG_FILES([ test_fms/mosaic/Makefile test_fms/affinity/Makefile test_fms/coupler/Makefile + test_fms/parser/Makefile FMS.pc ]) diff --git a/libFMS/Makefile.am b/libFMS/Makefile.am index 05a151b814..7ec87e39d2 100644 --- a/libFMS/Makefile.am +++ b/libFMS/Makefile.am @@ -62,6 +62,7 @@ libFMS_la_LIBADD += $(top_builddir)/tracer_manager/libtracer_manager.la libFMS_la_LIBADD += $(top_builddir)/random_numbers/librandom_numbers.la libFMS_la_LIBADD += $(top_builddir)/diag_integral/libdiag_integral.la libFMS_la_LIBADD += $(top_builddir)/sat_vapor_pres/libsat_vapor_pres.la +libFMS_la_LIBADD += $(top_builddir)/parser/libparser.la libFMS_la_LIBADD += $(top_builddir)/libFMS_mod.la # At least one source file must be included to please Automake. diff --git a/parser/Makefile.am b/parser/Makefile.am new file mode 100644 index 0000000000..a0b6c6bb0b --- /dev/null +++ b/parser/Makefile.am @@ -0,0 +1,42 @@ +#*********************************************************************** +#* 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 . +#*********************************************************************** + +# This is an automake file for the constants directory of the FMS +# package. + +# Ed Hartnett 2/22/19 + +# Include .h and .mod files. +AM_CPPFLAGS = -I$(top_srcdir)/include +AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR) + +# Build this uninstalled convenience library. +noinst_LTLIBRARIES = libparser.la + +# The convenience library depends on its source. +libparser_la_SOURCES = \ + yaml_parser.F90 \ + yaml_parser_binding.c + +MODFILES = \ + yaml_parser_mod.$(FC_MODEXT) +BUILT_SOURCES = $(MODFILES) +nodist_include_HEADERS = $(MODFILES) + +include $(top_srcdir)/mkmods.mk diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 new file mode 100644 index 0000000000..a95fa746f0 --- /dev/null +++ b/parser/yaml_parser.F90 @@ -0,0 +1,28 @@ +module yaml_parser_mod + +implicit none + +public :: do_stuff +public :: read_and_parse_file + +interface +function read_and_parse_file(filename) bind(c) & + result(sucess) + use iso_c_binding, only: c_char, c_int, c_bool + character(kind=c_char), intent(in) :: filename(*) + logical(kind=c_bool) :: sucess +end function read_and_parse_file +end interface + +contains + +subroutine do_stuff() + print *, "Doing stuff" + +#ifdef use_yaml + print *, "Very important stuff" +#endif + +end subroutine do_stuff + +end module yaml_parser_mod diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c new file mode 100644 index 0000000000..1406abce32 --- /dev/null +++ b/parser/yaml_parser_binding.c @@ -0,0 +1,152 @@ +#include +#include +#include + +struct key_value_pairs { + int key_number; + char key[50]; + char value[50]; + char parent_name[50]; + int parent_key; +}; + +struct yaml_file { + int nkeys; + struct key_value_pairs keys[50]; +}; + +struct yaml_file my_file; + +int get_num_blocks(char *block_name) +{ + int nblocks = 0; + int i; + + for ( i = 1; i <= my_file.nkeys; i++ ) + { + if(strcmp(my_file.keys[i].parent_name, block_name) == 0) nblocks = nblocks + 1; + } + + return nblocks; +} + +bool get_block_keys(char *block_name, int nfiles, int p[*]) +{ + int i; + + for ( i = 1; i <= my_file.nkeys; i++ ) + { + if(strcmp(my_file.keys[i].parent_name, block_name) == 0) { + p[i] = my_file.keys[i].key_number; + } + } + return true; +} + +int main(void) +{ + yaml_parser_t parser; + yaml_token_t token; + FILE *file; + + bool is_key = false; + char key_value[50]; + int layer = 0; + int key_count=0; + int parent[10]; + int current_parent; + char layer_name[10][50]; + char current_layername[50]; + int i; + printf("opening file: %s\n", "diag_table.yaml"); + file = fopen("diag_table.yaml", "r"); + + if(!yaml_parser_initialize(&parser)) + fputs("Failed to initialize parser!\n", stderr); + + bool is_new=false; + parent[0]=0; + strcpy(layer_name[0], "TOP"); + /* Set input file */ + yaml_parser_set_input_file(&parser, file); + do { + yaml_parser_scan(&parser, &token); + switch(token.type) + { + case YAML_KEY_TOKEN: + { + is_key = true; + break; + } + case YAML_VALUE_TOKEN: + { + is_key = false; + break; + } + case YAML_BLOCK_ENTRY_TOKEN: + { + layer = layer + 1; + + is_new=true; + if (strcmp(key_value, "")) strcpy(layer_name[layer], key_value); + /* printf("LAYER:%i NAME:%s for %s=%i\n", layer, layer_name[layer], layer_name[layer-1], parent[layer-1]); */ + break; + } + case YAML_BLOCK_END_TOKEN: + { + layer = layer - 1; + break; + } + case YAML_SCALAR_TOKEN: + { + if ( ! is_key) + { + current_parent = parent[layer]; + strcpy(current_layername, ""); + key_count = key_count + 1; + if (is_new) { + parent[layer]=key_count; + current_parent = parent[layer-1]; + strcpy(current_layername, layer_name[layer]); + is_new = false; + } + i = key_count; + my_file.keys[i].key_number=i; + my_file.keys[i].parent_key = current_parent; + strcpy(my_file.keys[i].parent_name, current_layername); + strcpy(my_file.keys[i].key, key_value); + strcpy(my_file.keys[i].value, token.data.scalar.value); + my_file.nkeys = key_count; + /* printf("----> LAYER:%i LAYER_NAME=%s PARENT:%i, KEYCOUNT:%i KEY: %s VALUE: %s \n", layer, current_layername, current_parent, key_count, key_value, token.data.scalar.value); */ + strcpy(key_value,""); + } + else + {strcpy(key_value,token.data.scalar.value);} + } + break; + } + if(token.type != YAML_STREAM_END_TOKEN) + yaml_token_delete(&token); + } while(token.type != YAML_STREAM_END_TOKEN); + yaml_token_delete(&token); + yaml_parser_delete(&parser); + + for ( i = 1; i <= my_file.nkeys; i++ ) { + printf("Key_number:%i Parent_key:%i Parent_name:%s Key:%s Value:%s \n", my_file.keys[i].key_number, my_file.keys[i].parent_key, my_file.keys[i].parent_name, my_file.keys[i].key, my_file.keys[i].value); + + } + printf("closing file: %s\n", "diag_table.yaml"); + fclose(file); + + int nfiles= get_num_blocks("diag_files"); + printf("diag_files = %i\n", nfiles); + + int block_keys[nfiles]; + if(get_block_keys("diag_files", nfiles, block_keys)){ + for ( i = 0; i <= nfiles-1; i++ ) { + printf("nfile:%i block_key=%i \n", i, block_keys[i]); + } + } + + return true; +} diff --git a/test_fms/Makefile.am b/test_fms/Makefile.am index 9e070def22..639a69c5b0 100644 --- a/test_fms/Makefile.am +++ b/test_fms/Makefile.am @@ -26,7 +26,7 @@ ACLOCAL_AMFLAGS = -I m4 # Make targets will be run in each subdirectory. Order is significant. SUBDIRS = coupler diag_manager data_override exchange monin_obukhov drifters \ mosaic interpolator fms mpp mpp_io time_interp time_manager \ -horiz_interp field_manager axis_utils affinity fms2_io +horiz_interp field_manager axis_utils affinity fms2_io parser # This input file must be distributed, it is turned into # test_common.sh by configure. diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am new file mode 100644 index 0000000000..b47b784b28 --- /dev/null +++ b/test_fms/parser/Makefile.am @@ -0,0 +1,44 @@ +#*********************************************************************** +#* 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 . +#*********************************************************************** + +# This is an automake file for the test_fms/data_override directory of the FMS +# package. + +# uramirez, Ed Hartnett + +# Find the needed mod and .inc files. +AM_CPPFLAGS = -I${top_srcdir}/include -I$(MODDIR) + +# Link to the FMS library. +LDADD = ${top_builddir}/libFMS/libFMS.la + +# Build this test program. +check_PROGRAMS = test_yaml_parser + +# This is the source code for the test. +test_yaml_parser_SOURCES = test_yaml_parser.F90 + +# Run the test program. +#TESTS = test_yaml_parser.sh + +# Include these files with the distribution. +#EXTRA_DIST = test_yaml_parser.sh + +# Clean up +CLEANFILES = input.nml *.nc* *.out diff --git a/test_fms/parser/test_yaml_parser.F90 b/test_fms/parser/test_yaml_parser.F90 new file mode 100644 index 0000000000..5f9c40cda7 --- /dev/null +++ b/test_fms/parser/test_yaml_parser.F90 @@ -0,0 +1,23 @@ +program test_yaml_parser + +use yaml_parser_mod +use mpp_mod +use fms_mod, only : fms_init, fms_end + +implicit none + +call do_stuff() + +#ifdef use_yaml + +call fms_init() +if (read_and_parse_file("diag_table.yaml")) then + print *, "The yaml file was read bro ^" +else + call mpp_error(FATAL, "The file was not opened sucessfully, get help!") +endif +call fms_end() + +#endif + +end program test_yaml_parser From 859bcb336075d5e44dd5d8d606cea226f4650254 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 25 Oct 2021 18:16:18 -0400 Subject: [PATCH 02/16] second parser commit --needs some clean up --- Makefile.am | 2 +- data_override/data_override.F90 | 323 +++++++++++------- parser/yaml_parser.F90 | 299 +++++++++++++++- parser/yaml_parser_binding.c | 244 ++++++++++--- test_fms/data_override/Makefile.am | 5 +- test_fms/data_override/test_data_override2.sh | 13 + test_fms/data_override/test_data_yaml.F90 | 50 +++ test_fms/parser/Makefile.am | 7 +- test_fms/parser/check_crashes.F90 | 78 +++++ test_fms/parser/data_table.yaml | 18 + test_fms/parser/diag_table.yaml | 26 ++ test_fms/parser/test_yaml_parser.F90 | 143 +++++++- test_fms/parser/test_yaml_parser.sh | 66 ++++ 13 files changed, 1068 insertions(+), 206 deletions(-) create mode 100644 test_fms/data_override/test_data_yaml.F90 create mode 100644 test_fms/parser/check_crashes.F90 create mode 100644 test_fms/parser/data_table.yaml create mode 100644 test_fms/parser/diag_table.yaml create mode 100755 test_fms/parser/test_yaml_parser.sh diff --git a/Makefile.am b/Makefile.am index 2e47df8b24..9254d916e5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -42,6 +42,7 @@ SUBDIRS = \ fms2_io \ mosaic2 \ fms \ + parser \ affinity \ mosaic \ time_manager \ @@ -65,7 +66,6 @@ SUBDIRS = \ tracer_manager \ sat_vapor_pres \ random_numbers \ - parser \ . \ libFMS \ test_fms \ diff --git a/data_override/data_override.F90 b/data_override/data_override.F90 index 013897aec6..70b46058a9 100644 --- a/data_override/data_override.F90 +++ b/data_override/data_override.F90 @@ -40,6 +40,7 @@ !> @brief File for @ref data_override_mod module data_override_mod +use yaml_parser_mod use constants_mod, only: PI use mpp_mod, only : mpp_error, FATAL, WARNING, stdout, stdlog, mpp_max use mpp_mod, only : input_nml_file @@ -139,7 +140,12 @@ module data_override_mod real :: min_glo_lon_lnd, max_glo_lon_lnd real :: min_glo_lon_ice, max_glo_lon_ice integer:: num_fields = 0 !< number of fields in override_array already processed +#ifdef use_yaml +type(data_type), dimension(:), allocatable :: data_table !< user-provided data table +#else type(data_type), dimension(max_table) :: data_table !< user-provided data table +#endif + type(data_type) :: default_table type(override_type), dimension(max_array), save :: override_array !< to store processed fields type(override_type), save :: default_array @@ -156,7 +162,13 @@ module data_override_mod public :: data_override_init, data_override, data_override_unset_domains -public :: data_override_UG +public :: data_override_UG, data_type + +#ifdef use_yaml +public :: read_table_yaml +#else +public :: read_table +#endif contains function count_ne_1(in_1, in_2, in_3) @@ -188,15 +200,10 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan character(len=128) :: grid_file = 'INPUT/grid_spec.nc' integer :: is,ie,js,je,use_get_grid_version - integer :: i, iunit, ntable, ntable_lima, ntable_new, unit,io_status, ierr - character(len=256) :: record + integer :: i, unit, io_status, ierr logical :: file_open - logical :: ongrid - character(len=128) :: region, region_type type(FmsNetcdfFile_t) :: fileobj - type(data_type) :: data_entry - debug_data_override = .false. read (input_nml_file, data_override_nml, iostat=io_status) @@ -235,9 +242,134 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan default_table%file_name = 'none' default_table%factor = 1. default_table%interpol_method = 'bilinear' + +#ifdef use_yaml + call read_table_yaml(data_table) +#else do i = 1,max_table data_table(i) = default_table enddo + call read_table(data_table) +#endif + +! Initialize override array + default_array%gridname = 'NONE' + default_array%fieldname = 'NONE' + default_array%t_index = -1 + default_array%dims = -1 + default_array%comp_domain = -1 + do i = 1, max_array + override_array(i) = default_array + enddo + call time_interp_external_init + end if + + module_is_initialized = .TRUE. + + if ( .NOT. (atm_on .or. ocn_on .or. lnd_on .or. ice_on .or. lndUG_on)) return + call fms2_io_init + +! Test if grid_file is already opened + inquire (file=trim(grid_file), opened=file_open) + if(file_open) call mpp_error(FATAL, trim(grid_file)//' already opened') + + if(.not. open_file(fileobj, grid_file, 'read' )) then + call mpp_error(FATAL, 'data_override_mod: Error in opening file '//trim(grid_file)) + endif + + if(variable_exists(fileobj, "x_T" ) .OR. variable_exists(fileobj, "geolon_t" ) ) then + use_get_grid_version = 1 + call close_file(fileobj) + else if(variable_exists(fileobj, "ocn_mosaic_file" ) .OR. variable_exists(fileobj, "gridfiles" ) ) then + use_get_grid_version = 2 + if(variable_exists(fileobj, "gridfiles" ) ) then + if(count_ne_1((ocn_on .OR. ice_on), lnd_on, atm_on)) call mpp_error(FATAL, 'data_override_mod: the grid file ' // & + 'is a solo mosaic, one and only one of atm_on, lnd_on or ice_on/ocn_on should be true') + end if + else + call mpp_error(FATAL, 'data_override_mod: none of x_T, geolon_t, ocn_mosaic_file or gridfiles exist in '//trim(grid_file)) + endif + + if(use_get_grid_version .EQ. 1) then + if (atm_on .and. .not. allocated(lon_local_atm) ) then + call mpp_get_compute_domain( atm_domain,is,ie,js,je) + allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) + call get_grid_version_1(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & + min_glo_lon_atm, max_glo_lon_atm, grid_center_bug ) + endif + if (ocn_on .and. .not. allocated(lon_local_ocn) ) then + call mpp_get_compute_domain( ocn_domain,is,ie,js,je) + allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) + call get_grid_version_1(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & + min_glo_lon_ocn, max_glo_lon_ocn, grid_center_bug ) + endif + + if (lnd_on .and. .not. allocated(lon_local_lnd) ) then + call mpp_get_compute_domain( lnd_domain,is,ie,js,je) + allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) + call get_grid_version_1(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & + min_glo_lon_lnd, max_glo_lon_lnd, grid_center_bug ) + endif + + if (ice_on .and. .not. allocated(lon_local_ice) ) then + call mpp_get_compute_domain( ice_domain,is,ie,js,je) + allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) + call get_grid_version_1(grid_file, 'ice', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & + min_glo_lon_ice, max_glo_lon_ice, grid_center_bug ) + endif + else + if (atm_on .and. .not. allocated(lon_local_atm) ) then + call mpp_get_compute_domain(atm_domain,is,ie,js,je) + allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) + call get_grid_version_2(fileobj, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & + min_glo_lon_atm, max_glo_lon_atm ) + endif + + if (ocn_on .and. .not. allocated(lon_local_ocn) ) then + call mpp_get_compute_domain( ocn_domain,is,ie,js,je) + allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) + call get_grid_version_2(fileobj, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & + min_glo_lon_ocn, max_glo_lon_ocn ) + endif + + if (lnd_on .and. .not. allocated(lon_local_lnd) ) then + call mpp_get_compute_domain( lnd_domain,is,ie,js,je) + allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) + call get_grid_version_2(fileobj, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & + min_glo_lon_lnd, max_glo_lon_lnd ) + endif + + if (ice_on .and. .not. allocated(lon_local_ice) ) then + call mpp_get_compute_domain( ice_domain,is,ie,js,je) + allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) + call get_grid_version_2(fileobj, 'ocn', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & + min_glo_lon_ice, max_glo_lon_ice ) + endif + end if + if(use_get_grid_version .EQ. 2) then + call close_file(fileobj) + end if + +end subroutine data_override_init + +#ifndef use_yaml +subroutine read_table(data_table, ntable_out) + type(data_type), dimension(max_table), intent(inout) :: data_table + integer, intent(out), optional :: ntable_out + + integer :: ntable + integer :: ntable_lima + integer :: ntable_new + + integer :: iunit + integer :: io_status + character(len=256) :: record + type(data_type) :: data_entry + + logical :: ongrid + character(len=128) :: region, region_type + + integer :: sunit ! Read coupler_table open(newunit=iunit, file='data_table', action='READ', iostat=io_status) @@ -273,13 +405,13 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan data_entry%interpol_method == 'bicubic' .or. & data_entry%interpol_method == 'bilinear' .or. & data_entry%interpol_method == 'none')) then - unit = stdout() - write(unit,*)" gridname is ", trim(data_entry%gridname) - write(unit,*)" fieldname_code is ", trim(data_entry%fieldname_code) - write(unit,*)" fieldname_file is ", trim(data_entry%fieldname_file) - write(unit,*)" file_name is ", trim(data_entry%file_name) - write(unit,*)" factor is ", data_entry%factor - write(unit,*)" interpol_method is ", trim(data_entry%interpol_method) + sunit = stdout() + write(sunit,*)" gridname is ", trim(data_entry%gridname) + write(sunit,*)" fieldname_code is ", trim(data_entry%fieldname_code) + write(sunit,*)" fieldname_file is ", trim(data_entry%fieldname_file) + write(sunit,*)" file_name is ", trim(data_entry%file_name) + write(sunit,*)" factor is ", data_entry%factor + write(sunit,*)" interpol_method is ", trim(data_entry%interpol_method) call mpp_error(FATAL, 'data_override_mod: invalid last entry in data_override_table, ' & //'its value should be "default", "bicubic", "bilinear" or "none" ') endif @@ -328,13 +460,13 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan data_entry%interpol_method == 'bicubic' .or. & data_entry%interpol_method == 'bilinear' .or. & data_entry%interpol_method == 'none')) then - unit = stdout() - write(unit,*)" gridname is ", trim(data_entry%gridname) - write(unit,*)" fieldname_code is ", trim(data_entry%fieldname_code) - write(unit,*)" fieldname_file is ", trim(data_entry%fieldname_file) - write(unit,*)" file_name is ", trim(data_entry%file_name) - write(unit,*)" factor is ", data_entry%factor - write(unit,*)" interpol_method is ", trim(data_entry%interpol_method) + sunit = stdout() + write(sunit,*)" gridname is ", trim(data_entry%gridname) + write(sunit,*)" fieldname_code is ", trim(data_entry%fieldname_code) + write(sunit,*)" fieldname_file is ", trim(data_entry%fieldname_file) + write(sunit,*)" file_name is ", trim(data_entry%file_name) + write(sunit,*)" factor is ", data_entry%factor + write(sunit,*)" interpol_method is ", trim(data_entry%interpol_method) call mpp_error(FATAL, 'data_override_mod: invalid last entry in data_override_table, ' & //'its value should be "default", "bicubic", "bilinear" or "none" ') endif @@ -354,106 +486,55 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan 'data_override_mod: New and old formats together in same data_table not supported') close(iunit, iostat=io_status) if(io_status/=0) call mpp_error(FATAL, 'data_override_mod: Error in closing file data_table') - -! Initialize override array - default_array%gridname = 'NONE' - default_array%fieldname = 'NONE' - default_array%t_index = -1 - default_array%dims = -1 - default_array%comp_domain = -1 - do i = 1, max_array - override_array(i) = default_array - enddo - call time_interp_external_init - end if - - module_is_initialized = .TRUE. - - if ( .NOT. (atm_on .or. ocn_on .or. lnd_on .or. ice_on .or. lndUG_on)) return - call fms2_io_init - -! Test if grid_file is already opened - inquire (file=trim(grid_file), opened=file_open) - if(file_open) call mpp_error(FATAL, trim(grid_file)//' already opened') - - if(.not. open_file(fileobj, grid_file, 'read' )) then - call mpp_error(FATAL, 'data_override_mod: Error in opening file '//trim(grid_file)) - endif - - if(variable_exists(fileobj, "x_T" ) .OR. variable_exists(fileobj, "geolon_t" ) ) then - use_get_grid_version = 1 - call close_file(fileobj) - else if(variable_exists(fileobj, "ocn_mosaic_file" ) .OR. variable_exists(fileobj, "gridfiles" ) ) then - use_get_grid_version = 2 - if(variable_exists(fileobj, "gridfiles" ) ) then - if(count_ne_1((ocn_on .OR. ice_on), lnd_on, atm_on)) call mpp_error(FATAL, 'data_override_mod: the grid file ' // & - 'is a solo mosaic, one and only one of atm_on, lnd_on or ice_on/ocn_on should be true') - end if - else - call mpp_error(FATAL, 'data_override_mod: none of x_T, geolon_t, ocn_mosaic_file or gridfiles exist in '//trim(grid_file)) - endif - - if(use_get_grid_version .EQ. 1) then - if (atm_on .and. .not. allocated(lon_local_atm) ) then - call mpp_get_compute_domain( atm_domain,is,ie,js,je) - allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) - call get_grid_version_1(grid_file, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & - min_glo_lon_atm, max_glo_lon_atm, grid_center_bug ) - endif - if (ocn_on .and. .not. allocated(lon_local_ocn) ) then - call mpp_get_compute_domain( ocn_domain,is,ie,js,je) - allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) - call get_grid_version_1(grid_file, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & - min_glo_lon_ocn, max_glo_lon_ocn, grid_center_bug ) - endif - - if (lnd_on .and. .not. allocated(lon_local_lnd) ) then - call mpp_get_compute_domain( lnd_domain,is,ie,js,je) - allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) - call get_grid_version_1(grid_file, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & - min_glo_lon_lnd, max_glo_lon_lnd, grid_center_bug ) - endif - - if (ice_on .and. .not. allocated(lon_local_ice) ) then - call mpp_get_compute_domain( ice_domain,is,ie,js,je) - allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) - call get_grid_version_1(grid_file, 'ice', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & - min_glo_lon_ice, max_glo_lon_ice, grid_center_bug ) - endif - else - if (atm_on .and. .not. allocated(lon_local_atm) ) then - call mpp_get_compute_domain(atm_domain,is,ie,js,je) - allocate(lon_local_atm(is:ie,js:je), lat_local_atm(is:ie,js:je)) - call get_grid_version_2(fileobj, 'atm', atm_domain, is, ie, js, je, lon_local_atm, lat_local_atm, & - min_glo_lon_atm, max_glo_lon_atm ) - endif - - if (ocn_on .and. .not. allocated(lon_local_ocn) ) then - call mpp_get_compute_domain( ocn_domain,is,ie,js,je) - allocate(lon_local_ocn(is:ie,js:je), lat_local_ocn(is:ie,js:je)) - call get_grid_version_2(fileobj, 'ocn', ocn_domain, is, ie, js, je, lon_local_ocn, lat_local_ocn, & - min_glo_lon_ocn, max_glo_lon_ocn ) - endif - - if (lnd_on .and. .not. allocated(lon_local_lnd) ) then - call mpp_get_compute_domain( lnd_domain,is,ie,js,je) - allocate(lon_local_lnd(is:ie,js:je), lat_local_lnd(is:ie,js:je)) - call get_grid_version_2(fileobj, 'lnd', lnd_domain, is, ie, js, je, lon_local_lnd, lat_local_lnd, & - min_glo_lon_lnd, max_glo_lon_lnd ) - endif - - if (ice_on .and. .not. allocated(lon_local_ice) ) then - call mpp_get_compute_domain( ice_domain,is,ie,js,je) - allocate(lon_local_ice(is:ie,js:je), lat_local_ice(is:ie,js:je)) - call get_grid_version_2(fileobj, 'ocn', ice_domain, is, ie, js, je, lon_local_ice, lat_local_ice, & - min_glo_lon_ice, max_glo_lon_ice ) - endif - end if - if(use_get_grid_version .EQ. 2) then - call close_file(fileobj) - end if - -end subroutine data_override_init + if (present(ntable_out)) ntable_out = ntable +end subroutine read_table + +#else +subroutine read_table_yaml(data_table, ntable_out) + type(data_type), dimension(:), allocatable, intent(out) :: data_table + integer, intent(out), optional :: ntable_out + + integer, allocatable :: entry_id(:) + integer :: nentries + integer :: i + character(len=50) :: buffer + integer :: file_id + + file_id = open_and_parse_file("data_table.yaml") + nentries = get_num_blocks(file_id, "data_table") + allocate(data_table(nentries)) + allocate(entry_id(nentries)) + call get_block_ids(file_id, "data_table", entry_id) + + do i = 1, nentries + call get_value_from_key(file_id, entry_id(i), "gridname", data_table(i)%gridname) + call get_value_from_key(file_id, entry_id(i), "fieldname_code", data_table(i)%fieldname_code) + call get_value_from_key(file_id, entry_id(i), "fieldname_file", data_table(i)%fieldname_file) + call get_value_from_key(file_id, entry_id(i), "file_name", data_table(i)%file_name) + call get_value_from_key(file_id, entry_id(i), "interpol_method", data_table(i)%interpol_method) + call get_value_from_key(file_id, entry_id(i), "factor", data_table(i)%factor) + call get_value_from_key(file_id, entry_id(i), "region_type", buffer, is_optional=.true.) + + if(trim(buffer) == "inside_region" ) then + data_table(i)%region_type = INSIDE_REGION + else if( trim(buffer) == "outside_region" ) then + data_table(i)%region_type = OUTSIDE_REGION + else + data_table(i)%region_type = NO_REGION + endif + + call get_value_from_key(file_id, entry_id(i), "lon_start", data_table(i)%lon_start, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lon_end", data_table(i)%lon_end, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lat_start", data_table(i)%lat_start, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lat_end", data_table(i)%lat_end, is_optional=.true.) + + print *, trim(data_table(i)%gridname), trim(data_table(i)%fieldname_code), trim(data_table(i)%fieldname_file), trim(data_table(i)%file_name), trim(data_table(i)%interpol_method), data_table(i)%factor + end do + + if(present(ntable_out)) ntable_out = nentries + +end subroutine read_table_yaml +#endif !> @brief Unset domains that had previously been set for use by data_override. !! diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index a95fa746f0..46e6211f17 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -1,28 +1,303 @@ module yaml_parser_mod +#ifdef use_yaml +use fms_mod, only: fms_c2f_string +use platform_mod +use mpp_mod +use iso_c_binding + implicit none +private -public :: do_stuff -public :: read_and_parse_file +public :: open_and_parse_file +public :: get_num_blocks +public :: get_block_ids +public :: get_value_from_key +public :: get_nkeys +public :: get_key_ids +public :: get_key_name +public :: get_key_value +!public :: clean_up + +!> @brief Dermine the value of a key from a keyname +interface get_value_from_key + module procedure get_value_from_key_0d + module procedure get_value_from_key_1d +end interface get_value_from_key interface -function read_and_parse_file(filename) bind(c) & + +!> @brief Private c function that opens and parses a yaml file (see yaml_parser_binding.c) +!! @return Flag indicating if the read was sucessful +function open_and_parse_file_wrap(filename, file_id) bind(c) & result(sucess) use iso_c_binding, only: c_char, c_int, c_bool - character(kind=c_char), intent(in) :: filename(*) - logical(kind=c_bool) :: sucess -end function read_and_parse_file + character(kind=c_char), intent(in) :: filename(*) !< Filename of the yaml file + integer(kind=c_int), intent(out) :: file_id !< File id corresponding' to the yaml file that was opened + logical(kind=c_bool) :: sucess !< Flag indicating if the read was sucessful +end function open_and_parse_file_wrap + +!> @brief c function that gets the number of key-value pairs in a block (see yaml_parser_binding.c) +!! @return Number of key-value pairs in this block +function get_nkeys(file_id, block_id) bind(c) & + result(nkeys) + use iso_c_binding, only: c_char, 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 !< Id of the parent_block + integer(kind=c_int) :: nkeys +end function get_nkeys + +!> @brief c function that gets the ids of the key-value pairs in a block (see yaml_parser_binding.c) +subroutine get_key_ids(file_id, block_id, key_ids) bind(c) + use iso_c_binding, only: c_char, 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 !< Id of the parent_block + integer(kind=c_int), intent(inout) :: key_ids(*) !< Ids of the key-value pairs +end subroutine get_key_ids + +!> @brief Private c function that get the key from a key_id in a yaml file +!! @return Name of the key obtained +function get_key(file_id, key_id) bind(c) & + result(key_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) :: key_id !< Id of the key-value pair of interest + type(c_ptr) :: key_name +end function get_key + +!> @brief Private c function that get the value from a key_id in a yaml file +!! @return String containing the value obtained +function get_value(file_id, key_id) bind(c) & + result(key_value) + 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) :: key_id !< Id of the key-value pair of interest + type(c_ptr) :: key_value +end function get_value + +!> @brief Private c function that determines they 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, sucess) bind(c) & + result(key_value2) + + use iso_c_binding, only: c_ptr, 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), intent(in) :: block_id !< ID corresponding' to the block you want the key for + character(kind=c_char), intent(in) :: key_name !< Name of the key you want the value for + logical(kind=c_bool), intent(out) :: sucess !< Flag indicating if the call was sucessful + type(c_ptr) :: key_value2 +end function get_value_from_key_wrap + +!> @brief Private c function that determines the number of blocks with block_name in the yaml file +!! (see yaml_parser_binding.c) +!! @return Number of blocks with block_name +function get_num_blocks_all(file_id, block_name) 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 + character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + + integer(kind=c_int) :: nblocks +end function get_num_blocks_all + +!> @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 (see yaml_parser_binding.c) +!! @return Number of blocks with block_name +function get_num_blocks_child(file_id, block_name, 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 + character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + integer(kind=c_int) :: parent_block_id !< Id of the parent block + + integer(kind=c_int) :: nblocks +end function get_num_blocks_child + +!> @brief Private c function that gets the the ids of the blocks with block_name in the yaml file +!! (see yaml_parser_binding.c) +subroutine get_block_ids_all(file_id, block_name, block_ids) bind(c) + 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 + character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + integer(kind=c_int), intent(inout) :: block_ids(*) !< Id of the parent_block +end subroutine get_block_ids_all + +!> @brief Private c function that gets the the ids of the blocks with block_name and that +!! belong' to a parent block id in the yaml file (see yaml_parser_binding.c) +subroutine get_block_ids_child(file_id, block_name, block_ids, parent_block_id) bind(c) + 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 + character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + 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_block_ids_child + end interface contains -subroutine do_stuff() - print *, "Doing stuff" +!> @brief Opens and parses a yaml file +!! @return A file id corresponding' to the file that was opened +function open_and_parse_file(filename) & + result(file_id) -#ifdef use_yaml - print *, "Very important stuff" -#endif + character(len=*), intent(in) :: filename !< Filename of the yaml file + logical :: sucess !< Flag indicating if the read was sucessful + + integer :: file_id + + sucess = open_and_parse_file_wrap(filename, file_id) + if (.not. sucess) call mpp_error(FATAL, "Error opening the yaml file:"//trim(filename)//". Check the file!") -end subroutine do_stuff +end function open_and_parse_file +!> @brief Gets the key from a file id +subroutine get_key_name(file_id, key_id, key_name) + integer, intent(in) :: key_id !< Id of the key-value pair of interest + integer, intent(in) :: file_id !< File id of the yaml file' to search + character(len=*), intent(out) :: key_name + + key_name = fms_c2f_string(get_key(file_id, key_id)) + +end subroutine get_key_name + +!> @brief Gets the value from a file id +subroutine get_key_value(file_id, key_id, key_value) + integer, intent(in) :: key_id !< Id of the key-value pair of interest + integer, intent(in) :: file_id !< File id of the yaml file' to search + character(len=*), intent(out) :: key_value + + key_value = fms_c2f_string(get_value(file_id, key_id)) + +end subroutine get_key_value + +!> @brief Used to dermine the value of a key from a keyname +subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_optional) + integer, intent(in) :: file_id !< File id of the yaml file' to search + integer, intent(in) :: block_id !< ID corresponding' to the block you want the key for + character(len=*), intent(in) :: key_name !< Name of the key you want the value for + class(*), intent(inout):: key_value !< Value of the key + logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key' to not exist. + !! If the key does not exist key_value will not be set, so it + !! is the user's responsibility' to initialize it before the call + + character(len=255) :: buffer !< String buffer with the value + + type(c_ptr) :: c_buffer !< c pointer with the value + logical(kind=c_bool) :: sucess !< Flag indicating if the value was obtained sucessfully + logical :: optional !< Flag indicating that the key was optional + integer :: err_unit !< integer with io error + + if (present(is_optional)) optional = is_optional + + c_buffer = get_value_from_key_wrap(file_id, block_id, key_name, sucess) + if (sucess) then + buffer = fms_c2f_string(c_buffer) + + select type (key_value) + type is (integer(kind=i4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i4") + type is (integer(kind=i8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i8") + type is (real(kind=r4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r4") + type is (real(kind=r8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r8") + type is (character(len=*)) + key_value = buffer + class default + call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//& + &" is not supported. Only i4, i8, r4, r8 and strings are supported.") + end select + endif + if(.not. sucess .and. .not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) + +end subroutine get_value_from_key_0d + +!> @brief Used' to dermine the 1D value of a key from a keyname +subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_optional) + integer, intent(in) :: file_id !< File id of the yaml file' to search + integer, intent(in) :: block_id !< ID corresponding' to the block you want the key for + character(len=*), intent(in) :: key_name !< Name of the key you want the value for + class(*), intent(inout):: key_value(:) !< Value of the key + logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key' to not exist. + !! If the key does not exist key_value will not be set, so it + !! is the user's responsibility' to initialize it before the call + + character(len=255) :: buffer !< String buffer with the value + + type(c_ptr) :: c_buffer !< c pointer with the value + logical(kind=c_bool) :: sucess !< Flag indicating if the value was obtained sucessfully + logical :: optional !< Flag indicating that the key was optional + integer :: err_unit !< integer with io error + + if (present(is_optional)) optional = is_optional + + c_buffer = get_value_from_key_wrap(file_id, block_id, key_name, sucess) + if (sucess) then + buffer = fms_c2f_string(c_buffer) + + select type (key_value) + type is (integer(kind=i4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i4") + type is (integer(kind=i8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to i8") + type is (real(kind=r4_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r4") + type is (real(kind=r8_kind)) + read(buffer,*, iostat=err_unit) key_value + if (err_unit .ne. 0) call mpp_error(FATAL, "Key:"//trim(key_name)//" Error converting '"//trim(buffer)//"' to r8") + type is (character(len=*)) + call mpp_error(FATAL, "get_value_from_key 1d string variables are not supported. Contact developers") + class default + call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//& + &" is not supported. Only i4, i8, r4, r8 and strings are supported.") + end select + endif + if(.not. sucess .and. .not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) + +end subroutine get_value_from_key_1d + +!> @brief Determines the number of blocks with block_name in the yaml file +!! If parent_block_id is present, it only counts those that belong' to that block +!! @return Number of blocks with block_name +function get_num_blocks(file_id, block_name, parent_block_id) & + result(nblocks) + + integer, intent(in) :: file_id !< File id of the yaml file' to search + character(len=*), intent(in) :: block_name !< The name of the block you are looking for + integer, intent(in), optional :: parent_block_id !< Id of the parent block + integer :: nblocks + + if (.not. present(parent_block_id)) then + nblocks=get_num_blocks_all(file_id, block_name) + else + nblocks=get_num_blocks_child(file_id, block_name, parent_block_id) + endif +end function get_num_blocks + +!> @brief Gets the the ids of the blocks with block_name in the yaml file +!! If parent_block_id is present, it only gets those that belong' to that block +subroutine get_block_ids(file_id, block_name, block_ids, parent_block_id) + + integer, intent(in) :: file_id !< File id of the yaml file' to search + character(len=*), intent(in) :: block_name !< The name of the block you are looking for + integer, intent(inout) :: block_ids(:) !< Id of blocks with block_name + integer, intent(in), optional :: parent_block_id !< Id of the parent_block + + if (.not. present(parent_block_id)) then + call get_block_ids_all(file_id, block_name, block_ids) + else + call get_block_ids_child(file_id, block_name, block_ids, parent_block_id) + endif +end subroutine get_block_ids + +#endif end module yaml_parser_mod diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index 1406abce32..3fe42272ef 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -1,70 +1,203 @@ +#ifdef use_yaml + #include #include #include -struct key_value_pairs { +typedef struct { int key_number; - char key[50]; - char value[50]; - char parent_name[50]; + char key[255]; + char value[255]; + char parent_name[255]; int parent_key; -}; +}key_value_pairs; -struct yaml_file { +typedef struct { int nkeys; - struct key_value_pairs keys[50]; -}; + key_value_pairs *keys; +}yaml_file; + +typedef struct { + yaml_file *files; +}file_type; + +file_type my_files; +int nfiles = 0; + +int get_nkeys(int *file_id, int *block_id) +{ + int nkeys = 0; + int i; + int j = *file_id; + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(my_files.files[j].keys[i].parent_key == *block_id && !strcmp(my_files.files[j].keys[i].parent_name, "") ) nkeys = nkeys + 1; + } + + return nkeys; + +} + +void get_key_ids(int *file_id, int *block_id, int key_ids[*]) +{ + int i; + int nkeys = -1; + int j = *file_id; + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(my_files.files[j].keys[i].parent_key == *block_id && !strcmp(my_files.files[j].keys[i].parent_name, "") ){ + nkeys = nkeys + 1; + key_ids[nkeys] = i; + } + } + + return; +} + +char *get_key(int *file_id, int *key_id) +{ + char *key_name; + int j = *file_id; + + key_name = malloc(sizeof(char) * (strlen(my_files.files[j].keys[*key_id].key) + 1)); + strcpy(key_name, my_files.files[j].keys[*key_id].key); + + return key_name; +} + +char *get_value(int *file_id, int *key_id) +{ + char *key_value; + int j = *file_id; + + key_value = malloc(sizeof(char) * (strlen(my_files.files[j].keys[*key_id].value) + 1)); + strcpy(key_value, my_files.files[j].keys[*key_id].value); + + return key_value; +} + +char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, bool *sucess) /*, char *key_name) */ +{ + int i; + int j = *file_id; + + char *key_value=NULL; + *sucess = false; + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if (my_files.files[j].keys[i].parent_key == *block_id) + { + if( strcmp(my_files.files[j].keys[i].key, key_name) == 0) + { + key_value = malloc(sizeof(char) * (strlen(my_files.files[j].keys[i].value) + 1)); + strcpy(key_value, my_files.files[j].keys[i].value); + *sucess = true; + break; + } + } + } + return key_value; +} + +int get_num_blocks_all(int *file_id, char *block_name) +{ + int nblocks = 0; + int i; + int j = *file_id; -struct yaml_file my_file; + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0) nblocks = nblocks + 1; + } -int get_num_blocks(char *block_name) + return nblocks; +} + +int get_num_blocks_child(int *file_id, char *block_name, int *parent_key_id) { int nblocks = 0; int i; + int j = *file_id; - for ( i = 1; i <= my_file.nkeys; i++ ) + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { - if(strcmp(my_file.keys[i].parent_name, block_name) == 0) nblocks = nblocks + 1; + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0 && my_files.files[j].keys[i].parent_key == *parent_key_id) nblocks = nblocks + 1; } return nblocks; } -bool get_block_keys(char *block_name, int nfiles, int p[*]) +void get_block_ids_all(int *file_id, char *block_name, int block_ids[*]) { int i; + int nblocks = -1; + int j = *file_id; - for ( i = 1; i <= my_file.nkeys; i++ ) + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { - if(strcmp(my_file.keys[i].parent_name, block_name) == 0) { - p[i] = my_file.keys[i].key_number; + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0) { + nblocks = nblocks + 1; + block_ids[nblocks] = my_files.files[j].keys[i].key_number; } } - return true; + return; +} + +void get_block_ids_child(int *file_id, char *block_name, int block_ids[*], int *parent_key_id ) +{ + int i; + int nblocks = -1; + int j = *file_id; + + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) + { + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0 && my_files.files[j].keys[i].parent_key == *parent_key_id) { + nblocks = nblocks + 1; + block_ids[nblocks] = my_files.files[j].keys[i].key_number; + } + } + return; } -int main(void) +bool open_and_parse_file_wrap(char *filename, int *file_id) { yaml_parser_t parser; yaml_token_t token; FILE *file; bool is_key = false; - char key_value[50]; + char key_value[255]; int layer = 0; int key_count=0; int parent[10]; int current_parent; - char layer_name[10][50]; - char current_layername[50]; + char layer_name[10][255]; + char current_layername[255]; int i; - printf("opening file: %s\n", "diag_table.yaml"); - file = fopen("diag_table.yaml", "r"); + int j; + + if (nfiles == 0 ) + { + my_files.files = (yaml_file*)calloc(1, sizeof(yaml_file)); + } else + { + my_files.files = realloc(my_files.files, (nfiles+1)*sizeof(yaml_file)); + } + + j = nfiles; + *file_id =j; + +/* printf("Opening file: %s.\nThere are %i files opened.\n", filename, j); */ + file = fopen(filename, "r"); + if (file == NULL) return false; - if(!yaml_parser_initialize(&parser)) - fputs("Failed to initialize parser!\n", stderr); + if(!yaml_parser_initialize(&parser)) return false; + + my_files.files[j].keys = (key_value_pairs*)calloc(1, sizeof(key_value_pairs)); - bool is_new=false; parent[0]=0; strcpy(layer_name[0], "TOP"); /* Set input file */ @@ -87,9 +220,21 @@ int main(void) { layer = layer + 1; - is_new=true; - if (strcmp(key_value, "")) strcpy(layer_name[layer], key_value); - /* printf("LAYER:%i NAME:%s for %s=%i\n", layer, layer_name[layer], layer_name[layer-1], parent[layer-1]); */ + if (strcmp(key_value, "")) + { + strcpy(layer_name[layer], key_value); + } + key_count = key_count + 1; + i = key_count; + my_files.files[j].keys = realloc(my_files.files[j].keys, (i+1)*sizeof(key_value_pairs)); + my_files.files[j].keys[i].key_number=i; + my_files.files[j].keys[i].parent_key = parent[layer-1]; + strcpy(my_files.files[j].keys[i].parent_name, layer_name[layer]); + strcpy(my_files.files[j].keys[i].key, ""); + strcpy(my_files.files[j].keys[i].value, ""); + parent[layer]=key_count; + /*printf("KEY:%i LAYER:%i NAME:%s for %s=%i\n", key_count, layer, layer_name[layer], layer_name[layer-1], parent[layer-1]); */ + break; } case YAML_BLOCK_END_TOKEN: @@ -104,19 +249,14 @@ int main(void) current_parent = parent[layer]; strcpy(current_layername, ""); key_count = key_count + 1; - if (is_new) { - parent[layer]=key_count; - current_parent = parent[layer-1]; - strcpy(current_layername, layer_name[layer]); - is_new = false; - } i = key_count; - my_file.keys[i].key_number=i; - my_file.keys[i].parent_key = current_parent; - strcpy(my_file.keys[i].parent_name, current_layername); - strcpy(my_file.keys[i].key, key_value); - strcpy(my_file.keys[i].value, token.data.scalar.value); - my_file.nkeys = key_count; + my_files.files[j].keys = realloc(my_files.files[j].keys, (i+1)*sizeof(key_value_pairs)); + my_files.files[j].keys[i].key_number=i; + my_files.files[j].keys[i].parent_key = current_parent; + strcpy(my_files.files[j].keys[i].parent_name, current_layername); + strcpy(my_files.files[j].keys[i].key, key_value); + strcpy(my_files.files[j].keys[i].value, token.data.scalar.value); + my_files.files[j].nkeys = key_count; /* printf("----> LAYER:%i LAYER_NAME=%s PARENT:%i, KEYCOUNT:%i KEY: %s VALUE: %s \n", layer, current_layername, current_parent, key_count, key_value, token.data.scalar.value); */ strcpy(key_value,""); } @@ -131,22 +271,16 @@ int main(void) yaml_token_delete(&token); yaml_parser_delete(&parser); - for ( i = 1; i <= my_file.nkeys; i++ ) { - printf("Key_number:%i Parent_key:%i Parent_name:%s Key:%s Value:%s \n", my_file.keys[i].key_number, my_file.keys[i].parent_key, my_file.keys[i].parent_name, my_file.keys[i].key, my_file.keys[i].value); - + for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { + printf("Key_number:%i Parent_key:%i Parent_name:%s Key:%s Value:%s \n", my_files.files[j].keys[i].key_number, my_files.files[j].keys[i].parent_key, my_files.files[j].keys[i].parent_name, my_files.files[j].keys[i].key, my_files.files[j].keys[i].value); } - printf("closing file: %s\n", "diag_table.yaml"); - fclose(file); - - int nfiles= get_num_blocks("diag_files"); - printf("diag_files = %i\n", nfiles); + printf("/\n"); - int block_keys[nfiles]; - if(get_block_keys("diag_files", nfiles, block_keys)){ - for ( i = 0; i <= nfiles-1; i++ ) { - printf("nfile:%i block_key=%i \n", i, block_keys[i]); - } - } + nfiles = nfiles + 1; +/* printf("closing file: %s\n", filename); */ + fclose(file); return true; } + +#endif diff --git a/test_fms/data_override/Makefile.am b/test_fms/data_override/Makefile.am index 252533e24b..c51af91888 100644 --- a/test_fms/data_override/Makefile.am +++ b/test_fms/data_override/Makefile.am @@ -29,12 +29,13 @@ AM_CPPFLAGS = -I$(top_srcdir)/include -I$(MODDIR) LDADD = $(top_builddir)/libFMS/libFMS.la # Build this test program. -check_PROGRAMS = test_get_grid_v1 test_data_override test_data_override_ongrid +check_PROGRAMS = test_data_yaml test_get_grid_v1 test_data_override test_data_override_ongrid # This is the source code for the test. test_data_override_SOURCES = test_data_override.F90 test_data_override_ongrid_SOURCES = test_data_override_ongrid.F90 test_get_grid_v1_SOURCES = test_get_grid_v1.F90 +test_data_yaml_SOURCES = test_data_yaml.F90 # Run the test program. TESTS = test_data_override2.sh @@ -44,4 +45,4 @@ EXTRA_DIST = input_base.nml diag_table_base data_table_base \ test_data_override2.sh # Clean up -CLEANFILES = input.nml *.nc* *.out diag_table data_table +CLEANFILES = input.nml *.nc* *.out diag_table diff --git a/test_fms/data_override/test_data_override2.sh b/test_fms/data_override/test_data_override2.sh index 873b97d686..785c14a496 100755 --- a/test_fms/data_override/test_data_override2.sh +++ b/test_fms/data_override/test_data_override2.sh @@ -30,18 +30,31 @@ # Run the ongrid test case with 2 halos in x and y touch input.nml +cat <<_EOF > data_table.yaml +data_table: + - gridname : "OCN" + fieldname_code : "runoff" + fieldname_file : "runoff" + file_name : "INPUT/runoff.daitren.clim.1440x1080.v20180328.nc" + interpol_method : "none" + factor : 1.0 +_EOF + printf '"OCN", "runoff", "runoff", "./INPUT/runoff.daitren.clim.1440x1080.v20180328.nc", "none" , 1.0' | cat > data_table [ ! -d "INPUT" ] && mkdir -p "INPUT" +echo "TEST 1" run_test test_data_override_ongrid 6 rm -rf "INPUT" # Run the ongrid test case again with no halos printf "&test_data_override_ongrid_nml \n nhalox=0 \n nhaloy=0\n/" | cat > input.nml [ ! -d "INPUT" ] && mkdir -p "INPUT" +echo "TEST 2" run_test test_data_override_ongrid 6 rm -rf "INPUT" # Run the get_grid_v1 test: +echo "TEST 3" run_test test_get_grid_v1 1 # Copy to builddir and rename data files for tests. diff --git a/test_fms/data_override/test_data_yaml.F90 b/test_fms/data_override/test_data_yaml.F90 new file mode 100644 index 0000000000..dfbdeed85f --- /dev/null +++ b/test_fms/data_override/test_data_yaml.F90 @@ -0,0 +1,50 @@ +program test_data_yaml + +use data_override_mod +use fms_mod, only: fms_init, fms_end + +implicit none + +#ifndef use_yaml +type(data_type), dimension(100) :: data_table +#else +type(data_type), dimension(:), allocatable :: data_table2 +#endif + +integer :: ntable +integer :: i + +call fms_init() +#ifndef use_yaml +call read_table(data_table, ntable) +do i = 1, ntable + print *, "Entry number:", i + print *, "gridname:", trim(data_table(i)%gridname) + print *, "fieldname_code:", trim(data_table(i)%fieldname_code) + print *, "fieldname_file:", trim(data_table(i)%fieldname_file) + print *, "file_name:", trim(data_table(i)%file_name) + print *, "interpol_method:", trim(data_table(i)%interpol_method) + print *, "factor:", data_table(i)%factor + print *, "grid:", data_table(i)%lon_start, data_table(i)%lon_end, data_table(i)%lat_start, data_table(i)%lat_end + print *, "region_type:", data_table(i)%region_type + print *, "" +enddo +#else +call read_table_yaml(data_table2, ntable) +do i = 1, ntable + print *, "Entry number:", i + print *, "gridname:", trim(data_table2(i)%gridname) + print *, "fieldname_code:", trim(data_table2(i)%fieldname_code) + print *, "fieldname_file:", trim(data_table2(i)%fieldname_file) + print *, "file_name:", trim(data_table2(i)%file_name) + print *, "interpol_method:", trim(data_table2(i)%interpol_method) + print *, "factor:", data_table2(i)%factor + print *, "grid:", data_table2(i)%lon_start, data_table2(i)%lon_end, data_table2(i)%lat_start, data_table2(i)%lat_end + print *, "region_type:", data_table2(i)%region_type + print *, "" +enddo +#endif + +call fms_end() + +end program test_data_yaml diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am index b47b784b28..1867c582fb 100644 --- a/test_fms/parser/Makefile.am +++ b/test_fms/parser/Makefile.am @@ -29,16 +29,17 @@ AM_CPPFLAGS = -I${top_srcdir}/include -I$(MODDIR) LDADD = ${top_builddir}/libFMS/libFMS.la # Build this test program. -check_PROGRAMS = test_yaml_parser +check_PROGRAMS = test_yaml_parser check_crashes # This is the source code for the test. test_yaml_parser_SOURCES = test_yaml_parser.F90 +check_crashes_SOURCES = check_crashes.F90 # Run the test program. -#TESTS = test_yaml_parser.sh +TESTS = test_yaml_parser.sh # Include these files with the distribution. -#EXTRA_DIST = test_yaml_parser.sh +EXTRA_DIST = test_yaml_parser.sh data_table.yaml diag_table.yaml # Clean up CLEANFILES = input.nml *.nc* *.out diff --git a/test_fms/parser/check_crashes.F90 b/test_fms/parser/check_crashes.F90 new file mode 100644 index 0000000000..f4451ea5ea --- /dev/null +++ b/test_fms/parser/check_crashes.F90 @@ -0,0 +1,78 @@ +program check_crashes +#ifdef use_yaml +use yaml_parser_mod +use mpp_mod +use fms_mod, only : fms_init, fms_end + +implicit none + +integer :: io_status +logical :: missing_file = .false. +logical :: bad_conversion = .false. +logical :: missing_key = .false. +logical :: wrong_buffer_size = .false. +logical :: get_key_name_bad_id = .false. + +namelist / check_crashes_nml / missing_file, bad_conversion, missing_key, wrong_buffer_size, get_key_name_bad_id + +call fms_init + +read (input_nml_file, check_crashes_nml, iostat=io_status) +if (io_status > 0) call mpp_error(FATAL,'=>check_crashes: Error reading input.nml') + +!< Bad file id +if (missing_file) call check_read_and_parse_file_missing +if (bad_conversion) call check_bad_conversion +if (missing_key) call check_missing_key +if (wrong_buffer_size) call check_wrong_buffer_size +if (get_key_name_bad_id) call check_get_key_name_bad_id + +call fms_end + +contains + +!> @brief This is to check if the parser crashes correctly if user tries to open a missing file. +subroutine check_read_and_parse_file_missing + integer :: yaml_file_id + yaml_file_id = open_and_parse_file("missing") +end subroutine check_read_and_parse_file_missing + +!> @brief This is to check if the parser crashes correctly if user sends a buffer of the wrong type +subroutine check_bad_conversion + integer :: yaml_file_id + real :: buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_value_from_key(yaml_file_id, 9, "varName", buffer) +end subroutine check_bad_conversion + +!> @brief This is to check if the parser crashes correctly if user tries to get they value for a key +!! that doesn't exist +subroutine check_missing_key + integer :: yaml_file_id + real :: buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_value_from_key(yaml_file_id, 9, "missing", buffer) +end subroutine check_missing_key + +subroutine check_get_key_name_bad_id + integer :: yaml_file_id + character(len=10) :: buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_value(yaml_file_id, 666, buffer) + +end subroutine check_get_key_name_bad_id + +subroutine check_wrong_buffer_size + integer :: yaml_file_id + integer :: file_ids(1) + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_block_ids(yaml_file_id, "diag_files", file_ids) + print *, file_ids + +end subroutine check_wrong_buffer_size +#endif +end program check_crashes diff --git a/test_fms/parser/data_table.yaml b/test_fms/parser/data_table.yaml new file mode 100644 index 0000000000..a68ed45094 --- /dev/null +++ b/test_fms/parser/data_table.yaml @@ -0,0 +1,18 @@ +data_table: + - gridname : "ICE" + fieldname_code : "sic_obs" + fieldname_file : "ice" + file_name : "INPUT/hadisst_ice.data.nc" + interpol_method : "bilinear" + factor : 0.01 + - gridname : "WUT" + fieldname_code : "potato" + fieldname_file : "mullions" + file_name : "INPUT/potato.nc" + interpol_method : "bilinear" + factor : 1e-06 + region_type : "inside_region" + lat_start : -89.1 + lat_end : 89.8 + lon_start : 3.4 + lon_end : 154.4 diff --git a/test_fms/parser/diag_table.yaml b/test_fms/parser/diag_table.yaml new file mode 100644 index 0000000000..98f3ca9333 --- /dev/null +++ b/test_fms/parser/diag_table.yaml @@ -0,0 +1,26 @@ +title: c384L49_esm5PIcontrol +baseDate: [1960 1 1 1 1 1 1] +diag_files: +- fileName: "atmos_daily" + freq: 24 + frequnit: hours + timeunit: days + unlimdim: time + varlist: + - varName: tdata + mullions: 10 + fill_value: -999.9 + - varName: pdata + outName: pressure + reduction: False + kind: double + module: "moist" +- fileName: atmos_8xdaily + freq: 3 + frequnit: hours + timeunit: days + unlimdim: time + varlist: + - varName: tdata + reduction: False + module: "moist" diff --git a/test_fms/parser/test_yaml_parser.F90 b/test_fms/parser/test_yaml_parser.F90 index 5f9c40cda7..9ed0cd3e0e 100644 --- a/test_fms/parser/test_yaml_parser.F90 +++ b/test_fms/parser/test_yaml_parser.F90 @@ -1,23 +1,142 @@ -program test_yaml_parser +program test_read_and_parse_file +#ifdef use_yaml use yaml_parser_mod use mpp_mod use fms_mod, only : fms_init, fms_end +use platform_mod implicit none -call do_stuff() +integer :: yaml_file_id1, nfiles, nvariables +integer, allocatable :: file_ids(:) +integer, allocatable :: variable_ids(:) +integer :: yaml_file_id2, nentries +integer, allocatable :: entries_ids(:) +integer :: i, j, k !< For do loops +integer :: zero +character(len=20) :: string_buffer +integer(kind=i4_kind) :: i4_buffer +integer(kind=i8_kind) :: i8_buffer +real(kind=r4_kind) :: r4_buffer +real(kind=r8_kind) :: r8_buffer +integer :: nkeys +integer, allocatable :: key_ids(:) +character(len=20) :: key_name +character(len=20) :: key_value +logical :: wut -#ifdef use_yaml +call fms_init -call fms_init() -if (read_and_parse_file("diag_table.yaml")) then - print *, "The yaml file was read bro ^" -else - call mpp_error(FATAL, "The file was not opened sucessfully, get help!") -endif -call fms_end() +!< Test open_and_parse_file +yaml_file_id1 = open_and_parse_file("diag_table.yaml") +if (yaml_file_id1 .ne. 0) call mpp_error(FATAL, "The yaml_file_id for this file should be 0") -#endif +!< Test if multiple files can be opened +yaml_file_id2 = open_and_parse_file("data_table.yaml") +if (yaml_file_id2 .ne. 1) call mpp_error(FATAL, "The yaml_file_id for this file should be 1") + +!< ----------------------------------- + +!< Test get_num_blocks +nfiles = get_num_blocks(yaml_file_id1, "diag_files") +if (nfiles .ne. 2) call mpp_error(FATAL, "There should be only 2 diag_files") + +!< Test if a different yaml file id will work +nentries = get_num_blocks(yaml_file_id2, "data_table") +if (nentries .ne. 2) call mpp_error(FATAL, "There should be only 2 entries") + +!< Try to look for a block that does not exist! +zero = get_num_blocks(yaml_file_id2, "diag_files") +if (zero .ne. 0) call mpp_error(FATAL, "'diag_files' should not exist in this file") + +!< Try the parent block_id optional argument +nvariables = get_num_blocks(yaml_file_id1, "varlist", parent_block_id=3) !< Number of variables that belong to the atmos_daily file in the diag_table.yaml +if (nvariables .ne. 2) call mpp_error(FATAL, "There should only be 2 variables in the atmos_daily file") + +!< ----------------------------------- + +!< Test get_block_ids +allocate(file_ids(nfiles)) +call get_block_ids(yaml_file_id1, "diag_files", file_ids) +if(file_ids(1) .ne. 3 .or. file_ids(2) .ne. 19) call mpp_error(FATAL, "The file_ids are wrong!") + +!< Test to see if a diffrent yaml file id will work +allocate(entries_ids(nentries)) +call get_block_ids(yaml_file_id2, "data_table", entries_ids) +if(entries_ids(1) .ne. 1 .or. entries_ids(2) .ne. 8) call mpp_error(FATAL, "The entry_ids are wrong!") + +!< Try the parent block id optional argument +allocate(variable_ids(nvariables)) +call get_block_ids(yaml_file_id1, "varlist", variable_ids, parent_block_id=3) +if (variable_ids(1) .ne. 9 .or. variable_ids(2) .ne. 13) call mpp_error(FATAL, "The variable_ids are wrong!") + +!< Error check: *_ids is not the correct size + +!< ----------------------------------- + +!< Test get_value_from_key +!! Try get_value_from_key using a string buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "varName", string_buffer) +if (trim(string_buffer) .ne. "tdata") call mpp_error(FATAL, "varName was not read correctly!") + +!! Try get_value_from_key using a i4 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "mullions", i4_buffer) +if (i4_buffer .ne. int(10, kind=i4_kind)) call mpp_error(FATAL, "mullions was not read correctly as an i4!") -end program test_yaml_parser +!! Try get_value_from_key using a i8 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "mullions", i8_buffer) +if (i8_buffer .ne. int(10, kind=i8_kind)) call mpp_error(FATAL, "mullions was not read correctly as an i8!") + +!! Try get_value_from_key using a r4 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "fill_value", r4_buffer) +if (r4_buffer .ne. real(-999.9, kind=r4_kind)) call mpp_error(FATAL, "fill_value was not read correctly as an r4!") + +!! Try get_value_from_key using a r8 buffer +call get_value_from_key(yaml_file_id1, variable_ids(1), "fill_value", r8_buffer) +if (r8_buffer .ne. real(-999.9, kind=r8_kind)) call mpp_error(FATAL, "fill_value was not read correctly as an r8!") + +!! Try the is_optional argument on an key that does not exist +string_buffer = "" +call get_value_from_key(yaml_file_id1, variable_ids(1), "NANANANA", string_buffer, is_optional=.true.) +if (trim(string_buffer) .ne. "") call mpp_error(FATAL, "string_buffer was set when they key does not exist?") + +!< ----------------------------------- + +!< Test nkeys +nkeys = get_nkeys(yaml_file_id1, variable_ids(1)) +if (nkeys .ne. 3) call mpp_error(FATAL, "The number of keys was not read correctly") + +!! Try to get the number of keys from a variable_id that doesn't exist +zero = get_nkeys(yaml_file_id1, 666) +if (zero .ne. 0) call mpp_error(FATAL, "The number of keys was not read correctly for a block id that does not exist") + +!< ----------------------------------- + +!< Test get_key_ids +allocate(key_ids(nkeys)) +call get_key_ids(yaml_file_id1, variable_ids(1), key_ids) +if (key_ids(1) .ne. 10 .or. key_ids(2) .ne. 11 .or. key_ids(3) .ne. 12) call mpp_error(FATAL, "The key ids obtained are wrong") + +!< Error check: *_ids is not the correct size + +!< ----------------------------------- + +!< Test get_key_name +call get_key_name(yaml_file_id1, key_ids(1), key_name) +if ((trim(key_name) .ne. "varName")) call mpp_error(FATAL, "get_key_name did not output the correct name") + +!< Test get_key_value +call get_key_value(yaml_file_id1, key_ids(1), key_value) +if ((trim(key_value) .ne. "tdata")) call mpp_error(FATAL, "get_key_name did not output the correct name") + +!< Error check wrong id + +deallocate(key_ids) +deallocate(variable_ids) +deallocate(entries_ids) +deallocate(file_ids) + +call fms_end +#endif +end program diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh new file mode 100755 index 0000000000..33f5532ad7 --- /dev/null +++ b/test_fms/parser/test_yaml_parser.sh @@ -0,0 +1,66 @@ +#!/bin/sh + +#*********************************************************************** +#* 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 . +#*********************************************************************** + +# This is part of the GFDL FMS package. This is a shell script to +# execute tests in the test_fms/data_override directory. + +# Set common test settings. +. ../test_common.sh + +# Run the ongrid test case with 2 halos in x and y +touch input.nml + +run_test test_yaml_parser 1 + +printf "&check_crashes_nml \n missing_file = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n bad_conversion = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n missing_key = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_name_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +#printf "&check_crashes_nml \n wrong_buffer_size = .true. \n/" | cat > input.nml +#run_test check_crashes 1 && echo "It worked?" +#if [ $? -eq 0 ]; then +# echo "The test should have failed" +# exit 3 +#fi From 9f63bd0490eec7c94f31f2fae2c6a7bf7d25957e Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 26 Oct 2021 12:26:14 -0400 Subject: [PATCH 03/16] Skips the parser tests if not using yaml --- configure.ac | 4 ++++ test_fms/parser/Makefile.am | 7 +++++++ test_fms/parser/test_yaml_parser.sh | 10 +++++----- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index 1b393782bd..2ec32cd803 100644 --- a/configure.ac +++ b/configure.ac @@ -135,6 +135,10 @@ if test $with_yaml = yes; then #If the test pass, define use_yaml macro AC_DEFINE([use_yaml], [1], [This is required to use yaml parser]) + + AM_CONDITIONAL([SKIP_PARSER_TESTS], false ) +else + AM_CONDITIONAL([SKIP_PARSER_TESTS], true ) fi # Require netCDF diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am index 1867c582fb..25d8f7f824 100644 --- a/test_fms/parser/Makefile.am +++ b/test_fms/parser/Makefile.am @@ -41,5 +41,12 @@ TESTS = test_yaml_parser.sh # Include these files with the distribution. EXTRA_DIST = test_yaml_parser.sh data_table.yaml diag_table.yaml +if SKIP_PARSER_TESTS +skipflag="skip" +else +skipflag="" +endif + +TESTS_ENVIRONMENT = parser_skip=${skipflag} # Clean up CLEANFILES = input.nml *.nc* *.out diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh index 33f5532ad7..f993762a99 100755 --- a/test_fms/parser/test_yaml_parser.sh +++ b/test_fms/parser/test_yaml_parser.sh @@ -28,31 +28,31 @@ # Run the ongrid test case with 2 halos in x and y touch input.nml -run_test test_yaml_parser 1 +run_test test_yaml_parser 1 $parser_skip printf "&check_crashes_nml \n missing_file = .true. \n/" | cat > input.nml -run_test check_crashes 1 && echo "It worked?" +run_test check_crashes 1 $parser_skip && echo "It worked?" if [ $? -eq 0 ]; then echo "The test should have failed" exit 3 fi printf "&check_crashes_nml \n bad_conversion = .true. \n/" | cat > input.nml -run_test check_crashes 1 && echo "It worked?" +run_test check_crashes 1 $parser_skip && echo "It worked?" if [ $? -eq 0 ]; then echo "The test should have failed" exit 3 fi printf "&check_crashes_nml \n missing_key = .true. \n/" | cat > input.nml -run_test check_crashes 1 && echo "It worked?" +run_test check_crashes 1 $parser_skip && echo "It worked?" if [ $? -eq 0 ]; then echo "The test should have failed" exit 3 fi printf "&check_crashes_nml \n get_key_name_bad_id = .true. \n/" | cat > input.nml -run_test check_crashes 1 && echo "It worked?" +run_test check_crashes 1 $parser_skip && echo "It worked?" if [ $? -eq 0 ]; then echo "The test should have failed" exit 3 From e8309b84add31abafc4fbddc4522e0f865f9a298 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 26 Oct 2021 12:39:07 -0400 Subject: [PATCH 04/16] clean up after data_override tests --- test_fms/data_override/Makefile.am | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test_fms/data_override/Makefile.am b/test_fms/data_override/Makefile.am index c51af91888..b3115bf514 100644 --- a/test_fms/data_override/Makefile.am +++ b/test_fms/data_override/Makefile.am @@ -45,4 +45,4 @@ EXTRA_DIST = input_base.nml diag_table_base data_table_base \ test_data_override2.sh # Clean up -CLEANFILES = input.nml *.nc* *.out diag_table +CLEANFILES = input.nml *.nc* *.out diag_table data_table data_table.yaml From 51ae66b61ad2fe623651205b924985b90c142763 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 26 Oct 2021 17:24:42 -0400 Subject: [PATCH 05/16] Attempt to get documentation to show up in the fms site --- parser/yaml_parser.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index 46e6211f17..eb2c8215f6 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -1,3 +1,11 @@ +!> @defgroup yaml_parser_mod yaml_parser_mod +!> @brief Routines to use for parsing yaml files + +!> @file +!> @brief File for @ref yaml_parser_mod + +!> @addtogroup yaml_parser_mod +!> @{ module yaml_parser_mod #ifdef use_yaml @@ -18,14 +26,18 @@ module yaml_parser_mod public :: get_key_name public :: get_key_value !public :: clean_up +!> @} !> @brief Dermine the value of a key from a keyname +!> @ingroup yaml_parser_mod interface get_value_from_key module procedure get_value_from_key_0d module procedure get_value_from_key_1d end interface get_value_from_key -interface +!> @brief c functions binding +!> @ingroup yaml_parser_mod +interface c_functions !> @brief Private c function that opens and parses a yaml file (see yaml_parser_binding.c) !! @return Flag indicating if the read was sucessful @@ -134,6 +146,8 @@ end subroutine get_block_ids_child end interface +!> @addtogroup yaml_parser_mod +!> @{ contains !> @brief Opens and parses a yaml file @@ -301,3 +315,5 @@ end subroutine get_block_ids #endif end module yaml_parser_mod +!> @} +! close documentation grouping From 42bb6a4221176b900137af8df512a531ae0dbdb4 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 26 Oct 2021 17:33:07 -0400 Subject: [PATCH 06/16] Attempt2 to get documentation to show up in the fms site --- docs/grouping.h | 4 ++++ parser/yaml_parser.F90 | 1 + 2 files changed, 5 insertions(+) diff --git a/docs/grouping.h b/docs/grouping.h index c2c75a631d..2e2f7a82de 100644 --- a/docs/grouping.h +++ b/docs/grouping.h @@ -114,6 +114,10 @@ * */ +/** @defgroup parser Parser + * + */ + /** @defgroup platform Platform * */ diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index eb2c8215f6..a85909a0a0 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -1,4 +1,5 @@ !> @defgroup yaml_parser_mod yaml_parser_mod +!> @ingroup parser !> @brief Routines to use for parsing yaml files !> @file From c3011b9302b28a9516b910711e3aab714812d5bc Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 27 Oct 2021 12:36:58 -0400 Subject: [PATCH 07/16] Attempt to write the doxygen for the yaml parser --- docs/Doxyfile.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/Doxyfile.in b/docs/Doxyfile.in index 345e0d82cc..63ac4a5084 100644 --- a/docs/Doxyfile.in +++ b/docs/Doxyfile.in @@ -2033,7 +2033,7 @@ INCLUDE_FILE_PATTERNS = *.inc # recursively expanded use the := operator instead of the = operator. # This tag requires that the tag ENABLE_PREPROCESSING is set to YES. -PREDEFINED = +PREDEFINED = use_yaml # If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then this # tag can be used to specify a list of macro names that should be expanded. The From a7d4a243ef4bf8c88bff257b5c3e91051c4e792d Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 27 Oct 2021 16:49:55 -0400 Subject: [PATCH 08/16] Adds licenses fix typos --- parser/yaml_parser.F90 | 75 ++++++++++++++++++++++-------------- parser/yaml_parser_binding.c | 19 +++++++++ 2 files changed, 66 insertions(+), 28 deletions(-) diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index a85909a0a0..7fa0bd4b44 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -1,3 +1,22 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** + !> @defgroup yaml_parser_mod yaml_parser_mod !> @ingroup parser !> @brief Routines to use for parsing yaml files @@ -38,7 +57,7 @@ module yaml_parser_mod !> @brief c functions binding !> @ingroup yaml_parser_mod -interface c_functions +interface !> @brief Private c function that opens and parses a yaml file (see yaml_parser_binding.c) !! @return Flag indicating if the read was sucessful @@ -46,7 +65,7 @@ function open_and_parse_file_wrap(filename, file_id) bind(c) & result(sucess) use iso_c_binding, only: c_char, c_int, c_bool character(kind=c_char), intent(in) :: filename(*) !< Filename of the yaml file - integer(kind=c_int), intent(out) :: file_id !< File id corresponding' to the yaml file that was opened + integer(kind=c_int), intent(out) :: file_id !< File id corresponding to the yaml file that was opened logical(kind=c_bool) :: sucess !< Flag indicating if the read was sucessful end function open_and_parse_file_wrap @@ -55,7 +74,7 @@ end function open_and_parse_file_wrap function get_nkeys(file_id, block_id) bind(c) & result(nkeys) use iso_c_binding, only: c_char, 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) :: file_id !< File id corresponding to the yaml file that was opened integer(kind=c_int), intent(in) :: block_id !< Id of the parent_block integer(kind=c_int) :: nkeys end function get_nkeys @@ -63,7 +82,7 @@ end function get_nkeys !> @brief c function that gets the ids of the key-value pairs in a block (see yaml_parser_binding.c) subroutine get_key_ids(file_id, block_id, key_ids) bind(c) use iso_c_binding, only: c_char, 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) :: file_id !< File id corresponding to the yaml file that was opened integer(kind=c_int), intent(in) :: block_id !< Id of the parent_block integer(kind=c_int), intent(inout) :: key_ids(*) !< Ids of the key-value pairs end subroutine get_key_ids @@ -73,7 +92,7 @@ end subroutine get_key_ids function get_key(file_id, key_id) bind(c) & result(key_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) :: file_id !< File id corresponding to the yaml file that was opened integer(kind=c_int), intent(in) :: key_id !< Id of the key-value pair of interest type(c_ptr) :: key_name end function get_key @@ -83,7 +102,7 @@ end function get_key function get_value(file_id, key_id) bind(c) & result(key_value) 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) :: file_id !< File id corresponding to the yaml file that was opened integer(kind=c_int), intent(in) :: key_id !< Id of the key-value pair of interest type(c_ptr) :: key_value end function get_value @@ -94,8 +113,8 @@ function get_value_from_key_wrap(file_id, block_id, key_name, sucess) bind(c) & result(key_value2) use iso_c_binding, only: c_ptr, 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), intent(in) :: block_id !< ID corresponding' to the block you want the key for + integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search + integer(kind=c_int), intent(in) :: block_id !< ID corresponding to the block you want the key for character(kind=c_char), intent(in) :: key_name !< Name of the key you want the value for logical(kind=c_bool), intent(out) :: sucess !< Flag indicating if the call was sucessful type(c_ptr) :: key_value2 @@ -107,7 +126,7 @@ end function get_value_from_key_wrap function get_num_blocks_all(file_id, block_name) 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), intent(in) :: file_id !< File id of the yaml file to search character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for integer(kind=c_int) :: nblocks @@ -119,7 +138,7 @@ end function get_num_blocks_all function get_num_blocks_child(file_id, block_name, 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), intent(in) :: file_id !< File id of the yaml file to search character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for integer(kind=c_int) :: parent_block_id !< Id of the parent block @@ -130,16 +149,16 @@ end function get_num_blocks_child !! (see yaml_parser_binding.c) subroutine get_block_ids_all(file_id, block_name, block_ids) bind(c) 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), intent(in) :: file_id !< File id of the yaml file to search character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for integer(kind=c_int), intent(inout) :: block_ids(*) !< Id of the parent_block end subroutine get_block_ids_all !> @brief Private c function that gets the the ids of the blocks with block_name and that -!! belong' to a parent block id in the yaml file (see yaml_parser_binding.c) +!! belong to a parent block id in the yaml file (see yaml_parser_binding.c) subroutine get_block_ids_child(file_id, block_name, block_ids, parent_block_id) bind(c) 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), intent(in) :: file_id !< File id of the yaml file to search character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for 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 @@ -152,7 +171,7 @@ end subroutine get_block_ids_child contains !> @brief Opens and parses a yaml file -!! @return A file id corresponding' to the file that was opened +!! @return A file id corresponding to the file that was opened function open_and_parse_file(filename) & result(file_id) @@ -169,7 +188,7 @@ end function open_and_parse_file !> @brief Gets the key from a file id subroutine get_key_name(file_id, key_id, key_name) integer, intent(in) :: key_id !< Id of the key-value pair of interest - integer, intent(in) :: file_id !< File id of the yaml file' to search + integer, intent(in) :: file_id !< File id of the yaml file to search character(len=*), intent(out) :: key_name key_name = fms_c2f_string(get_key(file_id, key_id)) @@ -179,7 +198,7 @@ end subroutine get_key_name !> @brief Gets the value from a file id subroutine get_key_value(file_id, key_id, key_value) integer, intent(in) :: key_id !< Id of the key-value pair of interest - integer, intent(in) :: file_id !< File id of the yaml file' to search + integer, intent(in) :: file_id !< File id of the yaml file to search character(len=*), intent(out) :: key_value key_value = fms_c2f_string(get_value(file_id, key_id)) @@ -188,13 +207,13 @@ end subroutine get_key_value !> @brief Used to dermine the value of a key from a keyname subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_optional) - integer, intent(in) :: file_id !< File id of the yaml file' to search - integer, intent(in) :: block_id !< ID corresponding' to the block you want the key for + integer, intent(in) :: file_id !< File id of the yaml file to search + integer, intent(in) :: block_id !< ID corresponding to the block you want the key for character(len=*), intent(in) :: key_name !< Name of the key you want the value for class(*), intent(inout):: key_value !< Value of the key - logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key' to not exist. - !! If the key does not exist key_value will not be set, so it - !! is the user's responsibility' to initialize it before the call + logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key to not exist. + !! If the key does not exist key_value will not be set, so it + !! is the user's responsibility to initialize it before the call character(len=255) :: buffer !< String buffer with the value @@ -235,13 +254,13 @@ end subroutine get_value_from_key_0d !> @brief Used' to dermine the 1D value of a key from a keyname subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_optional) - integer, intent(in) :: file_id !< File id of the yaml file' to search - integer, intent(in) :: block_id !< ID corresponding' to the block you want the key for + integer, intent(in) :: file_id !< File id of the yaml file to search + integer, intent(in) :: block_id !< ID corresponding to the block you want the key for character(len=*), intent(in) :: key_name !< Name of the key you want the value for class(*), intent(inout):: key_value(:) !< Value of the key logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key' to not exist. !! If the key does not exist key_value will not be set, so it - !! is the user's responsibility' to initialize it before the call + !! is the user's responsibility to initialize it before the call character(len=255) :: buffer !< String buffer with the value @@ -281,12 +300,12 @@ subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_opti end subroutine get_value_from_key_1d !> @brief Determines the number of blocks with block_name in the yaml file -!! If parent_block_id is present, it only counts those that belong' to that block +!! If parent_block_id is present, it only counts those that belong to that block !! @return Number of blocks with block_name function get_num_blocks(file_id, block_name, parent_block_id) & result(nblocks) - integer, intent(in) :: file_id !< File id of the yaml file' to search + integer, intent(in) :: file_id !< File id of the yaml file to search character(len=*), intent(in) :: block_name !< The name of the block you are looking for integer, intent(in), optional :: parent_block_id !< Id of the parent block integer :: nblocks @@ -299,10 +318,10 @@ function get_num_blocks(file_id, block_name, parent_block_id) & end function get_num_blocks !> @brief Gets the the ids of the blocks with block_name in the yaml file -!! If parent_block_id is present, it only gets those that belong' to that block +!! If parent_block_id is present, it only gets those that belong to that block subroutine get_block_ids(file_id, block_name, block_ids, parent_block_id) - integer, intent(in) :: file_id !< File id of the yaml file' to search + integer, intent(in) :: file_id !< File id of the yaml file to search character(len=*), intent(in) :: block_name !< The name of the block you are looking for integer, intent(inout) :: block_ids(:) !< Id of blocks with block_name integer, intent(in), optional :: parent_block_id !< Id of the parent_block diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index 3fe42272ef..d2d4190747 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -1,3 +1,22 @@ +/*********************************************************************** + * 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 . + **********************************************************************/ + #ifdef use_yaml #include From 2cf86098091f9290f879c3aa0139e5a1cb74137f Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 28 Oct 2021 16:48:23 -0400 Subject: [PATCH 09/16] Fix issue to get read_data_table_yaml correctly --- data_override/data_override.F90 | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/data_override/data_override.F90 b/data_override/data_override.F90 index 70b46058a9..a65658f637 100644 --- a/data_override/data_override.F90 +++ b/data_override/data_override.F90 @@ -162,13 +162,7 @@ module data_override_mod public :: data_override_init, data_override, data_override_unset_domains -public :: data_override_UG, data_type - -#ifdef use_yaml -public :: read_table_yaml -#else -public :: read_table -#endif +public :: data_override_UG contains function count_ne_1(in_1, in_2, in_3) @@ -532,7 +526,7 @@ subroutine read_table_yaml(data_table, ntable_out) end do if(present(ntable_out)) ntable_out = nentries - + table_size = nentries !< Because one variable is not enough end subroutine read_table_yaml #endif From c9c3a87237e2fd954316d373d3419b640d835bd0 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 28 Oct 2021 17:14:31 -0400 Subject: [PATCH 10/16] Clean up the data_override libyaml section --- data_override/data_override.F90 | 67 +++++++++++------------ test_fms/data_override/Makefile.am | 3 +- test_fms/data_override/test_data_yaml.F90 | 50 ----------------- 3 files changed, 32 insertions(+), 88 deletions(-) delete mode 100644 test_fms/data_override/test_data_yaml.F90 diff --git a/data_override/data_override.F90 b/data_override/data_override.F90 index a65658f637..e6f9dcd575 100644 --- a/data_override/data_override.F90 +++ b/data_override/data_override.F90 @@ -347,9 +347,8 @@ subroutine data_override_init(Atm_domain_in, Ocean_domain_in, Ice_domain_in, Lan end subroutine data_override_init #ifndef use_yaml -subroutine read_table(data_table, ntable_out) +subroutine read_table(data_table) type(data_type), dimension(max_table), intent(inout) :: data_table - integer, intent(out), optional :: ntable_out integer :: ntable integer :: ntable_lima @@ -480,13 +479,11 @@ subroutine read_table(data_table, ntable_out) 'data_override_mod: New and old formats together in same data_table not supported') close(iunit, iostat=io_status) if(io_status/=0) call mpp_error(FATAL, 'data_override_mod: Error in closing file data_table') - if (present(ntable_out)) ntable_out = ntable end subroutine read_table #else -subroutine read_table_yaml(data_table, ntable_out) +subroutine read_table_yaml(data_table) type(data_type), dimension(:), allocatable, intent(out) :: data_table - integer, intent(out), optional :: ntable_out integer, allocatable :: entry_id(:) integer :: nentries @@ -495,37 +492,35 @@ subroutine read_table_yaml(data_table, ntable_out) integer :: file_id file_id = open_and_parse_file("data_table.yaml") - nentries = get_num_blocks(file_id, "data_table") - allocate(data_table(nentries)) - allocate(entry_id(nentries)) - call get_block_ids(file_id, "data_table", entry_id) - - do i = 1, nentries - call get_value_from_key(file_id, entry_id(i), "gridname", data_table(i)%gridname) - call get_value_from_key(file_id, entry_id(i), "fieldname_code", data_table(i)%fieldname_code) - call get_value_from_key(file_id, entry_id(i), "fieldname_file", data_table(i)%fieldname_file) - call get_value_from_key(file_id, entry_id(i), "file_name", data_table(i)%file_name) - call get_value_from_key(file_id, entry_id(i), "interpol_method", data_table(i)%interpol_method) - call get_value_from_key(file_id, entry_id(i), "factor", data_table(i)%factor) - call get_value_from_key(file_id, entry_id(i), "region_type", buffer, is_optional=.true.) - - if(trim(buffer) == "inside_region" ) then - data_table(i)%region_type = INSIDE_REGION - else if( trim(buffer) == "outside_region" ) then - data_table(i)%region_type = OUTSIDE_REGION - else - data_table(i)%region_type = NO_REGION - endif - - call get_value_from_key(file_id, entry_id(i), "lon_start", data_table(i)%lon_start, is_optional=.true.) - call get_value_from_key(file_id, entry_id(i), "lon_end", data_table(i)%lon_end, is_optional=.true.) - call get_value_from_key(file_id, entry_id(i), "lat_start", data_table(i)%lat_start, is_optional=.true.) - call get_value_from_key(file_id, entry_id(i), "lat_end", data_table(i)%lat_end, is_optional=.true.) - - print *, trim(data_table(i)%gridname), trim(data_table(i)%fieldname_code), trim(data_table(i)%fieldname_file), trim(data_table(i)%file_name), trim(data_table(i)%interpol_method), data_table(i)%factor - end do - - if(present(ntable_out)) ntable_out = nentries + nentries = get_num_blocks(file_id, "data_table") + allocate(data_table(nentries)) + allocate(entry_id(nentries)) + call get_block_ids(file_id, "data_table", entry_id) + + do i = 1, nentries + call get_value_from_key(file_id, entry_id(i), "gridname", data_table(i)%gridname) + call get_value_from_key(file_id, entry_id(i), "fieldname_code", data_table(i)%fieldname_code) + call get_value_from_key(file_id, entry_id(i), "fieldname_file", data_table(i)%fieldname_file) + call get_value_from_key(file_id, entry_id(i), "file_name", data_table(i)%file_name) + call get_value_from_key(file_id, entry_id(i), "interpol_method", data_table(i)%interpol_method) + call get_value_from_key(file_id, entry_id(i), "factor", data_table(i)%factor) + call get_value_from_key(file_id, entry_id(i), "region_type", buffer, is_optional=.true.) + + if(trim(buffer) == "inside_region" ) then + data_table(i)%region_type = INSIDE_REGION + else if( trim(buffer) == "outside_region" ) then + data_table(i)%region_type = OUTSIDE_REGION + else + data_table(i)%region_type = NO_REGION + endif + + call get_value_from_key(file_id, entry_id(i), "lon_start", data_table(i)%lon_start, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lon_end", data_table(i)%lon_end, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lat_start", data_table(i)%lat_start, is_optional=.true.) + call get_value_from_key(file_id, entry_id(i), "lat_end", data_table(i)%lat_end, is_optional=.true.) + + end do + table_size = nentries !< Because one variable is not enough end subroutine read_table_yaml #endif diff --git a/test_fms/data_override/Makefile.am b/test_fms/data_override/Makefile.am index b3115bf514..7564bec265 100644 --- a/test_fms/data_override/Makefile.am +++ b/test_fms/data_override/Makefile.am @@ -29,13 +29,12 @@ AM_CPPFLAGS = -I$(top_srcdir)/include -I$(MODDIR) LDADD = $(top_builddir)/libFMS/libFMS.la # Build this test program. -check_PROGRAMS = test_data_yaml test_get_grid_v1 test_data_override test_data_override_ongrid +check_PROGRAMS = test_get_grid_v1 test_data_override test_data_override_ongrid # This is the source code for the test. test_data_override_SOURCES = test_data_override.F90 test_data_override_ongrid_SOURCES = test_data_override_ongrid.F90 test_get_grid_v1_SOURCES = test_get_grid_v1.F90 -test_data_yaml_SOURCES = test_data_yaml.F90 # Run the test program. TESTS = test_data_override2.sh diff --git a/test_fms/data_override/test_data_yaml.F90 b/test_fms/data_override/test_data_yaml.F90 deleted file mode 100644 index dfbdeed85f..0000000000 --- a/test_fms/data_override/test_data_yaml.F90 +++ /dev/null @@ -1,50 +0,0 @@ -program test_data_yaml - -use data_override_mod -use fms_mod, only: fms_init, fms_end - -implicit none - -#ifndef use_yaml -type(data_type), dimension(100) :: data_table -#else -type(data_type), dimension(:), allocatable :: data_table2 -#endif - -integer :: ntable -integer :: i - -call fms_init() -#ifndef use_yaml -call read_table(data_table, ntable) -do i = 1, ntable - print *, "Entry number:", i - print *, "gridname:", trim(data_table(i)%gridname) - print *, "fieldname_code:", trim(data_table(i)%fieldname_code) - print *, "fieldname_file:", trim(data_table(i)%fieldname_file) - print *, "file_name:", trim(data_table(i)%file_name) - print *, "interpol_method:", trim(data_table(i)%interpol_method) - print *, "factor:", data_table(i)%factor - print *, "grid:", data_table(i)%lon_start, data_table(i)%lon_end, data_table(i)%lat_start, data_table(i)%lat_end - print *, "region_type:", data_table(i)%region_type - print *, "" -enddo -#else -call read_table_yaml(data_table2, ntable) -do i = 1, ntable - print *, "Entry number:", i - print *, "gridname:", trim(data_table2(i)%gridname) - print *, "fieldname_code:", trim(data_table2(i)%fieldname_code) - print *, "fieldname_file:", trim(data_table2(i)%fieldname_file) - print *, "file_name:", trim(data_table2(i)%file_name) - print *, "interpol_method:", trim(data_table2(i)%interpol_method) - print *, "factor:", data_table2(i)%factor - print *, "grid:", data_table2(i)%lon_start, data_table2(i)%lon_end, data_table2(i)%lat_start, data_table2(i)%lat_end - print *, "region_type:", data_table2(i)%region_type - print *, "" -enddo -#endif - -call fms_end() - -end program test_data_yaml From ca59ea198376cc5763a9f08e8424fe0ce403922f Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 4 Nov 2021 13:31:35 -0400 Subject: [PATCH 11/16] More clean up --- parser/yaml_parser.F90 | 120 +++++++++++++++--- parser/yaml_parser_binding.c | 40 ++++-- test_fms/parser/check_crashes.F90 | 177 ++++++++++++++++++++++++--- test_fms/parser/test_yaml_parser.F90 | 6 - test_fms/parser/test_yaml_parser.sh | 111 ++++++++++++++++- 5 files changed, 399 insertions(+), 55 deletions(-) diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index 7fa0bd4b44..bdd00699ca 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -69,23 +69,42 @@ function open_and_parse_file_wrap(filename, file_id) bind(c) & logical(kind=c_bool) :: sucess !< Flag indicating if the read was sucessful end function open_and_parse_file_wrap -!> @brief c function that gets the number of key-value pairs in a block (see yaml_parser_binding.c) +!> @brief Private c function that checks if a file_id is valid (see yaml_parser_binding.c) +!! @return Flag indicating if the file_id is valid +function is_valid_file_id(file_id) bind(c) & + result(is_valid) + use iso_c_binding, only: c_char, c_int, c_bool + integer(kind=c_int), intent(in) :: file_id !< File id corresponding to the yaml file that was opened + logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid +end function is_valid_file_id + +!> @brief Private c function that gets the number of key-value pairs in a block (see yaml_parser_binding.c) !! @return Number of key-value pairs in this block -function get_nkeys(file_id, block_id) bind(c) & +function get_nkeys_binding(file_id, block_id) bind(c) & result(nkeys) use iso_c_binding, only: c_char, 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 !< Id of the parent_block integer(kind=c_int) :: nkeys -end function get_nkeys +end function get_nkeys_binding -!> @brief c function that gets the ids of the key-value pairs in a block (see yaml_parser_binding.c) -subroutine get_key_ids(file_id, block_id, key_ids) bind(c) +!> @brief Private c function that gets the ids of the key-value pairs in a block (see yaml_parser_binding.c) +subroutine get_key_ids_binding(file_id, block_id, key_ids) bind(c) use iso_c_binding, only: c_char, 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 !< Id of the parent_block integer(kind=c_int), intent(inout) :: key_ids(*) !< Ids of the key-value pairs -end subroutine get_key_ids +end subroutine get_key_ids_binding + +!> @brief Private c function that checks if a key_id is valid (see yaml_parser_binding.c) +!! @return Flag indicating if the key_id is valid +function is_valid_key_id(file_id, key_id) bind(c) & + result(is_valid) + use iso_c_binding, only: c_char, 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) :: key_id !< Key id to check if valid + logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid +end function is_valid_key_id !> @brief Private c function that get the key from a key_id in a yaml file !! @return Name of the key obtained @@ -116,7 +135,7 @@ function get_value_from_key_wrap(file_id, block_id, key_name, sucess) bind(c) & integer(kind=c_int), intent(in) :: file_id !< File id of the yaml file to search integer(kind=c_int), intent(in) :: block_id !< ID corresponding to the block you want the key for character(kind=c_char), intent(in) :: key_name !< Name of the key you want the value for - logical(kind=c_bool), intent(out) :: sucess !< Flag indicating if the call was sucessful + integer(kind=c_int), intent(out) :: sucess !< Flag indicating if the call was sucessful type(c_ptr) :: key_value2 end function get_value_from_key_wrap @@ -164,6 +183,16 @@ subroutine get_block_ids_child(file_id, block_name, block_ids, parent_block_id) integer(kind=c_int) :: parent_block_id !< Id of the parent block end subroutine get_block_ids_child +!> @brief Private c function that checks if a block_id is valid (see yaml_parser_binding.c) +!! @return Flag indicating if the block_id is valid +function is_valid_block_id(file_id, block_id) bind(c) & + result(is_valid) + use iso_c_binding, only: c_char, 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 check if valid + logical(kind=c_bool) :: is_valid !< Flag indicating if the file_id is valid +end function is_valid_block_id + end interface !> @addtogroup yaml_parser_mod @@ -191,6 +220,9 @@ subroutine get_key_name(file_id, key_id, key_name) integer, intent(in) :: file_id !< File id of the yaml file to search character(len=*), intent(out) :: key_name + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_key_name call is invalid! Check your call.") + if (.not. is_valid_key_id(file_id, key_id)) call mpp_error(FATAL, "The key id in your get_key_name call is invalid! Check your call.") + key_name = fms_c2f_string(get_key(file_id, key_id)) end subroutine get_key_name @@ -201,6 +233,9 @@ subroutine get_key_value(file_id, key_id, key_value) integer, intent(in) :: file_id !< File id of the yaml file to search character(len=*), intent(out) :: key_value + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_key_value call is invalid! Check your call.") + if (.not. is_valid_key_id(file_id, key_id)) call mpp_error(FATAL, "The key id in your get_key_value call is invalid! Check your call.") + key_value = fms_c2f_string(get_value(file_id, key_id)) end subroutine get_key_value @@ -218,14 +253,18 @@ subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_opti character(len=255) :: buffer !< String buffer with the value type(c_ptr) :: c_buffer !< c pointer with the value - logical(kind=c_bool) :: sucess !< Flag indicating if the value was obtained sucessfully + integer(kind=c_int) :: sucess !< Flag indicating if the value was obtained sucessfully logical :: optional !< Flag indicating that the key was optional integer :: err_unit !< integer with io error + optional = .false. if (present(is_optional)) optional = is_optional + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_value_from_key call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_value_from_key call is invalid! Check your call.") + c_buffer = get_value_from_key_wrap(file_id, block_id, key_name, sucess) - if (sucess) then + if (sucess == 1) then buffer = fms_c2f_string(c_buffer) select type (key_value) @@ -247,8 +286,9 @@ subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_opti call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//& &" is not supported. Only i4, i8, r4, r8 and strings are supported.") end select + else + if(.not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) endif - if(.not. sucess .and. .not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) end subroutine get_value_from_key_0d @@ -259,20 +299,24 @@ subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_opti character(len=*), intent(in) :: key_name !< Name of the key you want the value for class(*), intent(inout):: key_value(:) !< Value of the key logical, intent(in), optional :: is_optional !< Flag indicating if it is okay for they key' to not exist. - !! If the key does not exist key_value will not be set, so it + !! If the key does not exist key_value will not be set, so it !! is the user's responsibility to initialize it before the call character(len=255) :: buffer !< String buffer with the value type(c_ptr) :: c_buffer !< c pointer with the value - logical(kind=c_bool) :: sucess !< Flag indicating if the value was obtained sucessfully + integer(kind=c_int) :: sucess !< Flag indicating if the value was obtained sucessfully logical :: optional !< Flag indicating that the key was optional integer :: err_unit !< integer with io error + optional=.false. if (present(is_optional)) optional = is_optional + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_value_from_key call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_value_from_key call is invalid! Check your call.") + c_buffer = get_value_from_key_wrap(file_id, block_id, key_name, sucess) - if (sucess) then + if (sucess == 1) then buffer = fms_c2f_string(c_buffer) select type (key_value) @@ -294,9 +338,9 @@ subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_opti call mpp_error(FATAL, "The type of your buffer in your get_value_from_key call for key "//trim(key_name)//& &" is not supported. Only i4, i8, r4, r8 and strings are supported.") end select + else + if(.not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) endif - if(.not. sucess .and. .not. optional) call mpp_error(FATAL, "Error getting the value for key:"//trim(key_name)) - end subroutine get_value_from_key_1d !> @brief Determines the number of blocks with block_name in the yaml file @@ -310,9 +354,12 @@ function get_num_blocks(file_id, block_name, parent_block_id) & 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_blocks call is invalid! Check your call.") + if (.not. present(parent_block_id)) then nblocks=get_num_blocks_all(file_id, block_name) else + if (.not. is_valid_block_id(file_id, parent_block_id)) call mpp_error(FATAL, "The parent_block id in your get_num_blocks call is invalid! Check your call.") nblocks=get_num_blocks_child(file_id, block_name, parent_block_id) endif end function get_num_blocks @@ -325,14 +372,57 @@ subroutine get_block_ids(file_id, block_name, block_ids, parent_block_id) character(len=*), intent(in) :: block_name !< The name of the block you are looking for integer, intent(inout) :: block_ids(:) !< Id of blocks with block_name integer, intent(in), optional :: parent_block_id !< Id of the parent_block + integer :: nblocks_id + integer :: nblocks + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_block_ids call is invalid! Check your call.") + + nblocks_id = size(block_ids) + nblocks = get_num_blocks(file_id, block_name, parent_block_id) + if (nblocks .ne. nblocks_id) call mpp_error(FATAL, "The size of your block_ids array is not correct") if (.not. present(parent_block_id)) then call get_block_ids_all(file_id, block_name, block_ids) 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_block_ids_child(file_id, block_name, block_ids, parent_block_id) endif end subroutine get_block_ids +!> @brief Gets the number of key-value pairs in a block +!! @return Number of key-value pairs in this block +function get_nkeys(file_id, block_id) & + result(nkeys) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(in) :: block_id !< Id of the parent_block + integer :: nkeys + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_nkeys call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_nkeys call is invalid! Check your call.") + + nkeys = get_nkeys_binding(file_id, block_id) +end function get_nkeys + +!> @brief Gets the ids of the key-value pairs in a block +subroutine get_key_ids (file_id, block_id, key_ids) + integer, intent(in) :: file_id !< File id corresponding to the yaml file that was opened + integer, intent(in) :: block_id !< Id of the parent_block + integer, intent(inout) :: key_ids(:) !< Ids of the key-value pairs + + integer :: nkey_ids !< Size of key_ids + integer :: nkeys !< Actual number of keys + + if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_key_ids call is invalid! Check your call.") + if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_key_ids call is invalid! Check your call.") + + nkey_ids = size(key_ids) + nkeys = get_nkeys(file_id, block_id) + + if (nkeys .ne. nkey_ids) call mpp_error(FATAL, "The size of your key_ids array is not correct.") + + call get_key_ids_binding (file_id, block_id, key_ids) +end subroutine get_key_ids + #endif end module yaml_parser_mod !> @} diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index d2d4190747..5cfccf9624 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -43,7 +43,7 @@ typedef struct { file_type my_files; int nfiles = 0; -int get_nkeys(int *file_id, int *block_id) +int get_nkeys_binding(int *file_id, int *block_id) { int nkeys = 0; int i; @@ -58,17 +58,17 @@ int get_nkeys(int *file_id, int *block_id) } -void get_key_ids(int *file_id, int *block_id, int key_ids[*]) +void get_key_ids_binding(int *file_id, int *block_id, int key_ids[*]) { int i; - int nkeys = -1; + int key_count = -1; int j = *file_id; for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { if(my_files.files[j].keys[i].parent_key == *block_id && !strcmp(my_files.files[j].keys[i].parent_name, "") ){ - nkeys = nkeys + 1; - key_ids[nkeys] = i; + key_count = key_count + 1; + key_ids[key_count] = i; } } @@ -97,13 +97,13 @@ char *get_value(int *file_id, int *key_id) return key_value; } -char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, bool *sucess) /*, char *key_name) */ +char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, int *sucess) /*, char *key_name) */ { int i; int j = *file_id; - char *key_value=NULL; - *sucess = false; + char *key_value=NULL; + *sucess = 0; for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -113,7 +113,7 @@ char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, bool { key_value = malloc(sizeof(char) * (strlen(my_files.files[j].keys[i].value) + 1)); strcpy(key_value, my_files.files[j].keys[i].value); - *sucess = true; + *sucess = 1; break; } } @@ -181,6 +181,28 @@ void get_block_ids_child(int *file_id, char *block_name, int block_ids[*], int * return; } +bool is_valid_block_id(int *file_id, int *block_id) +{ + /* If the block id it not in the allowed range is not a valid block id */ + if (*block_id <= -1 || *block_id > my_files.files[*file_id].nkeys) {return false;} + + /* If the block id has an empty parent name then it is not a valid block id */ + if (strcmp(my_files.files[*file_id].keys[*block_id].parent_name, "") == 0) {return false;} + return true; +} + +bool is_valid_key_id(int *file_id, int *key_id) +{ + if (*key_id > -1 && *key_id < my_files.files[*file_id].nkeys) {return true;} + else { return false;} +} + +bool is_valid_file_id(int *file_id) +{ + if (*file_id > -1 && *file_id < nfiles) {return true;} + else { return false;} +} + bool open_and_parse_file_wrap(char *filename, int *file_id) { yaml_parser_t parser; diff --git a/test_fms/parser/check_crashes.F90 b/test_fms/parser/check_crashes.F90 index f4451ea5ea..a5fd9ea6cf 100644 --- a/test_fms/parser/check_crashes.F90 +++ b/test_fms/parser/check_crashes.F90 @@ -7,29 +7,107 @@ program check_crashes implicit none integer :: io_status -logical :: missing_file = .false. -logical :: bad_conversion = .false. -logical :: missing_key = .false. -logical :: wrong_buffer_size = .false. +logical :: missing_file = .false. +logical :: bad_conversion = .false. +logical :: missing_key = .false. +logical :: wrong_buffer_size_key_id = .false. +logical :: wrong_buffer_size_block_id = .false. +logical :: get_key_name_bad_key_id = .false. +logical :: get_block_ids_bad_id = .false. logical :: get_key_name_bad_id = .false. - -namelist / check_crashes_nml / missing_file, bad_conversion, missing_key, wrong_buffer_size, get_key_name_bad_id +logical :: get_key_value_bad_id = .false. +logical :: get_num_blocks_bad_id = .false. +logical :: get_value_from_key_bad_id = .false. +logical :: get_nkeys_bad_id = .false. +logical :: get_key_ids_bad_id = .false. +logical :: get_key_value_bad_key_id = .false. +logical :: get_key_ids_bad_block_id = .false. +logical :: get_nkeys_bad_block_id = .false. +logical :: get_block_ids_bad_block_id = .false. +logical :: get_num_blocks_bad_block_id = .false. +logical :: get_value_from_key_bad_block_id = .false. + +namelist / check_crashes_nml / missing_file, bad_conversion, missing_key, get_block_ids_bad_id, & + get_key_name_bad_id, get_key_value_bad_id, get_num_blocks_bad_id, get_value_from_key_bad_id, & + get_nkeys_bad_id, get_key_ids_bad_id, & + get_key_name_bad_key_id, get_key_value_bad_key_id, & + get_key_ids_bad_block_id, get_nkeys_bad_block_id, get_block_ids_bad_block_id, get_num_blocks_bad_block_id, & + get_value_from_key_bad_block_id, & + wrong_buffer_size_key_id, wrong_buffer_size_block_id call fms_init read (input_nml_file, check_crashes_nml, iostat=io_status) if (io_status > 0) call mpp_error(FATAL,'=>check_crashes: Error reading input.nml') -!< Bad file id -if (missing_file) call check_read_and_parse_file_missing -if (bad_conversion) call check_bad_conversion -if (missing_key) call check_missing_key -if (wrong_buffer_size) call check_wrong_buffer_size -if (get_key_name_bad_id) call check_get_key_name_bad_id +if (missing_file) call check_read_and_parse_file_missing +if (get_block_ids_bad_id) call check_get_block_ids_bad_id +if (get_key_name_bad_id) call check_get_key_name_bad_id +if (get_key_value_bad_id) call check_get_key_value_bad_id +if (get_num_blocks_bad_id) call check_get_num_blocks_bad_id +if (get_value_from_key_bad_id) call check_get_value_from_key_bad_id +if (get_nkeys_bad_id) call check_get_nkeys_bad_id +if (get_key_ids_bad_id) call check_get_key_ids_bad_id +if (bad_conversion) call check_bad_conversion +if (missing_key) call check_missing_key +if (wrong_buffer_size_key_id) call check_wrong_buffer_size_key_id +if (wrong_buffer_size_block_id) call check_wrong_buffer_size_block_id +if (get_key_name_bad_key_id) call check_get_key_name_bad_key_id +if (get_key_value_bad_key_id) call check_get_key_value_bad_key_id +if (get_key_ids_bad_block_id) call check_get_key_ids_bad_block_id +if (get_nkeys_bad_block_id) call check_get_nkeys_bad_block_id +if (get_block_ids_bad_block_id) call check_get_block_ids_bad_block_id +if (get_num_blocks_bad_block_id) call check_get_num_blocks_bad_block_id +if (get_value_from_key_bad_block_id) call check_get_value_from_key_bad_block_id call fms_end contains +subroutine check_get_key_ids_bad_block_id + integer :: yaml_file_id + integer :: key_ids(10) + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_ids (yaml_file_id, -40, key_ids) + +end subroutine check_get_key_ids_bad_block_id + +subroutine check_get_nkeys_bad_block_id + integer :: yaml_file_id + integer :: nkeys + + yaml_file_id = open_and_parse_file("diag_table.yaml") + nkeys = get_nkeys(yaml_file_id, 9999) + +end subroutine check_get_nkeys_bad_block_id + +subroutine check_get_block_ids_bad_block_id + integer :: yaml_file_id + integer :: block_ids(10) + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_block_ids(yaml_file_id, "varList", block_ids, parent_block_id=-40) + +end subroutine check_get_block_ids_bad_block_id + +subroutine check_get_num_blocks_bad_block_id + integer :: yaml_file_id + integer :: nblocks + + yaml_file_id = open_and_parse_file("diag_table.yaml") + + nblocks = get_num_blocks(yaml_file_id, "varList", parent_block_id=-30) + +end subroutine check_get_num_blocks_bad_block_id + +subroutine check_get_value_from_key_bad_block_id + integer :: yaml_file_id + integer :: key_value + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_value_from_key(yaml_file_id, 999, "mullions", key_value) + +end subroutine check_get_value_from_key_bad_block_id !> @brief This is to check if the parser crashes correctly if user tries to open a missing file. subroutine check_read_and_parse_file_missing @@ -37,6 +115,48 @@ subroutine check_read_and_parse_file_missing yaml_file_id = open_and_parse_file("missing") end subroutine check_read_and_parse_file_missing +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_block_ids +subroutine check_get_block_ids_bad_id + integer :: block_ids(10) + call get_block_ids(-40, "diagFiles", block_ids) +end subroutine check_get_block_ids_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_name +subroutine check_get_key_name_bad_id + character(len=10) :: buffer + call get_key_name(-45, 1, buffer) +end subroutine check_get_key_name_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_value +subroutine check_get_key_value_bad_id + character(len=10) :: buffer + call get_key_value(-45, 1, buffer) +end subroutine check_get_key_value_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_num_blocks +subroutine check_get_num_blocks_bad_id + integer :: nblocks + nblocks = get_num_blocks(-45, "diagFiles") +end subroutine check_get_num_blocks_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_value_from_key +subroutine check_get_value_from_key_bad_id + character(len=10) :: string_buffer + call get_value_from_key(-45, 1, "varName", string_buffer) +end subroutine check_get_value_from_key_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_nkeys +subroutine check_get_nkeys_bad_id + integer :: nkeys + nkeys = get_nkeys(-45, 1) +end subroutine check_get_nkeys_bad_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_ids +subroutine check_get_key_ids_bad_id + integer :: key_ids(10) + call get_key_ids(-45, 1, key_ids) +end subroutine check_get_key_ids_bad_id + !> @brief This is to check if the parser crashes correctly if user sends a buffer of the wrong type subroutine check_bad_conversion integer :: yaml_file_id @@ -56,23 +176,42 @@ subroutine check_missing_key call get_value_from_key(yaml_file_id, 9, "missing", buffer) end subroutine check_missing_key -subroutine check_get_key_name_bad_id +!> @brief This is to check if the parser crashes correctly if user sends an invalid key id to get_key_name +subroutine check_get_key_name_bad_key_id + integer :: yaml_file_id + character(len=10) :: buffer + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_name(yaml_file_id, 666, buffer) + +end subroutine check_get_key_name_bad_key_id + +!> @brief This is to check if the parser crashes correctly if user sends an invalid key id to get_key_value +subroutine check_get_key_value_bad_key_id integer :: yaml_file_id character(len=10) :: buffer yaml_file_id = open_and_parse_file("diag_table.yaml") call get_key_value(yaml_file_id, 666, buffer) -end subroutine check_get_key_name_bad_id +end subroutine check_get_key_value_bad_key_id + +subroutine check_wrong_buffer_size_key_id + integer :: yaml_file_id + integer :: key_ids(1) + + yaml_file_id = open_and_parse_file("diag_table.yaml") + call get_key_ids(yaml_file_id, 19, key_ids) + +end subroutine check_wrong_buffer_size_key_id -subroutine check_wrong_buffer_size +subroutine check_wrong_buffer_size_block_id integer :: yaml_file_id - integer :: file_ids(1) + integer :: block_ids(10) yaml_file_id = open_and_parse_file("diag_table.yaml") - call get_block_ids(yaml_file_id, "diag_files", file_ids) - print *, file_ids + call get_block_ids(yaml_file_id, "diag_files", block_ids) -end subroutine check_wrong_buffer_size +end subroutine check_wrong_buffer_size_block_id #endif end program check_crashes diff --git a/test_fms/parser/test_yaml_parser.F90 b/test_fms/parser/test_yaml_parser.F90 index 9ed0cd3e0e..6966bd9fa5 100644 --- a/test_fms/parser/test_yaml_parser.F90 +++ b/test_fms/parser/test_yaml_parser.F90 @@ -107,10 +107,6 @@ program test_read_and_parse_file nkeys = get_nkeys(yaml_file_id1, variable_ids(1)) if (nkeys .ne. 3) call mpp_error(FATAL, "The number of keys was not read correctly") -!! Try to get the number of keys from a variable_id that doesn't exist -zero = get_nkeys(yaml_file_id1, 666) -if (zero .ne. 0) call mpp_error(FATAL, "The number of keys was not read correctly for a block id that does not exist") - !< ----------------------------------- !< Test get_key_ids @@ -130,8 +126,6 @@ program test_read_and_parse_file call get_key_value(yaml_file_id1, key_ids(1), key_value) if ((trim(key_value) .ne. "tdata")) call mpp_error(FATAL, "get_key_name did not output the correct name") -!< Error check wrong id - deallocate(key_ids) deallocate(variable_ids) deallocate(entries_ids) diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh index f993762a99..e8d17e6095 100755 --- a/test_fms/parser/test_yaml_parser.sh +++ b/test_fms/parser/test_yaml_parser.sh @@ -51,6 +51,34 @@ if [ $? -eq 0 ]; then exit 3 fi +printf "&check_crashes_nml \n get_block_ids_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_num_blocks_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_nkeys_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_ids_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + printf "&check_crashes_nml \n get_key_name_bad_id = .true. \n/" | cat > input.nml run_test check_crashes 1 $parser_skip && echo "It worked?" if [ $? -eq 0 ]; then @@ -58,9 +86,80 @@ if [ $? -eq 0 ]; then exit 3 fi -#printf "&check_crashes_nml \n wrong_buffer_size = .true. \n/" | cat > input.nml -#run_test check_crashes 1 && echo "It worked?" -#if [ $? -eq 0 ]; then -# echo "The test should have failed" -# exit 3 -#fi +printf "&check_crashes_nml \n get_key_value_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_value_from_key_bad_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_name_bad_key_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_key_value_bad_key_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +### +printf "&check_crashes_nml \n get_key_ids_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_nkeys_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_block_ids_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_num_blocks_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n get_value_from_key_bad_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 $parser_skip && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n wrong_buffer_size_key_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi + +printf "&check_crashes_nml \n wrong_buffer_size_block_id = .true. \n/" | cat > input.nml +run_test check_crashes 1 && echo "It worked?" +if [ $? -eq 0 ]; then + echo "The test should have failed" + exit 3 +fi From 70e108cab3a916eaeaf33863d03964a64d96baf2 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 4 Nov 2021 16:51:46 -0400 Subject: [PATCH 12/16] but wait there is more clean up --- parser/yaml_parser_binding.c | 122 ++++++++++++++--------- test_fms/parser/Makefile.am | 4 +- test_fms/parser/check_crashes.F90 | 138 +++++++++++++++++---------- test_fms/parser/diag_table.yaml | 2 + test_fms/parser/parser_demo.F90 | 119 +++++++++++++++++++++++ test_fms/parser/parser_demo2.F90 | 108 +++++++++++++++++++++ test_fms/parser/test_yaml_parser.F90 | 65 ++++++++----- test_fms/parser/test_yaml_parser.sh | 5 +- 8 files changed, 440 insertions(+), 123 deletions(-) create mode 100644 test_fms/parser/parser_demo.F90 create mode 100644 test_fms/parser/parser_demo2.F90 diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index 5cfccf9624..c9866a2e03 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -23,31 +23,36 @@ #include #include +/* Type to store info about key */ typedef struct { - int key_number; - char key[255]; - char value[255]; - char parent_name[255]; - int parent_key; + int key_number; /* Id of this key */ + char key[255]; /* Name of the key */ + char value[255]; /* Value of the key */ + char parent_name[255]; /* Name of the block the key belongs to */ + int parent_key; /* Id of the block the key belongs to */ }key_value_pairs; +/* Type to store all of the keys */ typedef struct { int nkeys; key_value_pairs *keys; }yaml_file; +/* Type to store all the yaml files that are opened */ typedef struct { yaml_file *files; }file_type; -file_type my_files; -int nfiles = 0; +file_type my_files; /* Array of opened yaml files */ +int nfiles = 0; /* Number of files in the yaml file */ +/* @brief Private c function that gets the number of key-value pairs in a block + @return Number of key-value pairs in this block */ int get_nkeys_binding(int *file_id, int *block_id) { - int nkeys = 0; - int i; - int j = *file_id; + int nkeys = 0; /* Number of key-value pairs */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -58,11 +63,12 @@ int get_nkeys_binding(int *file_id, int *block_id) } +/* @brief Private c function that gets the ids of the key-value pairs in a block */ void get_key_ids_binding(int *file_id, int *block_id, int key_ids[*]) { - int i; - int key_count = -1; - int j = *file_id; + int i; /* For loops */ + int key_count = -1; /* Number of key-value pairs */ + int j = *file_id; /* To minimize the typing :) */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -75,10 +81,12 @@ void get_key_ids_binding(int *file_id, int *block_id, int key_ids[*]) return; } +/* @brief Private c function that get the key from a key_id in a yaml file + @return Name of the key obtained */ char *get_key(int *file_id, int *key_id) { - char *key_name; - int j = *file_id; + char *key_name; /* Name of the key */ + int j = *file_id; /* To minimize the typing :) */ key_name = malloc(sizeof(char) * (strlen(my_files.files[j].keys[*key_id].key) + 1)); strcpy(key_name, my_files.files[j].keys[*key_id].key); @@ -86,10 +94,12 @@ char *get_key(int *file_id, int *key_id) return key_name; } +/* @brief Private c function that get the value from a key_id in a yaml file + @return String containing the value obtained */ char *get_value(int *file_id, int *key_id) { - char *key_value; - int j = *file_id; + char *key_value; /* Value of the key */ + int j = *file_id; /* To minimize the typing :) */ key_value = malloc(sizeof(char) * (strlen(my_files.files[j].keys[*key_id].value) + 1)); strcpy(key_value, my_files.files[j].keys[*key_id].value); @@ -97,13 +107,15 @@ char *get_value(int *file_id, int *key_id) return key_value; } +/* @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) */ { - int i; - int j = *file_id; + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ - char *key_value=NULL; - *sucess = 0; + char *key_value=NULL; /* Value of the key */ + *sucess = 0; /* Flag indicating if the search was sucessful */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -121,11 +133,13 @@ char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, int * return key_value; } +/* @brief Private c function that determines the number of blocks with block_name in the yaml file + @return Number of blocks with block_name */ int get_num_blocks_all(int *file_id, char *block_name) { - int nblocks = 0; - int i; - int j = *file_id; + int nblocks = 0; /* Number of blocks */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -135,25 +149,30 @@ int get_num_blocks_all(int *file_id, char *block_name) return nblocks; } -int get_num_blocks_child(int *file_id, char *block_name, int *parent_key_id) +/* @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 */ +int get_num_blocks_child(int *file_id, char *block_name, int *parent_block_id) { - int nblocks = 0; - int i; - int j = *file_id; + int nblocks = 0; /* Number of blocks */ + int i; /* For loops */ + int j = *file_id; /* To minimize the typing :) */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { - if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0 && my_files.files[j].keys[i].parent_key == *parent_key_id) nblocks = nblocks + 1; + if(strcmp(my_files.files[j].keys[i].parent_name, block_name) == 0 && my_files.files[j].keys[i].parent_key == *parent_block_id) nblocks = nblocks + 1; } return nblocks; } + +/* @brief Private c function that gets the the ids of the blocks with block_name in the yaml file */ void get_block_ids_all(int *file_id, char *block_name, int block_ids[*]) { - int i; - int nblocks = -1; - int j = *file_id; + int i; /* For loops */ + int nblocks = -1; /* Number of blocks */ + int j = *file_id; /* To minimize the typing :) */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -165,11 +184,13 @@ void get_block_ids_all(int *file_id, char *block_name, int block_ids[*]) return; } +/* @brief Private c function that gets the the ids of the blocks with block_name and that + belong to a parent block id in the yaml file */ void get_block_ids_child(int *file_id, char *block_name, int block_ids[*], int *parent_key_id ) { - int i; - int nblocks = -1; - int j = *file_id; + int i; /* For loops */ + int nblocks = -1; /* Number of blocks */ + int j = *file_id; /* To minimize the typing :) */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { @@ -181,44 +202,49 @@ void get_block_ids_child(int *file_id, char *block_name, int block_ids[*], int * return; } +/* @brief Private c function to determine if a block_id is valid */ bool is_valid_block_id(int *file_id, int *block_id) { /* If the block id it not in the allowed range is not a valid block id */ if (*block_id <= -1 || *block_id > my_files.files[*file_id].nkeys) {return false;} /* If the block id has an empty parent name then it is not a valid block id */ - if (strcmp(my_files.files[*file_id].keys[*block_id].parent_name, "") == 0) {return false;} + if (*block_id != 0 && strcmp(my_files.files[*file_id].keys[*block_id].parent_name, "") == 0) {return false;} return true; } +/* @brief Private c function to determine if a key_id is valid */ bool is_valid_key_id(int *file_id, int *key_id) { - if (*key_id > -1 && *key_id < my_files.files[*file_id].nkeys) {return true;} + if (*key_id > -1 && *key_id <= my_files.files[*file_id].nkeys) {return true;} else { return false;} } +/* @brief Private c function to determine if a file_id is valid */ bool is_valid_file_id(int *file_id) { if (*file_id > -1 && *file_id < nfiles) {return true;} else { return false;} } +/* @brief Private c function that opens and parses a yaml file and saves it in a struct + @return Flag indicating if the read was sucessful */ bool open_and_parse_file_wrap(char *filename, int *file_id) { yaml_parser_t parser; yaml_token_t token; FILE *file; - bool is_key = false; - char key_value[255]; - int layer = 0; - int key_count=0; - int parent[10]; - int current_parent; - char layer_name[10][255]; - char current_layername[255]; - int i; - int j; + bool is_key = false; /* Flag indicating if the current token in a key */ + char key_value[255]; /* Value of a key */ + int layer = 0; /* Current layer (block level) */ + int key_count=0; /* Current number of keys */ + int parent[10]; /* Ids of blocks */ + int current_parent; /* Id of the current block */ + char layer_name[10][255]; /* Array of block names */ + char current_layername[255]; /* Name of the current block */ + int i; /* To minimize the typing :) */ + int j; /* To minimize the typing :) */ if (nfiles == 0 ) { @@ -312,10 +338,12 @@ bool open_and_parse_file_wrap(char *filename, int *file_id) yaml_token_delete(&token); yaml_parser_delete(&parser); + /* for ( i = 1; i <= my_files.files[j].nkeys; i++ ) { printf("Key_number:%i Parent_key:%i Parent_name:%s Key:%s Value:%s \n", my_files.files[j].keys[i].key_number, my_files.files[j].keys[i].parent_key, my_files.files[j].keys[i].parent_name, my_files.files[j].keys[i].key, my_files.files[j].keys[i].value); } printf("/\n"); + */ nfiles = nfiles + 1; /* printf("closing file: %s\n", filename); */ diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am index 25d8f7f824..04b7e28dd1 100644 --- a/test_fms/parser/Makefile.am +++ b/test_fms/parser/Makefile.am @@ -29,11 +29,13 @@ AM_CPPFLAGS = -I${top_srcdir}/include -I$(MODDIR) LDADD = ${top_builddir}/libFMS/libFMS.la # Build this test program. -check_PROGRAMS = test_yaml_parser check_crashes +check_PROGRAMS = parser_demo2 test_yaml_parser check_crashes parser_demo # This is the source code for the test. test_yaml_parser_SOURCES = test_yaml_parser.F90 check_crashes_SOURCES = check_crashes.F90 +parser_demo_SOURCES = parser_demo.F90 +parser_demo2_SOURCES = parser_demo2.F90 # Run the test program. TESTS = test_yaml_parser.sh diff --git a/test_fms/parser/check_crashes.F90 b/test_fms/parser/check_crashes.F90 index a5fd9ea6cf..d454ed6cf7 100644 --- a/test_fms/parser/check_crashes.F90 +++ b/test_fms/parser/check_crashes.F90 @@ -1,4 +1,25 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** + program check_crashes +!> @brief This programs tests if the public subroutines in parser/yaml_parser.F90 +!! crash as expected #ifdef use_yaml use yaml_parser_mod use mpp_mod @@ -6,26 +27,26 @@ program check_crashes implicit none -integer :: io_status -logical :: missing_file = .false. -logical :: bad_conversion = .false. -logical :: missing_key = .false. -logical :: wrong_buffer_size_key_id = .false. -logical :: wrong_buffer_size_block_id = .false. -logical :: get_key_name_bad_key_id = .false. -logical :: get_block_ids_bad_id = .false. -logical :: get_key_name_bad_id = .false. -logical :: get_key_value_bad_id = .false. -logical :: get_num_blocks_bad_id = .false. -logical :: get_value_from_key_bad_id = .false. -logical :: get_nkeys_bad_id = .false. -logical :: get_key_ids_bad_id = .false. -logical :: get_key_value_bad_key_id = .false. -logical :: get_key_ids_bad_block_id = .false. -logical :: get_nkeys_bad_block_id = .false. -logical :: get_block_ids_bad_block_id = .false. -logical :: get_num_blocks_bad_block_id = .false. -logical :: get_value_from_key_bad_block_id = .false. +integer :: io_status !< io_status when reading a namelist +logical :: missing_file = .false. !< try to open files that do not exist +logical :: bad_conversion = .false. !< try type conversions that are not possible +logical :: missing_key = .false. !< try to get the value of a key that does not exist +logical :: wrong_buffer_size_key_id = .false. !< try to send an array of key_id that is the wrong size +logical :: wrong_buffer_size_block_id = .false. !< try to send an array of block_id that is the wrong size +logical :: get_key_name_bad_key_id = .false. !< try to send a bad key_id to get_key_name +logical :: get_key_value_bad_key_id = .false. !< try to send a bad key_id to get_key_value +logical :: get_block_ids_bad_id = .false. !< try to send a bad file_id to get_block_ids +logical :: get_key_name_bad_id = .false. !< try to send a bad file_id to get_key_name +logical :: get_key_value_bad_id = .false. !< try to send a bad file_id to get_key_value +logical :: get_num_blocks_bad_id = .false. !< try to send a bad file_id to get_num_blocks +logical :: get_value_from_key_bad_id = .false. !< try to send a bad file_id to get_value_from_key +logical :: get_nkeys_bad_id = .false. !< try to send a bad file_id to get_nkeys +logical :: get_key_ids_bad_id = .false. !< try to send a bad file_id to get_key_ids +logical :: get_key_ids_bad_block_id = .false. !< try to send a bad block_id to get_key_ids +logical :: get_nkeys_bad_block_id = .false. !< try to send a bad block_id to get_nkeys +logical :: get_block_ids_bad_block_id = .false. !< try to send a bad block_id to get_block_ids +logical :: get_num_blocks_bad_block_id = .false. !< try to send a bad block_id to get_num_blocks +logical :: get_value_from_key_bad_block_id = .false. !< try to send a bad block_id to get_value_from_key namelist / check_crashes_nml / missing_file, bad_conversion, missing_key, get_block_ids_bad_id, & get_key_name_bad_id, get_key_value_bad_id, get_num_blocks_bad_id, get_value_from_key_bad_id, & @@ -63,36 +84,40 @@ program check_crashes call fms_end contains +!> @brief This is to check if the parser crashes correctly if user sends a bad block_id to get_key_ids subroutine check_get_key_ids_bad_block_id - integer :: yaml_file_id - integer :: key_ids(10) + integer :: yaml_file_id !< file_id for a yaml file + integer :: key_ids(10) !< array of key ids yaml_file_id = open_and_parse_file("diag_table.yaml") call get_key_ids (yaml_file_id, -40, key_ids) end subroutine check_get_key_ids_bad_block_id +!> @brief This is to check if the parser crashes correctly if user sends a bad block_id to get_nkeys subroutine check_get_nkeys_bad_block_id - integer :: yaml_file_id - integer :: nkeys + integer :: yaml_file_id !< file_id for a yaml file + integer :: nkeys !< number of keys yaml_file_id = open_and_parse_file("diag_table.yaml") nkeys = get_nkeys(yaml_file_id, 9999) end subroutine check_get_nkeys_bad_block_id +!> @brief This is to check if the parser crashes correctly if user sends a bad parent_block_id to get_block_ids subroutine check_get_block_ids_bad_block_id - integer :: yaml_file_id - integer :: block_ids(10) + integer :: yaml_file_id !< file_id for a yaml file + integer :: block_ids(10)!< array of block ids yaml_file_id = open_and_parse_file("diag_table.yaml") call get_block_ids(yaml_file_id, "varList", block_ids, parent_block_id=-40) end subroutine check_get_block_ids_bad_block_id +!> @brief This is to check if the parser crashes correctly if user sends a bad parent_block_id to get_num_blocks subroutine check_get_num_blocks_bad_block_id - integer :: yaml_file_id - integer :: nblocks + integer :: yaml_file_id !< file_id for a yaml file + integer :: nblocks !< number of blocks yaml_file_id = open_and_parse_file("diag_table.yaml") @@ -100,9 +125,10 @@ subroutine check_get_num_blocks_bad_block_id end subroutine check_get_num_blocks_bad_block_id +!> @brief This is to check if the parser crashes correctly if user sends a bad parent_block_id to get_value_from_key subroutine check_get_value_from_key_bad_block_id - integer :: yaml_file_id - integer :: key_value + integer :: yaml_file_id !< file_id for a yaml file + integer :: key_value !< integer buffer yaml_file_id = open_and_parse_file("diag_table.yaml") call get_value_from_key(yaml_file_id, 999, "mullions", key_value) @@ -111,56 +137,64 @@ end subroutine check_get_value_from_key_bad_block_id !> @brief This is to check if the parser crashes correctly if user tries to open a missing file. subroutine check_read_and_parse_file_missing - integer :: yaml_file_id + integer :: yaml_file_id !< file_id for a yaml file + yaml_file_id = open_and_parse_file("missing") end subroutine check_read_and_parse_file_missing !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_block_ids subroutine check_get_block_ids_bad_id - integer :: block_ids(10) + integer :: block_ids(10) !< array of block ids + call get_block_ids(-40, "diagFiles", block_ids) end subroutine check_get_block_ids_bad_id !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_name subroutine check_get_key_name_bad_id - character(len=10) :: buffer + character(len=10) :: buffer !< string buffer + call get_key_name(-45, 1, buffer) end subroutine check_get_key_name_bad_id !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_value subroutine check_get_key_value_bad_id - character(len=10) :: buffer + character(len=10) :: buffer !< string buffer + call get_key_value(-45, 1, buffer) end subroutine check_get_key_value_bad_id !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_num_blocks subroutine check_get_num_blocks_bad_id - integer :: nblocks + integer :: nblocks !< number of blocks + nblocks = get_num_blocks(-45, "diagFiles") end subroutine check_get_num_blocks_bad_id !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_value_from_key subroutine check_get_value_from_key_bad_id - character(len=10) :: string_buffer + character(len=10) :: string_buffer !< string buffer + call get_value_from_key(-45, 1, "varName", string_buffer) end subroutine check_get_value_from_key_bad_id !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_nkeys subroutine check_get_nkeys_bad_id - integer :: nkeys + integer :: nkeys !< number of keys + nkeys = get_nkeys(-45, 1) end subroutine check_get_nkeys_bad_id !> @brief This is to check if the parser crashes correctly if user sends an invalid file id to get_key_ids subroutine check_get_key_ids_bad_id - integer :: key_ids(10) + integer :: key_ids(10) !< array of key ids + call get_key_ids(-45, 1, key_ids) end subroutine check_get_key_ids_bad_id !> @brief This is to check if the parser crashes correctly if user sends a buffer of the wrong type subroutine check_bad_conversion - integer :: yaml_file_id - real :: buffer + integer :: yaml_file_id !< file_id for a yaml file + real :: buffer !< real buffer yaml_file_id = open_and_parse_file("diag_table.yaml") call get_value_from_key(yaml_file_id, 9, "varName", buffer) @@ -169,8 +203,8 @@ end subroutine check_bad_conversion !> @brief This is to check if the parser crashes correctly if user tries to get they value for a key !! that doesn't exist subroutine check_missing_key - integer :: yaml_file_id - real :: buffer + integer :: yaml_file_id !< file_id for a yaml file + real :: buffer !< string bufffer yaml_file_id = open_and_parse_file("diag_table.yaml") call get_value_from_key(yaml_file_id, 9, "missing", buffer) @@ -178,8 +212,8 @@ end subroutine check_missing_key !> @brief This is to check if the parser crashes correctly if user sends an invalid key id to get_key_name subroutine check_get_key_name_bad_key_id - integer :: yaml_file_id - character(len=10) :: buffer + integer :: yaml_file_id !< file_id for a yaml file + character(len=10) :: buffer !< string buffer yaml_file_id = open_and_parse_file("diag_table.yaml") call get_key_name(yaml_file_id, 666, buffer) @@ -188,26 +222,30 @@ end subroutine check_get_key_name_bad_key_id !> @brief This is to check if the parser crashes correctly if user sends an invalid key id to get_key_value subroutine check_get_key_value_bad_key_id - integer :: yaml_file_id - character(len=10) :: buffer + integer :: yaml_file_id !< file_id for a yaml file + character(len=10) :: buffer !< string buffer yaml_file_id = open_and_parse_file("diag_table.yaml") call get_key_value(yaml_file_id, 666, buffer) end subroutine check_get_key_value_bad_key_id +!> @brief This is to check if the parser crashes correctly if user sends an a key_id array that is that the correct +!! size to get_key_ids subroutine check_wrong_buffer_size_key_id - integer :: yaml_file_id - integer :: key_ids(1) + integer :: yaml_file_id !< file_id for a yaml file + integer :: key_ids(1) !< array of key ids yaml_file_id = open_and_parse_file("diag_table.yaml") call get_key_ids(yaml_file_id, 19, key_ids) end subroutine check_wrong_buffer_size_key_id +!> @brief This is to check if the parser crashes correctly if user sends an a block_id array that is that the correct +!! size to get_block_ids subroutine check_wrong_buffer_size_block_id - integer :: yaml_file_id - integer :: block_ids(10) + integer :: yaml_file_id !< file_id for a yaml file + integer :: block_ids(10)!< array of block ids yaml_file_id = open_and_parse_file("diag_table.yaml") call get_block_ids(yaml_file_id, "diag_files", block_ids) diff --git a/test_fms/parser/diag_table.yaml b/test_fms/parser/diag_table.yaml index 98f3ca9333..7bc468a8b1 100644 --- a/test_fms/parser/diag_table.yaml +++ b/test_fms/parser/diag_table.yaml @@ -8,6 +8,8 @@ diag_files: unlimdim: time varlist: - varName: tdata + reduction: False + module: mullions mullions: 10 fill_value: -999.9 - varName: pdata diff --git a/test_fms/parser/parser_demo.F90 b/test_fms/parser/parser_demo.F90 new file mode 100644 index 0000000000..16bc1c81ac --- /dev/null +++ b/test_fms/parser/parser_demo.F90 @@ -0,0 +1,119 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** + +program parser_demo +!> @brief This programs demostrates how to use the parser + +#ifdef use_yaml +use FMS_mod, only: fms_init, fms_end +use yaml_parser_mod +use platform_mod + +implicit none + +integer :: diag_yaml_id !< Id for the diag_table yaml +integer :: nfiles !< Number of files in the diag_table yaml +integer, allocatable :: file_ids(:) !< Ids of the files in the diag_table yaml +integer :: nvariables !< Number of variables in the diag_table yaml +integer, allocatable :: var_ids(:) !< Ids of the variables in the diag_table yaml +integer :: i, j !< For do loops +character(len=255) :: string_buffer !< Buffer to read strings to +integer :: int_buffer !< Buffer to read integers to +real(kind=r8_kind) :: r8_buffer !< Buffer to read r8 to + +call fms_init +call fms_end + +diag_yaml_id = open_and_parse_file("diag_table.yaml") +print *, "" + +call get_value_from_key(diag_yaml_id, 0, "title", string_buffer) +print *, "title:", trim(string_buffer) + +call get_value_from_key(diag_yaml_id, 0, "baseDate", string_buffer) +print *, "baseDate:", trim(string_buffer) + +nfiles = get_num_blocks(diag_yaml_id, "diag_files") +allocate(file_ids(nfiles)) +call get_block_ids(diag_yaml_id, "diag_files", file_ids) +print *, "" + +do i = 1, nfiles + print *, "File number:", i + + call get_value_from_key(diag_yaml_id, file_ids(i), "fileName", string_buffer) + print *, "fileName:", trim(string_buffer) + + call get_value_from_key(diag_yaml_id, file_ids(i), "freq", int_buffer) + print *, "freq:", int_buffer + + call get_value_from_key(diag_yaml_id, file_ids(i), "frequnit", string_buffer) + print *, "frequnit:", trim(string_buffer) + + call get_value_from_key(diag_yaml_id, file_ids(i), "timeunit", string_buffer) + print *, "timeunit:", trim(string_buffer) + + call get_value_from_key(diag_yaml_id, file_ids(i), "unlimdim", string_buffer) + print *, "unlimdim:", trim(string_buffer) + + !< The number of variables that are part of the current file + nvariables = get_num_blocks(diag_yaml_id, "varlist", parent_block_id=file_ids(i)) + allocate(var_ids(nvariables)) + call get_block_ids(diag_yaml_id, "varlist", var_ids, parent_block_id=file_ids(i)) + + do j = 1, nvariables + print *, " Variable number:", j + + call get_value_from_key(diag_yaml_id, var_ids(j), "varName", string_buffer) + print *, " varName:", trim(string_buffer) + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "reduction", string_buffer) + print *, " reduction:", trim(string_buffer) + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "module", string_buffer) + print *, " module:", trim(string_buffer) + + r8_buffer = 0. + call get_value_from_key(diag_yaml_id, var_ids(j), "fill_value", r8_buffer, is_optional=.true.) + print *, " fill_value:", r8_buffer + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "outName", string_buffer, is_optional=.true.) + print *, " outName:", trim(string_buffer) + + string_buffer = "" + call get_value_from_key(diag_yaml_id, var_ids(j), "kind", string_buffer, is_optional=.true.) + print *, " kind:", trim(string_buffer) + + int_buffer = 0. + call get_value_from_key(diag_yaml_id, var_ids(j), "mullions", int_buffer, is_optional=.true.) + print *, " mullions:", int_buffer + + print *, "" + end do + deallocate(var_ids) + print *, "" +enddo +deallocate(file_ids) + +#endif + +end program parser_demo diff --git a/test_fms/parser/parser_demo2.F90 b/test_fms/parser/parser_demo2.F90 new file mode 100644 index 0000000000..c230559a4e --- /dev/null +++ b/test_fms/parser/parser_demo2.F90 @@ -0,0 +1,108 @@ +!*********************************************************************** +!* 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 . +!*********************************************************************** + +program parser_demo +!> @brief This programs demostrates how to use the parser + +#ifdef use_yaml +use FMS_mod, only: fms_init, fms_end +use yaml_parser_mod +use platform_mod + +implicit none + +integer :: diag_yaml_id !< Id for the diag_table yaml +integer :: nfiles !< Number of files in the diag_table yaml +integer, allocatable :: file_ids(:) !< Ids of the files in the diag_table yaml +integer :: nvariables !< Number of variables in the diag_table yaml +integer, allocatable :: var_ids(:) !< Ids of the variables in the diag_table yaml +integer :: i, j, k !< For do loops +integer :: nkeys !< Number of keys +integer, allocatable :: key_ids(:) !< Ids of keys in the diag_table_yaml +character(len=255) :: key_value !< The value of a key +character(len=255) :: key_name !< The name of a key + +call fms_init +call fms_end + +diag_yaml_id = open_and_parse_file("diag_table.yaml") +print *, "" + +nkeys = get_nkeys(diag_yaml_id, 0) +allocate(key_ids(nkeys)) +call get_key_ids(diag_yaml_id, 0, key_ids) + +do i = 1, nkeys + call get_key_name(diag_yaml_id, key_ids(i), key_name) + call get_key_value(diag_yaml_id, key_ids(i), key_value) + print *, "Key:", trim(key_name), " Value:", trim(key_value) +enddo + +deallocate(key_ids) + +nfiles = get_num_blocks(diag_yaml_id, "diag_files") +allocate(file_ids(nfiles)) +call get_block_ids(diag_yaml_id, "diag_files", file_ids) +print *, "" + +do i = 1, nfiles + print *, "File number:", i + + nkeys = get_nkeys(diag_yaml_id, file_ids(i)) + allocate(key_ids(nkeys)) + call get_key_ids(diag_yaml_id, file_ids(i), key_ids) + + do j = 1, nkeys + call get_key_name(diag_yaml_id, key_ids(j), key_name) + call get_key_value(diag_yaml_id, key_ids(j), key_value) + print *, " Key:", trim(key_name), " Value:", trim(key_value) + enddo + + deallocate(key_ids) + print *, "" + !< The number of variables that are part of the current file + nvariables = get_num_blocks(diag_yaml_id, "varlist", parent_block_id=file_ids(i)) + allocate(var_ids(nvariables)) + call get_block_ids(diag_yaml_id, "varlist", var_ids, parent_block_id=file_ids(i)) + + do j = 1, nvariables + print *, " Variable number:", j + + nkeys = get_nkeys(diag_yaml_id, var_ids(j)) + allocate(key_ids(nkeys)) + call get_key_ids(diag_yaml_id, var_ids(j), key_ids) + + do k = 1, nkeys + call get_key_name(diag_yaml_id, key_ids(k), key_name) + call get_key_value(diag_yaml_id, key_ids(k), key_value) + print *, " Key:", trim(key_name), " Value:", trim(key_value) + enddo + + deallocate(key_ids) + print *, "" + end do + + deallocate(var_ids) + print *, "" +enddo +deallocate(file_ids) + +#endif + +end program parser_demo diff --git a/test_fms/parser/test_yaml_parser.F90 b/test_fms/parser/test_yaml_parser.F90 index 6966bd9fa5..3cdc3b7fb3 100644 --- a/test_fms/parser/test_yaml_parser.F90 +++ b/test_fms/parser/test_yaml_parser.F90 @@ -1,3 +1,23 @@ +!*********************************************************************** +!* 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 public subroutines in parser/yaml_parser.F90 program test_read_and_parse_file #ifdef use_yaml @@ -8,23 +28,24 @@ program test_read_and_parse_file implicit none -integer :: yaml_file_id1, nfiles, nvariables -integer, allocatable :: file_ids(:) -integer, allocatable :: variable_ids(:) -integer :: yaml_file_id2, nentries -integer, allocatable :: entries_ids(:) -integer :: i, j, k !< For do loops -integer :: zero -character(len=20) :: string_buffer -integer(kind=i4_kind) :: i4_buffer -integer(kind=i8_kind) :: i8_buffer -real(kind=r4_kind) :: r4_buffer -real(kind=r8_kind) :: r8_buffer -integer :: nkeys -integer, allocatable :: key_ids(:) -character(len=20) :: key_name -character(len=20) :: key_value -logical :: wut +integer :: yaml_file_id1 !< file id of a yaml file +integer :: nfiles !< number of files +integer :: nvariables !< number of variables +integer, allocatable :: file_ids(:) !< array of file ids +integer, allocatable :: variable_ids(:) !< array of variable ids +integer :: yaml_file_id2 !< file id of a yaml file +integer :: nentries !< number of entries +integer, allocatable :: entries_ids(:) !< array of entries ids +integer :: zero !< dummy integer buffer +character(len=20) :: string_buffer !< string buffer +integer(kind=i4_kind) :: i4_buffer !< i4 buffer +integer(kind=i8_kind) :: i8_buffer !< i8 buffer +real(kind=r4_kind) :: r4_buffer !< r4 buffer +real(kind=r8_kind) :: r8_buffer !< r8 buffer +integer :: nkeys !< number of keys +integer, allocatable :: key_ids(:) !< array of key ids +character(len=20) :: key_name !< the name of the key +character(len=20) :: key_value !< the value of a key call fms_init @@ -59,7 +80,7 @@ program test_read_and_parse_file !< Test get_block_ids allocate(file_ids(nfiles)) call get_block_ids(yaml_file_id1, "diag_files", file_ids) -if(file_ids(1) .ne. 3 .or. file_ids(2) .ne. 19) call mpp_error(FATAL, "The file_ids are wrong!") +if(file_ids(1) .ne. 3 .or. file_ids(2) .ne. 21) call mpp_error(FATAL, "The file_ids are wrong!") !< Test to see if a diffrent yaml file id will work allocate(entries_ids(nentries)) @@ -69,7 +90,7 @@ program test_read_and_parse_file !< Try the parent block id optional argument allocate(variable_ids(nvariables)) call get_block_ids(yaml_file_id1, "varlist", variable_ids, parent_block_id=3) -if (variable_ids(1) .ne. 9 .or. variable_ids(2) .ne. 13) call mpp_error(FATAL, "The variable_ids are wrong!") +if (variable_ids(1) .ne. 9 .or. variable_ids(2) .ne. 15) call mpp_error(FATAL, "The variable_ids are wrong!") !< Error check: *_ids is not the correct size @@ -105,16 +126,14 @@ program test_read_and_parse_file !< Test nkeys nkeys = get_nkeys(yaml_file_id1, variable_ids(1)) -if (nkeys .ne. 3) call mpp_error(FATAL, "The number of keys was not read correctly") +if (nkeys .ne. 5) call mpp_error(FATAL, "The number of keys was not read correctly") !< ----------------------------------- !< Test get_key_ids allocate(key_ids(nkeys)) call get_key_ids(yaml_file_id1, variable_ids(1), key_ids) -if (key_ids(1) .ne. 10 .or. key_ids(2) .ne. 11 .or. key_ids(3) .ne. 12) call mpp_error(FATAL, "The key ids obtained are wrong") - -!< Error check: *_ids is not the correct size +if (key_ids(1) .ne. 10 .or. key_ids(2) .ne. 11 .or. key_ids(3) .ne. 12 .or. key_ids(4) .ne. 13 .or. key_ids(5) .ne. 14) call mpp_error(FATAL, "The key ids obtained are wrong") !< ----------------------------------- diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh index e8d17e6095..eb46002fb8 100755 --- a/test_fms/parser/test_yaml_parser.sh +++ b/test_fms/parser/test_yaml_parser.sh @@ -20,15 +20,16 @@ #*********************************************************************** # This is part of the GFDL FMS package. This is a shell script to -# execute tests in the test_fms/data_override directory. +# execute tests in the test_fms/parser directory. # Set common test settings. . ../test_common.sh -# Run the ongrid test case with 2 halos in x and y touch input.nml run_test test_yaml_parser 1 $parser_skip +run_test parser_demo 1 $parser_skip +run_test parser_demo2 1 $parser_skip printf "&check_crashes_nml \n missing_file = .true. \n/" | cat > input.nml run_test check_crashes 1 $parser_skip && echo "It worked?" From 33598c58c9dc098a0535a917330d45a3f2c3fdf6 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Fri, 5 Nov 2021 13:04:11 -0400 Subject: [PATCH 13/16] Fix memory leak issues --- fms/fms.F90 | 2 +- parser/yaml_parser_binding.c | 21 ++++----------------- 2 files changed, 5 insertions(+), 18 deletions(-) diff --git a/fms/fms.F90 b/fms/fms.F90 index 61f5772e3a..e9af55099f 100644 --- a/fms/fms.F90 +++ b/fms/fms.F90 @@ -831,7 +831,7 @@ function fms_c2f_string (cstring) result(fstring) allocate(character(len=length) :: fstring) !> Set the length of fstring fstring = string_buffer - + deallocate(string_buffer) end function fms_c2f_string !####################################################################### !> @brief Prints to the log file (or a specified unit) the version id string and diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index c9866a2e03..4691d197d0 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -85,26 +85,16 @@ void get_key_ids_binding(int *file_id, int *block_id, int key_ids[*]) @return Name of the key obtained */ char *get_key(int *file_id, int *key_id) { - char *key_name; /* Name of the key */ - int j = *file_id; /* To minimize the typing :) */ - - key_name = malloc(sizeof(char) * (strlen(my_files.files[j].keys[*key_id].key) + 1)); - strcpy(key_name, my_files.files[j].keys[*key_id].key); - - return key_name; + int j = *file_id; /* To minimize the typing :) */ + return my_files.files[j].keys[*key_id].key; } /* @brief Private c function that get the value from a key_id in a yaml file @return String containing the value obtained */ char *get_value(int *file_id, int *key_id) { - char *key_value; /* Value of the key */ int j = *file_id; /* To minimize the typing :) */ - - key_value = malloc(sizeof(char) * (strlen(my_files.files[j].keys[*key_id].value) + 1)); - strcpy(key_value, my_files.files[j].keys[*key_id].value); - - return key_value; + return my_files.files[j].keys[*key_id].value; } /* @brief Private c function that determines they value of a key in yaml_file @@ -114,7 +104,6 @@ char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, int * int i; /* For loops */ int j = *file_id; /* To minimize the typing :) */ - char *key_value=NULL; /* Value of the key */ *sucess = 0; /* Flag indicating if the search was sucessful */ for ( i = 1; i <= my_files.files[j].nkeys; i++ ) @@ -123,14 +112,12 @@ char *get_value_from_key_wrap(int *file_id, int *block_id, char *key_name, int * { if( strcmp(my_files.files[j].keys[i].key, key_name) == 0) { - key_value = malloc(sizeof(char) * (strlen(my_files.files[j].keys[i].value) + 1)); - strcpy(key_value, my_files.files[j].keys[i].value); *sucess = 1; break; } } } - return key_value; + if (*sucess == 1) {return my_files.files[j].keys[i].value;} else {return "";} } /* @brief Private c function that determines the number of blocks with block_name in the yaml file From ea990d563a24b134fa5a0b5a5a261cd7ebb87cea Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 8 Nov 2021 10:43:05 -0500 Subject: [PATCH 14/16] Fixes for gnu compiler, add in a null character --- parser/yaml_parser.F90 | 14 +++++++------- parser/yaml_parser_binding.c | 6 +++--- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index bdd00699ca..3d995ed8b8 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -209,7 +209,7 @@ function open_and_parse_file(filename) & integer :: file_id - sucess = open_and_parse_file_wrap(filename, file_id) + sucess = open_and_parse_file_wrap(trim(filename)//c_null_char, file_id) if (.not. sucess) call mpp_error(FATAL, "Error opening the yaml file:"//trim(filename)//". Check the file!") end function open_and_parse_file @@ -263,7 +263,7 @@ subroutine get_value_from_key_0d(file_id, block_id, key_name, key_value, is_opti if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_value_from_key call is invalid! Check your call.") if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_value_from_key call is invalid! Check your call.") - c_buffer = get_value_from_key_wrap(file_id, block_id, key_name, sucess) + c_buffer = get_value_from_key_wrap(file_id, block_id, trim(key_name)//c_null_char, sucess) if (sucess == 1) then buffer = fms_c2f_string(c_buffer) @@ -315,7 +315,7 @@ subroutine get_value_from_key_1d(file_id, block_id, key_name, key_value, is_opti if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_value_from_key call is invalid! Check your call.") if (.not. is_valid_block_id(file_id, block_id)) call mpp_error(FATAL, "The block id in your get_value_from_key call is invalid! Check your call.") - c_buffer = get_value_from_key_wrap(file_id, block_id, key_name, sucess) + c_buffer = get_value_from_key_wrap(file_id, block_id, trim(key_name)//c_null_char, sucess) if (sucess == 1) then buffer = fms_c2f_string(c_buffer) @@ -357,10 +357,10 @@ function get_num_blocks(file_id, block_name, parent_block_id) & if (.not. is_valid_file_id(file_id)) call mpp_error(FATAL, "The file id in your get_num_blocks call is invalid! Check your call.") if (.not. present(parent_block_id)) then - nblocks=get_num_blocks_all(file_id, block_name) + nblocks=get_num_blocks_all(file_id, trim(block_name)//c_null_char) else if (.not. is_valid_block_id(file_id, parent_block_id)) call mpp_error(FATAL, "The parent_block id in your get_num_blocks call is invalid! Check your call.") - nblocks=get_num_blocks_child(file_id, block_name, parent_block_id) + nblocks=get_num_blocks_child(file_id, trim(block_name)//c_null_char, parent_block_id) endif end function get_num_blocks @@ -382,10 +382,10 @@ subroutine get_block_ids(file_id, block_name, block_ids, parent_block_id) if (nblocks .ne. nblocks_id) call mpp_error(FATAL, "The size of your block_ids array is not correct") if (.not. present(parent_block_id)) then - call get_block_ids_all(file_id, block_name, block_ids) + call get_block_ids_all(file_id, trim(block_name)//c_null_char, block_ids) 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_block_ids_child(file_id, block_name, block_ids, parent_block_id) + call get_block_ids_child(file_id, trim(block_name)//c_null_char, block_ids, parent_block_id) endif end subroutine get_block_ids diff --git a/parser/yaml_parser_binding.c b/parser/yaml_parser_binding.c index 4691d197d0..9c4fdaefab 100644 --- a/parser/yaml_parser_binding.c +++ b/parser/yaml_parser_binding.c @@ -64,7 +64,7 @@ int get_nkeys_binding(int *file_id, int *block_id) } /* @brief Private c function that gets the ids of the key-value pairs in a block */ -void get_key_ids_binding(int *file_id, int *block_id, int key_ids[*]) +void get_key_ids_binding(int *file_id, int *block_id, int *key_ids) { int i; /* For loops */ int key_count = -1; /* Number of key-value pairs */ @@ -155,7 +155,7 @@ int get_num_blocks_child(int *file_id, char *block_name, int *parent_block_id) /* @brief Private c function that gets the the ids of the blocks with block_name in the yaml file */ -void get_block_ids_all(int *file_id, char *block_name, int block_ids[*]) +void get_block_ids_all(int *file_id, char *block_name, int *block_ids) { int i; /* For loops */ int nblocks = -1; /* Number of blocks */ @@ -173,7 +173,7 @@ void get_block_ids_all(int *file_id, char *block_name, int block_ids[*]) /* @brief Private c function that gets the the ids of the blocks with block_name and that belong to a parent block id in the yaml file */ -void get_block_ids_child(int *file_id, char *block_name, int block_ids[*], int *parent_key_id ) +void get_block_ids_child(int *file_id, char *block_name, int *block_ids, int *parent_key_id ) { int i; /* For loops */ int nblocks = -1; /* Number of blocks */ From 8bef575cd06287affaa5cca472e856a36af7740c Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 10 Nov 2021 15:40:08 -0500 Subject: [PATCH 15/16] defines c strings correctly --- parser/yaml_parser.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/parser/yaml_parser.F90 b/parser/yaml_parser.F90 index 3d995ed8b8..74f5a48421 100644 --- a/parser/yaml_parser.F90 +++ b/parser/yaml_parser.F90 @@ -134,7 +134,7 @@ function get_value_from_key_wrap(file_id, block_id, key_name, sucess) bind(c) & use iso_c_binding, only: c_ptr, 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), intent(in) :: block_id !< ID corresponding to the block you want the key for - character(kind=c_char), intent(in) :: key_name !< Name of the key you want the value for + character(kind=c_char), intent(in) :: key_name(*) !< Name of the key you want the value for integer(kind=c_int), intent(out) :: sucess !< Flag indicating if the call was sucessful type(c_ptr) :: key_value2 end function get_value_from_key_wrap @@ -146,7 +146,7 @@ function get_num_blocks_all(file_id, block_name) 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 - character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for integer(kind=c_int) :: nblocks end function get_num_blocks_all @@ -158,7 +158,7 @@ function get_num_blocks_child(file_id, block_name, 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 - character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for integer(kind=c_int) :: parent_block_id !< Id of the parent block integer(kind=c_int) :: nblocks @@ -169,7 +169,7 @@ end function get_num_blocks_child subroutine get_block_ids_all(file_id, block_name, block_ids) bind(c) 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 - character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for integer(kind=c_int), intent(inout) :: block_ids(*) !< Id of the parent_block end subroutine get_block_ids_all @@ -178,7 +178,7 @@ end subroutine get_block_ids_all subroutine get_block_ids_child(file_id, block_name, block_ids, parent_block_id) bind(c) 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 - character(kind=c_char), intent(in) :: block_name !< The name of the block you are looking for + character(kind=c_char), intent(in) :: block_name(*) !< The name of the block you are looking for 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_block_ids_child From 382e7d819f3c6ef8e1e2ee00366b49bc39c4b902 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Fri, 12 Nov 2021 11:08:13 -0500 Subject: [PATCH 16/16] The test script now generate the .yaml files --- test_fms/parser/Makefile.am | 4 +-- test_fms/parser/data_table.yaml | 18 ---------- test_fms/parser/diag_table.yaml | 28 ---------------- test_fms/parser/test_yaml_parser.sh | 52 +++++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 48 deletions(-) delete mode 100644 test_fms/parser/data_table.yaml delete mode 100644 test_fms/parser/diag_table.yaml diff --git a/test_fms/parser/Makefile.am b/test_fms/parser/Makefile.am index 04b7e28dd1..469538ce11 100644 --- a/test_fms/parser/Makefile.am +++ b/test_fms/parser/Makefile.am @@ -41,7 +41,7 @@ parser_demo2_SOURCES = parser_demo2.F90 TESTS = test_yaml_parser.sh # Include these files with the distribution. -EXTRA_DIST = test_yaml_parser.sh data_table.yaml diag_table.yaml +EXTRA_DIST = test_yaml_parser.sh if SKIP_PARSER_TESTS skipflag="skip" @@ -51,4 +51,4 @@ endif TESTS_ENVIRONMENT = parser_skip=${skipflag} # Clean up -CLEANFILES = input.nml *.nc* *.out +CLEANFILES = input.nml *.nc* *.out *.yaml diff --git a/test_fms/parser/data_table.yaml b/test_fms/parser/data_table.yaml deleted file mode 100644 index a68ed45094..0000000000 --- a/test_fms/parser/data_table.yaml +++ /dev/null @@ -1,18 +0,0 @@ -data_table: - - gridname : "ICE" - fieldname_code : "sic_obs" - fieldname_file : "ice" - file_name : "INPUT/hadisst_ice.data.nc" - interpol_method : "bilinear" - factor : 0.01 - - gridname : "WUT" - fieldname_code : "potato" - fieldname_file : "mullions" - file_name : "INPUT/potato.nc" - interpol_method : "bilinear" - factor : 1e-06 - region_type : "inside_region" - lat_start : -89.1 - lat_end : 89.8 - lon_start : 3.4 - lon_end : 154.4 diff --git a/test_fms/parser/diag_table.yaml b/test_fms/parser/diag_table.yaml deleted file mode 100644 index 7bc468a8b1..0000000000 --- a/test_fms/parser/diag_table.yaml +++ /dev/null @@ -1,28 +0,0 @@ -title: c384L49_esm5PIcontrol -baseDate: [1960 1 1 1 1 1 1] -diag_files: -- fileName: "atmos_daily" - freq: 24 - frequnit: hours - timeunit: days - unlimdim: time - varlist: - - varName: tdata - reduction: False - module: mullions - mullions: 10 - fill_value: -999.9 - - varName: pdata - outName: pressure - reduction: False - kind: double - module: "moist" -- fileName: atmos_8xdaily - freq: 3 - frequnit: hours - timeunit: days - unlimdim: time - varlist: - - varName: tdata - reduction: False - module: "moist" diff --git a/test_fms/parser/test_yaml_parser.sh b/test_fms/parser/test_yaml_parser.sh index eb46002fb8..de134653d5 100755 --- a/test_fms/parser/test_yaml_parser.sh +++ b/test_fms/parser/test_yaml_parser.sh @@ -27,6 +27,58 @@ touch input.nml +cat <<_EOF > data_table.yaml +data_table: + - gridname : "ICE" + fieldname_code : "sic_obs" + fieldname_file : "ice" + file_name : "INPUT/hadisst_ice.data.nc" + interpol_method : "bilinear" + factor : 0.01 + - gridname : "WUT" + fieldname_code : "potato" + fieldname_file : "mullions" + file_name : "INPUT/potato.nc" + interpol_method : "bilinear" + factor : 1e-06 + region_type : "inside_region" + lat_start : -89.1 + lat_end : 89.8 + lon_start : 3.4 + lon_end : 154.4 +_EOF + +cat <<_EOF > diag_table.yaml +title: c384L49_esm5PIcontrol +baseDate: [1960 1 1 1 1 1 1] +diag_files: +- fileName: "atmos_daily" + freq: 24 + frequnit: hours + timeunit: days + unlimdim: time + varlist: + - varName: tdata + reduction: False + module: mullions + mullions: 10 + fill_value: -999.9 + - varName: pdata + outName: pressure + reduction: False + kind: double + module: "moist" +- fileName: atmos_8xdaily + freq: 3 + frequnit: hours + timeunit: days + unlimdim: time + varlist: + - varName: tdata + reduction: False + module: "moist" +_EOF + run_test test_yaml_parser 1 $parser_skip run_test parser_demo 1 $parser_skip run_test parser_demo2 1 $parser_skip