test_fms/parser/test_yaml_parser.F90

   1 !***********************************************************************
   2 !*                   GNU Lesser General Public License
   3 !*
   4 !* This file is part of the GFDL Flexible Modeling System (FMS).
   5 !*
   6 !* FMS is free software: you can redistribute it and/or modify it under
   7 !* the terms of the GNU Lesser General Public License as published by
   8 !* the Free Software Foundation, either version 3 of the License, or (at
   9 !* your option) any later version.
  10 !*
  11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
  12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 !* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 !* for more details.
  15 !*
  16 !* You should have received a copy of the GNU Lesser General Public
  17 !* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
  18 !***********************************************************************
  19
  20 !> @brief  This programs tests the public subroutines in parser/yaml_parser.F90
  21 program test_read_and_parse_file
  22
  23 #ifdef use_yaml
  24 use yaml_parser_mod
  25 use mpp_mod
  26 use fms_mod, only : fms_init, fms_end
  27 use platform_mod
  28
  29 implicit none
  30
  31 integer               :: yaml_file_id1   !< file id of a yaml file
  32 integer               :: nfiles          !< number of files
  33 integer               :: nvariables      !< number of variables
  34 integer, allocatable  :: file_ids(:)     !< array of file ids
  35 integer, allocatable  :: variable_ids(:) !< array of variable ids
  36 integer               :: yaml_file_id2   !< file id of a yaml file
  37 integer               :: nentries        !< number of entries
  38 integer, allocatable  :: entries_ids(:)  !< array of entries ids
  39 integer               :: zero            !< dummy integer buffer
  40 character(len=20)     :: string_buffer   !< string buffer
  41 integer(kind=i4_kind) :: i4_buffer       !< i4 buffer
  42 integer(kind=i8_kind) :: i8_buffer       !< i8 buffer
  43 real(kind=r4_kind)    :: r4_buffer       !< r4 buffer
  44 real(kind=r8_kind)    :: r8_buffer       !< r8 buffer
  45 integer               :: nkeys           !< number of keys
  46 integer, allocatable  :: key_ids(:)      !< array of key ids
  47 character(len=20)     :: key_name        !< the name of the key
  48 character(len=20)     :: key_value       !< the value of a key
  49 logical               :: logical_buffer  !< logical buffer
  50
  51 call fms_init
  52
  53 !< Test open_and_parse_file
  54 yaml_file_id1 = open_and_parse_file("diag_table.yaml")
  55 if (yaml_file_id1 .ne. 0) call mpp_error(FATAL, "The yaml_file_id for this file should be 0")
  56
  57 !< Test if multiple files can be opened
  58 yaml_file_id2 = open_and_parse_file("data_table.yaml")
  59 if (yaml_file_id2 .ne. 1) call mpp_error(FATAL, "The yaml_file_id for this file should be 1")
  60
  61 !< -----------------------------------
  62
  63 !< Test get_num_blocks
  64 nfiles = get_num_blocks(yaml_file_id1, "diag_files")
  65 if (nfiles .ne. 2) call mpp_error(FATAL, "There should be only 2 diag_files")
  66
  67 !< Test if a different yaml file id will work
  68 nentries = get_num_blocks(yaml_file_id2, "data_table")
  69 if (nentries .ne. 2) call mpp_error(FATAL, "There should be only 2 entries")
  70
  71 !< Try to look for a block that does not exist!
  72 zero = get_num_blocks(yaml_file_id2, "diag_files")
  73 if (zero .ne. 0) call mpp_error(FATAL, "'diag_files' should not exist in this file")
  74
  75 !< Try the parent block_id optional argument
  76 nvariables = get_num_blocks(yaml_file_id1, "varlist", parent_block_id=3) !< Number of variables that belong to the
  77                                                                          !! atmos_daily file in the diag_table.yaml
  78 if (nvariables .ne. 2) call mpp_error(FATAL, "There should only be 2 variables in the atmos_daily file")
  79
  80 !< -----------------------------------
  81
  82 !< Test get_block_ids
  83 allocate(file_ids(nfiles))
  84 call get_block_ids(yaml_file_id1, "diag_files", file_ids)
  85 if(file_ids(1) .ne. 3 .or. file_ids(2) .ne. 21) call mpp_error(FATAL, "The file_ids are wrong!")
  86
  87 !< Test to see if a diffrent yaml file id will work
  88 allocate(entries_ids(nentries))
  89 call get_block_ids(yaml_file_id2, "data_table", entries_ids)
  90 if(entries_ids(1) .ne. 1 .or. entries_ids(2) .ne. 8) call mpp_error(FATAL, "The entry_ids are wrong!")
  91
  92 !< Try the parent block id optional argument
  93 allocate(variable_ids(nvariables))
  94 call get_block_ids(yaml_file_id1, "varlist", variable_ids, parent_block_id=3)
  95 if (variable_ids(1) .ne. 9 .or. variable_ids(2) .ne. 15) call mpp_error(FATAL, "The variable_ids are wrong!")
  96
  97 !< Error check: *_ids is not the correct size
  98
  99 !< -----------------------------------
 100
 101 !< Test get_value_from_key
 102 !! Try get_value_from_key using a string buffer
 103 call get_value_from_key(yaml_file_id1, variable_ids(1), "varName", string_buffer)
 104 if (trim(string_buffer) .ne. "tdata") call mpp_error(FATAL, "varName was not read correctly!")
 105
 106 !! Try get_value_from_key using a i4 buffer
 107 call get_value_from_key(yaml_file_id1, variable_ids(1), "mullions", i4_buffer)
 108 if (i4_buffer .ne. int(10, kind=i4_kind)) call mpp_error(FATAL, "mullions was not read correctly as an i4!")
 109
 110 !! Try get_value_from_key using a i8 buffer
 111 call get_value_from_key(yaml_file_id1, variable_ids(1), "mullions", i8_buffer)
 112 if (i8_buffer .ne. int(10, kind=i8_kind)) call mpp_error(FATAL, "mullions was not read correctly as an i8!")
 113
 114 !! Try get_value_from_key using a r4 buffer
 115 call get_value_from_key(yaml_file_id1, variable_ids(1), "fill_value", r4_buffer)
 116 if (r4_buffer .ne. real(-999.9, kind=r4_kind)) call mpp_error(FATAL, "fill_value was not read correctly as an r4!")
 117
 118 !! Try get_value_from_key using a r8 buffer
 119 call get_value_from_key(yaml_file_id1, variable_ids(1), "fill_value", r8_buffer)
 120 if (abs(r8_buffer - real(-999.9, kind=r8_kind)) .gt. 5d-5) then
 121   call mpp_error(FATAL, "fill_value was not read correctly as an r8!")
 122 endif
 123
 124 !! Try get_value_from_key using a logical buffer
 125 logical_buffer = .true.
 126 call get_value_from_key(yaml_file_id2, entries_ids(2), "do_data_bug", logical_buffer)
 127 if (logical_buffer) call mpp_error(FATAL, "do_data_bug was not read correctly as a logical")
 128
 129 logical_buffer = .false.
 130 call get_value_from_key(yaml_file_id2, entries_ids(2), "use_data_bug", logical_buffer)
 131 if (.not. logical_buffer) call mpp_error(FATAL, "use_data_bug was not read correctly as a logical")
 132
 133 !! Try the is_optional argument on an key that does not exist
 134 string_buffer = ""
 135 call get_value_from_key(yaml_file_id1, variable_ids(1), "NANANANA", string_buffer, is_optional=.true.)
 136 if (trim(string_buffer) .ne. "") call mpp_error(FATAL, "string_buffer was set when they key does not exist?")
 137
 138 !< -----------------------------------
 139
 140 !< Test nkeys
 141 nkeys = get_nkeys(yaml_file_id1, variable_ids(1))
 142 if (nkeys .ne. 5) call mpp_error(FATAL, "The number of keys was not read correctly")
 143
 144 !< -----------------------------------
 145
 146 !< Test get_key_ids
 147 allocate(key_ids(nkeys))
 148 call get_key_ids(yaml_file_id1, variable_ids(1), key_ids)
 149 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)&
 150   & call mpp_error(FATAL, "The key ids obtained are wrong")
 151
 152 !< -----------------------------------
 153
 154 !< Test get_key_name
 155 call get_key_name(yaml_file_id1, key_ids(1), key_name)
 156 if ((trim(key_name) .ne. "varName")) call mpp_error(FATAL, "get_key_name did not output the correct name")
 157
 158 !< Test get_key_value
 159 call get_key_value(yaml_file_id1, key_ids(1), key_value)
 160 if ((trim(key_value) .ne. "tdata")) call mpp_error(FATAL, "get_key_name did not output the correct name")
 161
 162 deallocate(key_ids)
 163 deallocate(variable_ids)
 164 deallocate(entries_ids)
 165 deallocate(file_ids)
 166
 167 call fms_end
 168 #endif
 169 end program