Changeset 5837 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/variable.f90
- Timestamp:
- 2015-10-26T15:59:39+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/variable.f90
r4213 r5837 11 11 !> @details 12 12 !> define type TVAR:<br/> 13 !> TYPE(TVAR) :: tl_var<br/> 13 !> @code 14 !> TYPE(TVAR) :: tl_var 15 !> @endcode 14 16 !> 15 !> the variable value will always be 4D tableof real(8).<br/>17 !> @note the variable value inside structure will always be 4D array of real(8).<br/> 16 18 !> However the variable value could be initialised with 17 !> table of real(4), real(8), integer(4) or integer(8)19 !> array of real(4), real(8), integer(4) or integer(8). 18 20 !> 19 21 !> to initialise a variable structure:<br/> 20 !> tl_var=var_init( cd_name, [value,] [id_start, [id_count,]] [td_dim,] [td_att] ) 22 !> @code 23 !> tl_var=var_init( cd_name, [value,] [id_start, [id_count,]] [id_type,] [td_dim,] [td_att]... ) 24 !> @endcode 21 25 !> - cd_name is the variable name 22 !> - value is a 4D table ordered as ('x','y','z','t') (optional) 23 !> (real(4), real(8), integer(4) or integer(8) 24 !> - id_start is a integer(4) 1D table of index from which the data 25 !> values will be read (optional) 26 !> - id_count is a integer(4) 1D table of the number of indices selected 27 !> along each dimension (optional) 28 !> - td_dim is the table of dimension structure (optional) 29 !> - td_att is the table of attribute structure (optional) 26 !> - value is a 1D,2D,3D or 4D array, see var_init for more information [optional] 27 !> - id_start is a integer(4) 1D array of index from which the data 28 !> values will be read [optional] 29 !> - id_count is a integer(4) 1D array of the number of indices selected 30 !> along each dimension [optional] 31 !> - id_type is the type of the variable to be used [optional] 32 !> - td_dim is the array of dimension structure [optional] 33 !> - td_att is the array of attribute structure [optional] 34 !> Note:<br/> 35 !> - others optionals arguments could be added, see var_init. 36 !> - to put variable 0D, use td_dim with all dimension unused 37 !> (td_dim(:)%l_use=.FALSE.) 38 !> 39 !> to print information about variable structure:<br/> 40 !> @code 41 !> CALL var_print(td_var [,ld_more]) 42 !> @endcode 43 !> - td_var is the variable structure 44 !> - ld_more to print more infomration about variable 30 45 !> 31 !> to print information about variable structure:<br/> 32 !> CALL var_print(tl_var) 46 !> to clean variable structure:<br/> 47 !> @code 48 !> CALL var_clean(tl_var) 49 !> @endcode 50 !> 51 !> to copy variable structure in another one (using different memory cell):<br/> 52 !> @code 53 !> tl_var2=var_copy(tl_var1) 54 !> @endcode 55 !> @note as we use pointer for the value array of the variable structure, 56 !> the use of the assignment operator (=) to copy variable structure 57 !> create a pointer on the same array. 58 !> This is not the case with this copy function. 33 59 !> 34 60 !> to get variable name:<br/> 35 61 !> - tl_var\%c_name 36 !> 62 !> 63 !> to get grid point of the variable:<br/> 64 !> - tl_var\%c_point 65 !> 66 !> to get EW overlap:<br/> 67 !> - tl_var\%i_ew 68 !> 37 69 !> to get variable value:<br/> 38 70 !> - tl_var\%d_value(:,:,:,:) … … 42 74 !> - tl_var\%i_type 43 75 !> 44 !> to get variable id ( affected when variable will be added toa file):<br/>76 !> to get variable id (read from a file):<br/> 45 77 !> - tl_var\%i_id 46 78 !> … … 49 81 !> - tl_var\%i_ndim 50 82 !> 51 !> to get the tableof dimension structure (4 elts) associated to the83 !> to get the array of dimension structure (4 elts) associated to the 52 84 !> variable:<br/> 53 85 !> - tl_var\%t_dim(:) 54 86 !> 55 87 !> Variable attributes<br/> 56 !> attribue value are always character or real(8) 1D table.<br/> 88 !> @note attribue value are always character or real(8) 1D array.<br/> 89 !> 57 90 !> to get the number of attributes of the variable:<br/> 58 91 !> - tl_var\%i_natt 59 92 !> 60 !> to get the tableof attribute structure associated to the93 !> to get the array of attribute structure associated to the 61 94 !> variable:<br/> 62 95 !> - tl_var\%t_att(:) … … 66 99 !> - tl_var\%c_stdname 67 100 !> 101 !> to get variable longname:<br/> 102 !> - tl_var\%c_longname 103 !> 68 104 !> to get variable units:<br/> 69 105 !> - tl_var\%c_units 106 !> 107 !> to get variable axis:<br/> 108 !> - tl_var\%c_axis 70 109 !> 71 110 !> to get variable scale factor:<br/> … … 79 118 !> 80 119 !> to add value to a variable structure:<br/> 81 !> CALL var_add_value(tl_var, value, [id_start, [id_count]]) 82 !> - value : 4D table of value (real(4), real(8), integer(4), integer(8)) 83 !> - id_start : 1D table of the index in the variable from which the data 120 !> @code 121 !> CALL var_add_value(tl_var, value, [id_type,] [id_start, [id_count]]) 122 !> @endcode 123 !> - value : 4D array of value (real(4), real(8), integer(1), integer(2), integer(4), integer(8)) 124 !> - id_type is the type of the variable to be used (default is the type 125 !> of array value) 126 !> - id_start : 1D array of the index in the variable from which the data 84 127 !> values will be read (integer(4), optional) 85 !> - id_count : 1D tableof the number of indices selected along each128 !> - id_count : 1D array of the number of indices selected along each 86 129 !> dimension (integer(4), optional) 87 130 !> 88 !> to add one attribute to a variable structure:<br/> 131 !> to add attribute to a variable structure:<br/> 132 !> @code 89 133 !> CALL var_add_att(tl_var, td_att) 90 !> - td_att is an attribute structure 134 !> @endcode 135 !> - td_att is an attribute structure, or array of attribute structure 91 136 !> 92 !> to add one dimension to a variable structure:<br/> 137 !> to add dimension to a variable structure:<br/> 138 !> @code 93 139 !> CALL var_add_dim(tl_var, td_dim) 94 !> - td_dim is a dimension structure 140 !> @endcode 141 !> - td_dim is a dimension structure, or array of dimension structure 95 142 !> 96 143 !> to delete value of a variable structure:<br/> 144 !> @code 97 145 !> CALL var_del_value(tl_var) 146 !> @endcode 98 147 !> 99 148 !> to delete one attribute of a variable structure:<br/> 149 !> @code 100 150 !> CALL var_del_att(tl_var, td_att) 151 !> @endcode 101 152 !> - td_att is an attribute structure 153 !> or 154 !> @code 155 !> CALL var_del_att(tl_var, cd_name) 156 !> @endcode 157 !> - cd_name is attribute name 102 158 !> 103 159 !> to delete one dimension of a variable structure:<br/> 160 !> @code 104 161 !> CALL var_del_dim(tl_var, td_dim) 162 !> @endcode 105 163 !> - td_dim is a dimension structure 106 164 !> 107 165 !> to overwrite one attribute structure in variable structure:<br/> 166 !> @code 108 167 !> CALL var_move_att(tl_var, td_att) 168 !> @endcode 109 169 !> - td_att is an attribute structure 110 170 !> 111 171 !> to overwrite one dimension structure in variable structure:<br/> 172 !> @code 112 173 !> CALL var_move_dim(tl_var, td_dim) 174 !> @endcode 113 175 !> - td_dim is a dimension structure 114 176 !> 177 !> to get the mask of a variable strucutre, (based on its FillValue):<br/> 178 !> @code 179 !> mask(:,:)=var_get_mask(tl_var) 180 !> @endcode 181 !> 182 !> to change FillValue to standard NETCDF Fill Value:<br/> 183 !> @code 184 !> CALL var_chg_FillValue(tl_var, [dd_fill]) 185 !> @endcode 186 !> - dd_fill is the FillValue to be used [optional] 187 !> 188 !> to concatenate two variables:<br/> 189 !> @code 190 !> tl_var=var_concat(tl_var1, tl_var2, [DIM]) 191 !> @endcode 192 !> - tl_var1 : variable structure 193 !> - tl_var2 : variable structure 194 !> - DIM : number of the dimension following which concatenate (1=>I, 2=>J, 3=>Z, 4=>T) [optional, default=4] 195 !> 196 !> to forced min and max value of a variable:<br/> 197 !> define min and max value of the variable:<br/> 198 !> tl_var\%d_min=min<br/> 199 !> tl_var\%d_max=max<br/> 200 !> then<br/> 201 !> @code 202 !> CALL var_limit_value( tl_var ) 203 !> @endcode 204 !> - min and max : real(8) value 205 !> 206 !> to get the biggest dimensions use in a array of variable:<br/> 207 !> @code 208 !> tl_dim(:)=var_max_dim(tl_var(:)) 209 !> @endcode 210 !> - tl_var(:) : array of variable structure 211 !> - tl_dim(:) : array (4 elts) of dimension structure 212 !> 213 !> to reorder dimension of a variable (default 'x','y','z','t'):<br/> 214 !> @code 215 !> CALL var_reorder( td_var, cd_dimorder ) 216 !> @endcode 217 !> - td_var is variable structure 218 !> - cd_dimorder string character(LEN=4) of dimension order to be used (example: 219 !> 'yxzt') [optional] 220 !> 221 !> to get variable index, in an array of variable structure:<br/> 222 !> @code 223 !> il_index=var_get_index( td_var, cd_name ) 224 !> @endcode 225 !> - td_var array of variable structure 226 !> - cd_name variable name 227 !> 228 !> to get variable id, read from a file:<br/> 229 !>@code 230 !> il_id=var_get_id( td_var, cd_name ) 231 !>@endcode 232 !> - td_var array of variable structure 233 !> - cd_name variable name 234 !> 235 !> to get free variable unit in an array of variable structure:<br/> 236 !>@code 237 !> il_unit=var_get_unit(td_var) 238 !>@endcode 239 !> - td_var array of variable structure 240 !> 241 !> to convert time variable structure in date structure:<br/> 242 !>@code 243 !> tl_date=var_to_date(td_var) 244 !>@endcode 245 !> - td_var is time variable structure 246 !> - tl_date is date structure 247 !> 248 !> to read matrix value from character string in namelist 249 !>@code 250 !> CALL var_read_matrix(td_var, cd_matrix) 251 !>@endcode 252 !> - td_var is variable structure 253 !> - cd_matrix is matrix value 254 !> 255 !> to read variable configuration file ('variable.cfg') and fill global array 256 !> of variable structure:<br/> 257 !>@code 258 !> CALL var_def_extra( cd_file ) 259 !>@endcode 260 !> - cd_file is filename 261 !> 262 !> to add variable information get from namelist, in global array of variable 263 !> structure: 264 !>@code 265 !> CALL var_chg_extra( cd_varinfo ) 266 !>@endcode 267 !> - cd_varinfo is variable information from namelist 268 !> 269 !> to check variable dimension expected, as defined in file 'variable.cfg':<br/> 270 !>@code 271 !> CALL var_check_dim( td_var ) 272 !>@endcode 273 !> - td_var is variable structure 274 !> 115 275 !> @author 116 276 !> J.Paul 117 277 ! REVISION HISTORY: 118 !> @date Nov, 2013 - Initial Version 278 !> @date November, 2013 - Initial Version 279 !> @date September, 2014 280 !> - add var_reorder 281 !> @date November, 2014 282 !> - Fix memory leaks bug 119 283 ! 120 284 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 121 !> @todo122 !> - manage ew_wrap in structure123 !> - manage c_point in structure124 !> - think about create init for 0D 1D 2D 3D input table125 !> - creer module cfg qui lit et def tg_varcfg (pb var_get_extra appele ds126 !> var_init)127 285 !---------------------------------------------------------------------- 128 286 MODULE var … … 130 288 USE global ! global variable 131 289 USE kind ! F90 kind parameter 132 USE logger ! log file manager 290 USE logger ! log file manager 291 USE date ! date manager 133 292 USE fct ! basic useful function 134 293 USE att ! attribute manager 135 294 USE dim ! dimension manager 136 295 IMPLICIT NONE 137 PRIVATE138 296 ! NOTE_avoid_public_variables_if_possible 139 297 … … 141 299 PUBLIC :: TVAR !< variable structure 142 300 143 PUBLIC :: tg_varextra !< tableof variable structure with extra information.301 PUBLIC :: tg_varextra !< array of variable structure with extra information. 144 302 145 303 ! function and subroutine 146 PUBLIC :: ASSIGNMENT(=) !< copy variable structure 147 PUBLIC :: var_init !< initialize variable structure 148 PUBLIC :: var_print !< print variable information 149 PUBLIC :: var_clean !< clean variable structure 150 PUBLIC :: var_get_id !< return the variable id, from a table of variable structure 151 PUBLIC :: var_add_value !< add table of value in variable structure 152 PUBLIC :: var_add_att !< add attribute structure in variable structure 153 PUBLIC :: var_add_dim !< add dimension structure in variable structure 154 PUBLIC :: var_del_value !< delete table of value of variable structure 155 PUBLIC :: var_del_att !< delete one attribute structure of variable structure 156 PUBLIC :: var_del_dim !< delete one dimension structure of variable structure 157 PUBLIC :: var_move_att !< overwrite one attribute structure in variable structure 158 PUBLIC :: var_move_dim !< overwrite one dimension structure in variable structure 159 PUBLIC :: var_get_mask !< return the mask of variable 160 PUBLIC :: var_chg_FillValue !< change FillValue to standard NETCDF Fill Value 161 PUBLIC :: var_def_extra !< read variable configuration file, and save extra information. 162 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 163 PUBLIC :: var_read_matrix !< 164 ! PUBLIC :: var_match_file !< read variable namelist information, and modify extra information. 165 PUBLIC :: var_max_dim !< get table of maximum dimension use 166 PUBLIC :: var_concat !< concatenate two variables 167 PUBLIC :: var_limit_value !< forced min and max value 168 PUBLIC :: var_check_dim !< check variable dimension expected 169 170 ! PUBLIC :: var_ended !< deallocate global variable 171 172 PRIVATE :: var__add_value_dp !< add table of value real(8) in variable structure 173 PRIVATE :: var__add_value_rp !< add table of value real(4) in variable structure 174 PRIVATE :: var__add_value_i1 !< add table of value integer(1) in variable structure 175 PRIVATE :: var__add_value_i2 !< add table of value integer(2) in variable structure 176 PRIVATE :: var__add_value_i4 !< add table of value integer(4) in variable structure 177 PRIVATE :: var__add_value_i8 !< add table of value integer(8) in variable structure 178 PRIVATE :: var__init !< initialse variable structure without table of value 179 PRIVATE :: var__init_dp !< initialse variable structure with real(8) 4D table of value 180 PRIVATE :: var__init_1D_dp !< initialse variable structure with real(8) 1D table of value 181 PRIVATE :: var__init_2D_dp !< initialse variable structure with real(8) 2D table of value 182 PRIVATE :: var__init_3D_dp !< initialse variable structure with real(8) 3D table of value 183 PRIVATE :: var__init_sp !< initialse variable structure with real(4) 4D table of value 184 PRIVATE :: var__init_1D_sp !< initialse variable structure with real(4) 1D table of value 185 PRIVATE :: var__init_2D_sp !< initialse variable structure with real(4) 2D table of value 186 PRIVATE :: var__init_3D_sp !< initialse variable structure with real(4) 3D table of value 187 PRIVATE :: var__init_i1 !< initialse variable structure with integer(1) 4D table of value 188 PRIVATE :: var__init_1D_i1 !< initialse variable structure with integer(1) 1D table of value 189 PRIVATE :: var__init_2D_i1 !< initialse variable structure with integer(1) 2D table of value 190 PRIVATE :: var__init_3D_i1 !< initialse variable structure with integer(1) 3D table of value 191 PRIVATE :: var__init_i2 !< initialse variable structure with integer(2) 4D table of value 192 PRIVATE :: var__init_1D_i2 !< initialse variable structure with integer(2) 1D table of value 193 PRIVATE :: var__init_2D_i2 !< initialse variable structure with integer(2) 2D table of value 194 PRIVATE :: var__init_3D_i2 !< initialse variable structure with integer(2) 3D table of value 195 PRIVATE :: var__init_i4 !< initialse variable structure with integer(4) 4D table of value 196 PRIVATE :: var__init_1D_i4 !< initialse variable structure with integer(4) 1D table of value 197 PRIVATE :: var__init_2D_i4 !< initialse variable structure with integer(4) 2D table of value 198 PRIVATE :: var__init_3D_i4 !< initialse variable structure with integer(4) 3D table of value 199 PRIVATE :: var__init_i8 !< initialse variable structure with integer(8) 4D table of value 200 PRIVATE :: var__init_1D_i8 !< initialse variable structure with integer(8) 1D table of value 201 PRIVATE :: var__init_2D_i8 !< initialse variable structure with integer(8) 2D table of value 202 PRIVATE :: var__init_3D_i8 !< initialse variable structure with integer(8) 3D table of value 203 PRIVATE :: var__add_dim_unit !< add one dimension structure in variable structure 204 PRIVATE :: var__add_dim_tab !< add a table of dimension structure in variable structure 205 PRIVATE :: var__add_att_unit !< add one attribute structure in variable structure 206 PRIVATE :: var__add_att_tab !< add a table of attribute structure in variable structure 207 PRIVATE :: var__add_dim !< add a dimension structure in a variable structure. 208 PRIVATE :: var__add_value !< add a 4D table of double value in a variable structure. 209 PRIVATE :: var__copy_unit !< copy variable structure 210 PRIVATE :: var__copy_tab !< copy variable structure 211 PRIVATE :: var__get_extra !< add extra information in variable structure 212 PRIVATE :: var__concat_i !< concatenate varibales in i-direction 213 PRIVATE :: var__concat_j !< concatenate varibales in j-direction 214 PRIVATE :: var__concat_k !< concatenate varibales in k-direction 215 PRIVATE :: var__concat_l !< concatenate varibales in l-direction 216 PRIVATE :: var__get_max !< get maximum value from namelist 217 PRIVATE :: var__get_min !< get minimum value from namelist 218 PRIVATE :: var__get_interp !< get interpolation method from namelist 219 PRIVATE :: var__get_extrap !< get extrapolation method from namelist 220 PRIVATE :: var__get_filter !< get filter method from namelist 221 222 !> @struct TVAR 223 TYPE TVAR 304 PUBLIC :: var_init !< initialize variable structure 305 PUBLIC :: var_print !< print variable information 306 PUBLIC :: var_clean !< clean variable structure 307 PUBLIC :: var_copy !< copy variable structure 308 PUBLIC :: var_add_value !< add array of value in variable structure 309 PUBLIC :: var_add_att !< add attribute structure in variable structure 310 PUBLIC :: var_add_dim !< add dimension structure in variable structure 311 PUBLIC :: var_del_value !< delete array of value of variable structure 312 PUBLIC :: var_del_att !< delete one attribute structure of variable structure 313 PUBLIC :: var_del_dim !< delete one dimension structure of variable structure 314 PUBLIC :: var_move_att !< overwrite one attribute structure in variable structure 315 PUBLIC :: var_move_dim !< overwrite one dimension structure in variable structure 316 PUBLIC :: var_get_mask !< return the mask of variable 317 PUBLIC :: var_chg_FillValue !< change FillValue to standard NETCDF Fill Value 318 PUBLIC :: var_concat !< concatenate two variables 319 PUBLIC :: var_limit_value !< forced min and max value 320 PUBLIC :: var_max_dim !< get array of maximum dimension use 321 PUBLIC :: var_reorder !< reorder table of value in variable structure 322 PUBLIC :: var_get_index !< return the variable index, in an array of variable structure 323 PUBLIC :: var_get_id !< return the variable id, read from a file 324 PUBLIC :: var_get_unit !< get free variable unit in an array of variable structure 325 PUBLIC :: var_to_date !< convert time variable structure in date structure 326 PUBLIC :: var_read_matrix !< read matrix value from character string in namelist 327 PUBLIC :: var_def_extra !< read variable configuration file, and save extra information. 328 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 329 PUBLIC :: var_check_dim !< check variable dimension expected 330 331 PRIVATE :: var__init ! initialize variable structure without array of value 332 PRIVATE :: var__init_dp ! initialize variable structure with real(8) 4D array of value 333 PRIVATE :: var__init_1D_dp ! initialize variable structure with real(8) 1D array of value 334 PRIVATE :: var__init_2D_dp ! initialize variable structure with real(8) 2D array of value 335 PRIVATE :: var__init_3D_dp ! initialize variable structure with real(8) 3D array of value 336 PRIVATE :: var__init_sp ! initialize variable structure with real(4) 4D array of value 337 PRIVATE :: var__init_1D_sp ! initialize variable structure with real(4) 1D array of value 338 PRIVATE :: var__init_2D_sp ! initialize variable structure with real(4) 2D array of value 339 PRIVATE :: var__init_3D_sp ! initialize variable structure with real(4) 3D array of value 340 PRIVATE :: var__init_i1 ! initialize variable structure with integer(1) 4D array of value 341 PRIVATE :: var__init_1D_i1 ! initialize variable structure with integer(1) 1D array of value 342 PRIVATE :: var__init_2D_i1 ! initialize variable structure with integer(1) 2D array of value 343 PRIVATE :: var__init_3D_i1 ! initialize variable structure with integer(1) 3D array of value 344 PRIVATE :: var__init_i2 ! initialize variable structure with integer(2) 4D array of value 345 PRIVATE :: var__init_1D_i2 ! initialize variable structure with integer(2) 1D array of value 346 PRIVATE :: var__init_2D_i2 ! initialize variable structure with integer(2) 2D array of value 347 PRIVATE :: var__init_3D_i2 ! initialize variable structure with integer(2) 3D array of value 348 PRIVATE :: var__init_i4 ! initialize variable structure with integer(4) 4D array of value 349 PRIVATE :: var__init_1D_i4 ! initialize variable structure with integer(4) 1D array of value 350 PRIVATE :: var__init_2D_i4 ! initialize variable structure with integer(4) 2D array of value 351 PRIVATE :: var__init_3D_i4 ! initialize variable structure with integer(4) 3D array of value 352 PRIVATE :: var__init_i8 ! initialize variable structure with integer(8) 4D array of value 353 PRIVATE :: var__init_1D_i8 ! initialize variable structure with integer(8) 1D array of value 354 PRIVATE :: var__init_2D_i8 ! initialize variable structure with integer(8) 2D array of value 355 PRIVATE :: var__init_3D_i8 ! initialize variable structure with integer(8) 3D array of value 356 PRIVATE :: var__print_unit ! print information on one variable 357 PRIVATE :: var__print_arr ! print information on a array of variables 358 PRIVATE :: var__clean_unit ! clean variable structure 359 PRIVATE :: var__clean_arr_1D ! clean 1D array of variable structure 360 PRIVATE :: var__clean_arr_2D ! clean 2D array of variable structure 361 PRIVATE :: var__clean_arr_3D ! clean 3D array of variable structure 362 PRIVATE :: var__add_value_dp ! add array of value real(8) in variable structure 363 PRIVATE :: var__add_value_rp ! add array of value real(4) in variable structure 364 PRIVATE :: var__add_value_i1 ! add array of value integer(1) in variable structure 365 PRIVATE :: var__add_value_i2 ! add array of value integer(2) in variable structure 366 PRIVATE :: var__add_value_i4 ! add array of value integer(4) in variable structure 367 PRIVATE :: var__add_value_i8 ! add array of value integer(8) in variable structure 368 PRIVATE :: var__add_att_unit ! add one attribute structure in variable structure 369 PRIVATE :: var__add_att_arr ! add a array of attribute structure in variable structure 370 PRIVATE :: var__del_att_name ! delete one attribute given attribute name 371 PRIVATE :: var__del_att_str ! delete one attribute given attribute structure 372 PRIVATE :: var__add_dim_unit ! add one dimension structure in variable structure 373 PRIVATE :: var__add_dim_arr ! add a array of dimension structure in variable structure 374 PRIVATE :: var__add_value ! add a 4D array of real(8) value in a variable structure. 375 PRIVATE :: var__copy_unit ! copy variable structure 376 PRIVATE :: var__copy_arr ! copy a array of variable structure 377 PRIVATE :: var__get_extra ! add extra information in variable structure 378 PRIVATE :: var__concat_i ! concatenate varibales in i-direction 379 PRIVATE :: var__concat_j ! concatenate varibales in j-direction 380 PRIVATE :: var__concat_k ! concatenate varibales in k-direction 381 PRIVATE :: var__concat_l ! concatenate varibales in l-direction 382 PRIVATE :: var__get_max ! get maximum value from namelist 383 PRIVATE :: var__get_min ! get minimum value from namelist 384 PRIVATE :: var__get_interp ! get interpolation method from namelist 385 PRIVATE :: var__get_extrap ! get extrapolation method from namelist 386 PRIVATE :: var__get_filter ! get filter method from namelist 387 388 TYPE TVAR !< variable structure 224 389 225 390 CHARACTER(LEN=lc) :: c_name = '' !< variable name 226 CHARACTER(LEN=lc) :: c_point = ' ' !< type of grid point391 CHARACTER(LEN=lc) :: c_point = 'T' !< ARAKAWA C-grid point name (T,U,V,F) 227 392 INTEGER(i4) :: i_id = 0 !< variable id 228 INTEGER(i4) :: i_ew = 0!< east-west overlap393 INTEGER(i4) :: i_ew = -1 !< east-west overlap 229 394 230 395 REAL(dp) , DIMENSION(:,:,:,:), POINTER :: d_value => NULL() !< variable value … … 237 402 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension 238 403 239 ! highlight some attribute 404 LOGICAL :: l_file = .FALSE. !< variable read in a file 405 406 ! highlight some attributes 240 407 CHARACTER(LEN=lc) :: c_stdname = ''!< variable standard name 241 408 CHARACTER(LEN=lc) :: c_longname = ''!< variable long name … … 245 412 REAL(dp) :: d_ofs = 0. !< offset 246 413 REAL(dp) :: d_fill= 0. !< fill value ! NF90_FILL_DOUBLE 247 REAL(dp) :: d_min = d g_fill !< minimum value248 REAL(dp) :: d_max = d g_fill !< maximum value414 REAL(dp) :: d_min = dp_fill !< minimum value 415 REAL(dp) :: d_max = dp_fill !< maximum value 249 416 250 417 !!! netcdf4 … … 256 423 257 424 !!! dimg 258 INTEGER(i4) :: i_rec = 0 !< record number425 INTEGER(i4) :: i_rec = 0 !< record number 259 426 260 427 CHARACTER(LEN=lc), DIMENSION(2) :: c_interp = '' !< interpolation method … … 264 431 END TYPE TVAR 265 432 266 TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< tableof variable structure with extra information.433 TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information. 267 434 !< fill when running var_def_extra() 268 435 436 INTERFACE var_init 437 MODULE PROCEDURE var__init ! initialize variable structure without array of value 438 MODULE PROCEDURE var__init_dp ! initialize variable structure with real(8) 4D array of value 439 MODULE PROCEDURE var__init_1D_dp ! initialize variable structure with real(8) 1D array of value 440 MODULE PROCEDURE var__init_2D_dp ! initialize variable structure with real(8) 2D array of value 441 MODULE PROCEDURE var__init_3D_dp ! initialize variable structure with real(8) 3D array of value 442 MODULE PROCEDURE var__init_sp ! initialize variable structure with real(4) 4D array of value 443 MODULE PROCEDURE var__init_1D_sp ! initialize variable structure with real(4) 1D array of value 444 MODULE PROCEDURE var__init_2D_sp ! initialize variable structure with real(4) 2D array of value 445 MODULE PROCEDURE var__init_3D_sp ! initialize variable structure with real(4) 3D array of value 446 MODULE PROCEDURE var__init_i1 ! initialize variable structure with integer(1) 4D array of value 447 MODULE PROCEDURE var__init_1D_i1 ! initialize variable structure with integer(1) 1D array of value 448 MODULE PROCEDURE var__init_2D_i1 ! initialize variable structure with integer(1) 2D array of value 449 MODULE PROCEDURE var__init_3D_i1 ! initialize variable structure with integer(1) 3D array of value 450 MODULE PROCEDURE var__init_i2 ! initialize variable structure with integer(2) 4D array of value 451 MODULE PROCEDURE var__init_1D_i2 ! initialize variable structure with integer(2) 1D array of value 452 MODULE PROCEDURE var__init_2D_i2 ! initialize variable structure with integer(2) 2D array of value 453 MODULE PROCEDURE var__init_3D_i2 ! initialize variable structure with integer(2) 3D array of value 454 MODULE PROCEDURE var__init_i4 ! initialize variable structure with integer(4) 4D array of value 455 MODULE PROCEDURE var__init_1D_i4 ! initialize variable structure with integer(4) 1D array of value 456 MODULE PROCEDURE var__init_2D_i4 ! initialize variable structure with integer(4) 2D array of value 457 MODULE PROCEDURE var__init_3D_i4 ! initialize variable structure with integer(4) 3D array of value 458 MODULE PROCEDURE var__init_i8 ! initialize variable structure with integer(8) 4D array of value 459 MODULE PROCEDURE var__init_1D_i8 ! initialize variable structure with integer(8) 1D array of value 460 MODULE PROCEDURE var__init_2D_i8 ! initialize variable structure with integer(8) 2D array of value 461 MODULE PROCEDURE var__init_3D_i8 ! initialize variable structure with integer(8) 3D array of value 462 END INTERFACE var_init 463 464 INTERFACE var_print 465 MODULE PROCEDURE var__print_unit ! print information on one variable 466 MODULE PROCEDURE var__print_arr ! print information on a array of variables 467 END INTERFACE var_print 468 469 INTERFACE var_clean 470 MODULE PROCEDURE var__clean_unit 471 MODULE PROCEDURE var__clean_arr_1D 472 MODULE PROCEDURE var__clean_arr_2D 473 MODULE PROCEDURE var__clean_arr_3D 474 END INTERFACE 475 269 476 INTERFACE var_add_value 270 MODULE PROCEDURE var__add_value_dp ! add tableof value real(8) in variable structure271 MODULE PROCEDURE var__add_value_rp ! add tableof value real(4) in variable structure272 MODULE PROCEDURE var__add_value_i1 ! add tableof value integer(1) in variable structure273 MODULE PROCEDURE var__add_value_i2 ! add tableof value integer(2) in variable structure274 MODULE PROCEDURE var__add_value_i4 ! add tableof value integer(4) in variable structure275 MODULE PROCEDURE var__add_value_i8 ! add tableof value integer(8) in variable structure477 MODULE PROCEDURE var__add_value_dp ! add array of value real(8) in variable structure 478 MODULE PROCEDURE var__add_value_rp ! add array of value real(4) in variable structure 479 MODULE PROCEDURE var__add_value_i1 ! add array of value integer(1) in variable structure 480 MODULE PROCEDURE var__add_value_i2 ! add array of value integer(2) in variable structure 481 MODULE PROCEDURE var__add_value_i4 ! add array of value integer(4) in variable structure 482 MODULE PROCEDURE var__add_value_i8 ! add array of value integer(8) in variable structure 276 483 END INTERFACE var_add_value 277 484 278 INTERFACE var_init 279 MODULE PROCEDURE var__init ! initialse variable structure without table of value 280 MODULE PROCEDURE var__init_dp ! initialse variable structure with real(8) 4D table of value 281 MODULE PROCEDURE var__init_1D_dp ! initialse variable structure with real(8) 1D table of value 282 MODULE PROCEDURE var__init_2D_dp ! initialse variable structure with real(8) 2D table of value 283 MODULE PROCEDURE var__init_3D_dp ! initialse variable structure with real(8) 3D table of value 284 MODULE PROCEDURE var__init_sp ! initialse variable structure with real(4) 4D table of value 285 MODULE PROCEDURE var__init_1D_sp ! initialse variable structure with real(4) 1D table of value 286 MODULE PROCEDURE var__init_2D_sp ! initialse variable structure with real(4) 2D table of value 287 MODULE PROCEDURE var__init_3D_sp ! initialse variable structure with real(4) 3D table of value 288 MODULE PROCEDURE var__init_i1 ! initialse variable structure with integer(1) 4D table of value 289 MODULE PROCEDURE var__init_1D_i1 ! initialse variable structure with integer(1) 1D table of value 290 MODULE PROCEDURE var__init_2D_i1 ! initialse variable structure with integer(1) 2D table of value 291 MODULE PROCEDURE var__init_3D_i1 ! initialse variable structure with integer(1) 3D table of value 292 MODULE PROCEDURE var__init_i2 ! initialse variable structure with integer(2) 4D table of value 293 MODULE PROCEDURE var__init_1D_i2 ! initialse variable structure with integer(2) 1D table of value 294 MODULE PROCEDURE var__init_2D_i2 ! initialse variable structure with integer(2) 2D table of value 295 MODULE PROCEDURE var__init_3D_i2 ! initialse variable structure with integer(2) 3D table of value 296 MODULE PROCEDURE var__init_i4 ! initialse variable structure with integer(4) 4D table of value 297 MODULE PROCEDURE var__init_1D_i4 ! initialse variable structure with integer(4) 1D table of value 298 MODULE PROCEDURE var__init_2D_i4 ! initialse variable structure with integer(4) 2D table of value 299 MODULE PROCEDURE var__init_3D_i4 ! initialse variable structure with integer(4) 3D table of value 300 MODULE PROCEDURE var__init_i8 ! initialse variable structure with integer(8) 4D table of value 301 MODULE PROCEDURE var__init_1D_i8 ! initialse variable structure with integer(8) 1D table of value 302 MODULE PROCEDURE var__init_2D_i8 ! initialse variable structure with integer(8) 2D table of value 303 MODULE PROCEDURE var__init_3D_i8 ! initialse variable structure with integer(8) 3D table of value 304 END INTERFACE var_init 485 INTERFACE var_add_att 486 MODULE PROCEDURE var__add_att_unit ! add one attribute structure in variable structure 487 MODULE PROCEDURE var__add_att_arr ! add a array of attribute structure in variable structure 488 END INTERFACE var_add_att 489 490 INTERFACE var_del_att ! delete one attribute in variable structure 491 MODULE PROCEDURE var__del_att_name ! - given attribute name 492 MODULE PROCEDURE var__del_att_str ! - given attribute structure 493 END INTERFACE var_del_att 305 494 306 495 INTERFACE var_add_dim 307 496 MODULE PROCEDURE var__add_dim_unit ! add one dimension structure in variable structure 308 MODULE PROCEDURE var__add_dim_ tab ! add a tableof dimension structure in variable structure497 MODULE PROCEDURE var__add_dim_arr ! add a array of dimension structure in variable structure 309 498 END INTERFACE var_add_dim 310 499 311 INTERFACE var_add_att 312 MODULE PROCEDURE var__add_att_unit ! add one attribute structure in variable structure 313 MODULE PROCEDURE var__add_att_tab ! add a table of attribute structure in variable structure 314 END INTERFACE var_add_att 315 316 INTERFACE ASSIGNMENT(=) 500 INTERFACE var_copy 317 501 MODULE PROCEDURE var__copy_unit ! copy variable structure 318 MODULE PROCEDURE var__copy_ tab! copy variable structure502 MODULE PROCEDURE var__copy_arr ! copy variable structure 319 503 END INTERFACE 320 504 CONTAINS 321 505 !------------------------------------------------------------------- 322 506 !> @brief 323 !> This subroutine copy variable structure in another variable 324 !> structure 507 !> This subroutine copy variable structure in another one 325 508 !> @details 326 !> variable value are copied in a temporary table, so input and output509 !> variable value are copied in a temporary array, so input and output 327 510 !> variable structure value do not point on the same "memory cell", and so 328 511 !> are independant. 329 512 !> 513 !> @warning do not use on the output of a function who create or read an 514 !> structure (ex: tl_var=var_copy(var_init()) is forbidden). 515 !> This will create memory leaks. 330 516 !> @warning to avoid infinite loop, do not use any function inside 331 517 !> this subroutine 332 518 !> 333 519 !> @author J.Paul 334 !> - Nov, 2013- Initial Version 335 ! 336 !> @param[out] td_var1 : variable structure 337 !> @param[in] td_var2 : variable structure 338 !------------------------------------------------------------------- 339 !> @code 340 SUBROUTINE var__copy_unit( td_var1, td_var2 ) 520 !> - November, 2013- Initial Version 521 !> @date November, 2014 522 !> - use function instead of overload assignment operator (to avoid memory leak) 523 ! 524 !> @param[in] td_var variable structure 525 !> @return copy of input variable structure 526 !------------------------------------------------------------------- 527 FUNCTION var__copy_unit( td_var ) 341 528 IMPLICIT NONE 342 529 ! Argument 343 TYPE(TVAR), INTENT(OUT) :: td_var1 344 TYPE(TVAR), INTENT(IN) :: td_var2 530 TYPE(TVAR), INTENT(IN) :: td_var 531 ! function 532 TYPE(TVAR) :: var__copy_unit 345 533 346 534 ! local variable … … 353 541 354 542 ! copy variable name, id, .. 355 td_var1%c_name = TRIM(td_var2%c_name)356 td_var1%c_point = TRIM(td_var2%c_point)357 td_var1%i_id = td_var2%i_id358 td_var1%i_ew = td_var2%i_ew359 360 td_var1%d_min = td_var2%d_min361 td_var1%d_max = td_var2%d_max362 363 td_var1%i_type = td_var2%i_type364 td_var1%i_natt = td_var2%i_natt365 td_var1%i_ndim = td_var2%i_ndim366 td_var1%i_ndim = td_var2%i_ndim543 var__copy_unit%c_name = TRIM(td_var%c_name) 544 var__copy_unit%c_point = TRIM(td_var%c_point) 545 var__copy_unit%i_id = td_var%i_id 546 var__copy_unit%i_ew = td_var%i_ew 547 548 var__copy_unit%d_min = td_var%d_min 549 var__copy_unit%d_max = td_var%d_max 550 551 var__copy_unit%i_type = td_var%i_type 552 var__copy_unit%i_natt = td_var%i_natt 553 var__copy_unit%i_ndim = td_var%i_ndim 554 var__copy_unit%i_ndim = td_var%i_ndim 367 555 368 556 ! copy dimension 369 td_var1%t_dim(:) = td_var2%t_dim(:)557 var__copy_unit%t_dim(:) = dim_copy(td_var%t_dim(:)) 370 558 371 559 ! copy attribute 372 IF( ASSOCIATED(td_var1%t_att) ) DEALLOCATE(td_var1%t_att) 373 IF( ASSOCIATED(td_var2%t_att) .AND. td_var1%i_natt > 0 )THEN 374 ALLOCATE( td_var1%t_att(td_var1%i_natt) ) 375 DO ji=1,td_var1%i_natt 376 tl_att=td_var2%t_att(ji) 377 td_var1%t_att(ji)=tl_att 560 IF( ASSOCIATED(var__copy_unit%t_att) )THEN 561 CALL att_clean( var__copy_unit%t_att(:) ) 562 DEALLOCATE(var__copy_unit%t_att) 563 ENDIF 564 IF( ASSOCIATED(td_var%t_att) .AND. var__copy_unit%i_natt > 0 )THEN 565 ALLOCATE( var__copy_unit%t_att(var__copy_unit%i_natt) ) 566 DO ji=1,var__copy_unit%i_natt 567 tl_att=att_copy(td_var%t_att(ji)) 568 var__copy_unit%t_att(ji)=att_copy(tl_att) 378 569 ENDDO 570 ! clean 571 CALL att_clean(tl_att) 379 572 ENDIF 380 573 381 574 ! copy highlight attribute 382 td_var1%c_stdname = TRIM(td_var2%c_stdname)383 td_var1%c_longname = TRIM(td_var2%c_longname)384 td_var1%c_units = TRIM(td_var2%c_units)385 td_var1%c_axis = TRIM(td_var2%c_axis)386 td_var1%d_scf = td_var2%d_scf387 td_var1%d_ofs = td_var2%d_ofs388 td_var1%d_fill = td_var2%d_fill575 var__copy_unit%c_stdname = TRIM(td_var%c_stdname) 576 var__copy_unit%c_longname = TRIM(td_var%c_longname) 577 var__copy_unit%c_units = TRIM(td_var%c_units) 578 var__copy_unit%c_axis = TRIM(td_var%c_axis) 579 var__copy_unit%d_scf = td_var%d_scf 580 var__copy_unit%d_ofs = td_var%d_ofs 581 var__copy_unit%d_fill = td_var%d_fill 389 582 390 583 ! copy netcdf4 variable 391 td_var1%l_contiguous = td_var2%l_contiguous392 td_var1%l_shuffle = td_var2%l_shuffle393 td_var1%l_fletcher32 = td_var2%l_fletcher32394 td_var1%i_deflvl = td_var2%i_deflvl395 td_var1%i_chunksz(:) = td_var2%i_chunksz(:)584 var__copy_unit%l_contiguous = td_var%l_contiguous 585 var__copy_unit%l_shuffle = td_var%l_shuffle 586 var__copy_unit%l_fletcher32 = td_var%l_fletcher32 587 var__copy_unit%i_deflvl = td_var%i_deflvl 588 var__copy_unit%i_chunksz(:) = td_var%i_chunksz(:) 396 589 397 590 ! copy dimg variable 398 td_var1%i_rec = td_var2%i_rec591 var__copy_unit%i_rec = td_var%i_rec 399 592 400 593 ! copy pointer in an independant variable 401 IF( ASSOCIATED( td_var1%d_value) ) DEALLOCATE(td_var1%d_value)402 IF( ASSOCIATED(td_var 2%d_value) )THEN403 ALLOCATE( dl_value( td_var 2%t_dim(1)%i_len, &404 & td_var 2%t_dim(2)%i_len, &405 & td_var 2%t_dim(3)%i_len, &406 & td_var 2%t_dim(4)%i_len ) )407 dl_value(:,:,:,:)=td_var 2%d_value(:,:,:,:)408 409 ALLOCATE( td_var1%d_value( td_var1%t_dim(1)%i_len, &410 & td_var1%t_dim(2)%i_len, &411 & td_var1%t_dim(3)%i_len, &412 & td_var1%t_dim(4)%i_len ) )413 td_var1%d_value(:,:,:,:)=dl_value(:,:,:,:)594 IF( ASSOCIATED(var__copy_unit%d_value) ) DEALLOCATE(var__copy_unit%d_value) 595 IF( ASSOCIATED(td_var%d_value) )THEN 596 ALLOCATE( dl_value( td_var%t_dim(1)%i_len, & 597 & td_var%t_dim(2)%i_len, & 598 & td_var%t_dim(3)%i_len, & 599 & td_var%t_dim(4)%i_len ) ) 600 dl_value(:,:,:,:)=td_var%d_value(:,:,:,:) 601 602 ALLOCATE( var__copy_unit%d_value( var__copy_unit%t_dim(1)%i_len, & 603 & var__copy_unit%t_dim(2)%i_len, & 604 & var__copy_unit%t_dim(3)%i_len, & 605 & var__copy_unit%t_dim(4)%i_len ) ) 606 var__copy_unit%d_value(:,:,:,:)=dl_value(:,:,:,:) 414 607 415 608 DEALLOCATE( dl_value ) 416 609 ENDIF 417 610 418 td_var1%c_interp(:)=td_var2%c_interp(:) 419 td_var1%c_extrap(:)=td_var2%c_extrap(:) 420 td_var1%c_filter(:)=td_var2%c_filter(:) 421 422 END SUBROUTINE var__copy_unit 423 !> @endcode 611 var__copy_unit%c_interp(:)=td_var%c_interp(:) 612 var__copy_unit%c_extrap(:)=td_var%c_extrap(:) 613 var__copy_unit%c_filter(:)=td_var%c_filter(:) 614 615 END FUNCTION var__copy_unit 424 616 !------------------------------------------------------------------- 425 617 !> @brief 426 !> This subroutine copy variable structure in another variable 427 !> structure 618 !> This subroutine copy a array of variable structure in another one 428 619 !> @details 429 !> variable value are copied in a temporary table, so input and output 430 !> variable structure value do not point on the same "memory cell", and so 431 !> are independant. 432 !> 620 !> see var__copy_unit 621 !> 622 !> @warning do not use on the output of a function who create or read an 623 !> structure (ex: tl_var=var_copy(var_init()) is forbidden). 624 !> This will create memory leaks. 433 625 !> @warning to avoid infinite loop, do not use any function inside 434 626 !> this subroutine 435 627 !> 436 628 !> @author J.Paul 437 !> - Nov, 2013- Initial Version 438 ! 439 !> @param[out] td_var1 : variable structure 440 !> @param[in] td_var2 : variable structure 441 !------------------------------------------------------------------- 442 !> @code 443 SUBROUTINE var__copy_tab( td_var1, td_var2 ) 629 !> - November, 2013- Initial Version 630 !> @date November, 2014 631 !> - use function instead of overload assignment operator 632 !> (to avoid memory leak) 633 ! 634 !> @param[in] td_var array of variable structure 635 !> @return copy of input array of variable structure 636 !------------------------------------------------------------------- 637 FUNCTION var__copy_arr( td_var ) 444 638 IMPLICIT NONE 445 639 ! Argument 446 TYPE(TVAR), DIMENSION(:), INTENT(IN ) :: td_var2 447 TYPE(TVAR), DIMENSION(:), INTENT( OUT) :: td_var1 640 TYPE(TVAR), DIMENSION(:), INTENT(IN ) :: td_var 641 ! function 642 TYPE(TVAR), DIMENSION(SIZE(td_var(:))) :: var__copy_arr 448 643 449 644 ! local variable … … 452 647 !---------------------------------------------------------------- 453 648 454 IF( SIZE(td_var2(:))/=SIZE(td_var1(:)) )THEN 455 CALL logger_error("VAR COPY: variable structure dimension differ") 456 ELSE 457 DO ji=1,SIZE(td_var2(:)) 458 td_var1(ji)=td_var2(ji) 459 ENDDO 460 ENDIF 461 462 END SUBROUTINE var__copy_tab 463 !> @endcode 649 DO ji=1,SIZE(td_var(:)) 650 var__copy_arr(ji)=var_copy(td_var(ji)) 651 ENDDO 652 653 END FUNCTION var__copy_arr 464 654 !------------------------------------------------------------------- 465 655 !> @brief This subroutine clean variable structure 466 ! 656 !> 467 657 !> @author J.Paul 468 !> - Nov, 2013- Initial Version 469 ! 470 !> @param[in] td_var : variable strucutre 471 !------------------------------------------------------------------- 472 !> @code 473 SUBROUTINE var_clean( td_var ) 658 !> - November, 2013- Initial Version 659 !> 660 !> @param[inout] td_var variable strucutre 661 !------------------------------------------------------------------- 662 SUBROUTINE var__clean_unit( td_var ) 474 663 IMPLICIT NONE 475 664 ! Argument … … 480 669 481 670 ! loop indices 482 INTEGER(i4) :: ji483 671 !---------------------------------------------------------------- 484 485 CALL logger_info( &486 & " CLEAN: reset variable "//TRIM(td_var%c_name) )487 672 488 673 ! del attribute 489 674 IF( ASSOCIATED(td_var%t_att) )THEN 490 ! clean each attribute 491 DO ji=td_var%i_natt,1,-1 492 CALL att_clean(td_var%t_att(ji) ) 493 ENDDO 494 DEALLOCATE( td_var%t_att ) 675 CALL att_clean( td_var%t_att(:) ) 676 DEALLOCATE(td_var%t_att) 495 677 ENDIF 496 678 497 679 ! del dimension 498 680 IF( td_var%i_ndim /= 0 )THEN 499 ! clean each dimension 500 DO ji=td_var%i_ndim,1,-1 501 CALL dim_clean(td_var%t_dim(ji)) 502 ENDDO 681 CALL dim_clean(td_var%t_dim(:)) 503 682 ENDIF 504 683 … … 509 688 510 689 ! replace by empty structure 511 td_var=tl_var 512 513 END SUBROUTINE var_clean 514 !> @endcode 515 !------------------------------------------------------------------- 516 !> @brief This function initalise a variable structure. 517 ! 518 !> @details 690 td_var=var_copy(tl_var) 691 692 END SUBROUTINE var__clean_unit 693 !------------------------------------------------------------------- 694 !> @brief This subroutine clean 1D array of variable structure 519 695 ! 520 696 !> @author J.Paul 521 !> - Nov, 2013- Initial Version 522 ! 523 !> @param[in] cd_name : variable name 524 !> @param[in] id_type : variable type 525 !> @param[in] td_dim : table of dimension structure 526 !> @param[in] td_att : table of attribute structure 527 !> @param[in] dd_fill : fill value 528 !> @param[in] cd_units : units 529 !> @param[in] cd_stdname : variable standard name 530 !> @param[in] cd_longname : variable long name 531 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 532 !> @param[in] id_id : variable id 533 !> @param[in] id_ew : east west wrap 534 !> @param[in] dd_scf : scale factor 535 !> @param[in] dd_ofs : add offset 536 !> @param[in] id_rec : record id (for rstdimg file) 537 !> @param[in] dd_min : minimum value 538 !> @param[in] dd_max : maximum value 539 !> @param[in] ld_contiguous : use contiguous storage or not 540 !> @param[in] ld_shuffle : shuffle filter is turned on or not 541 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 542 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 543 !> @param[in] id_chunksz : chunk size 544 !> @param[in] cd_interp : interpolation method 545 !> @param[in] cd_extrap : extrapolation method 546 !> @param[in] cd_filter : filter method 547 !------------------------------------------------------------------- 548 !> @code 697 !> - September, 2014- Initial Version 698 ! 699 !> @param[inout] td_var array of variable strucutre 700 !------------------------------------------------------------------- 701 SUBROUTINE var__clean_arr_1D( td_var ) 702 IMPLICIT NONE 703 ! Argument 704 TYPE(TVAR), DIMENSION(:), INTENT(INOUT) :: td_var 705 706 ! local variable 707 ! loop indices 708 INTEGER(i4) :: ji 709 !---------------------------------------------------------------- 710 711 DO ji=SIZE(td_var(:)),1,-1 712 CALL var_clean(td_var(ji)) 713 ENDDO 714 715 END SUBROUTINE var__clean_arr_1D 716 !------------------------------------------------------------------- 717 !> @brief This subroutine clean 2D array of variable structure 718 ! 719 !> @author J.Paul 720 !> - September, 2014- Initial Version 721 ! 722 !> @param[inout] td_var array of variable strucutre 723 !------------------------------------------------------------------- 724 SUBROUTINE var__clean_arr_2D( td_var ) 725 IMPLICIT NONE 726 ! Argument 727 TYPE(TVAR), DIMENSION(:,:), INTENT(INOUT) :: td_var 728 729 ! local variable 730 ! loop indices 731 INTEGER(i4) :: ji 732 INTEGER(i4) :: jj 733 !---------------------------------------------------------------- 734 735 DO jj=SIZE(td_var(:,:),DIM=2),1,-1 736 DO ji=SIZE(td_var(:,:),DIM=1),1,-1 737 CALL var_clean(td_var(ji,jj)) 738 ENDDO 739 ENDDO 740 741 END SUBROUTINE var__clean_arr_2D 742 !------------------------------------------------------------------- 743 !> @brief This subroutine clean 3D array of variable structure 744 ! 745 !> @author J.Paul 746 !> - September, 2014- Initial Version 747 ! 748 !> @param[inout] td_var array of variable strucutre 749 !------------------------------------------------------------------- 750 SUBROUTINE var__clean_arr_3D( td_var ) 751 IMPLICIT NONE 752 ! Argument 753 TYPE(TVAR), DIMENSION(:,:,:), INTENT(INOUT) :: td_var 754 755 ! local variable 756 ! loop indices 757 INTEGER(i4) :: ji 758 INTEGER(i4) :: jj 759 INTEGER(i4) :: jk 760 !---------------------------------------------------------------- 761 762 DO jk=SIZE(td_var(:,:,:),DIM=3),1,-1 763 DO jj=SIZE(td_var(:,:,:),DIM=2),1,-1 764 DO ji=SIZE(td_var(:,:,:),DIM=1),1,-1 765 CALL var_clean(td_var(ji,jj,jk)) 766 ENDDO 767 ENDDO 768 ENDDO 769 770 END SUBROUTINE var__clean_arr_3D 771 !------------------------------------------------------------------- 772 !> @brief This function initialize a variable structure, given variable name. 773 ! 774 !> @details 775 !> Optionally you could add 1D,2D,3D or 4D array of value, 776 !> see var__init_1D_dp, var__init_2D_dp... for more information. 777 !> 778 !> you could also add more information with the following optional arguments: 779 !> - id_type : integer(4) variable type, (as defined by NETCDF type constants). 780 !> - td_dim : array of dimension structure. 781 !> - td_att : array of attribute structure. 782 !> - dd_fill : real(8) variable FillValue. if none NETCDF FillValue will be used. 783 !> - cd_units : string character of units. 784 !> - cd_axis : string character of axis expected to be used 785 !> - cd_stdname : string character of variable standard name. 786 !> - cd_longname : string character of variable long name. 787 !> - cd_point : one character for ARAKAWA C-grid point name (T,U,V,F). 788 !> - id_id : variable id (read from a file). 789 !> - id_ew : number of point composing east west wrap band. 790 !> - dd_scf : real(8) value for scale factor attribute. 791 !> - dd_ofs : real(8) value for add offset attribute. 792 !> - id_rec : record id (for rstdimg file). 793 !> - dd_min : real(8) value for minimum value. 794 !> - dd_max : real(8) value for maximum value. 795 !> - ld_contiguous : use contiguous storage or not (for netcdf4). 796 !> - ld_shuffle : shuffle filter is turned on or not (for netcdf4). 797 !> - ld_fletcher32 : fletcher32 filter is turned on or not (for netcdf4). 798 !> - id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use (for netcdf4). 799 !> - id_chunksz : chunk size (for netcdf4). 800 !> - cd_interp : a array of character defining interpolation method. 801 !> - cd_extrap : a array of character defining extrapolation method. 802 !> - cd_filter : a array of character defining filtering method. 803 !> 804 !> @note most of these optionals arguments will be inform automatically, 805 !> when reading variable from a file, or using confiuguration file variable.cfg. 806 !> 807 !> @author J.Paul 808 !> - November, 2013- Initial Version 809 !> 810 !> @param[in] cd_name variable name 811 !> @param[in] id_type variable type 812 !> @param[in] td_dim array of dimension structure 813 !> @param[in] td_att array of attribute structure 814 !> @param[in] dd_fill fill value 815 !> @param[in] cd_units units 816 !> @param[in] cd_axis axis expected to be used 817 !> @param[in] cd_stdname variable standard name 818 !> @param[in] cd_longname variable long name 819 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 820 !> @param[in] id_id variable id 821 !> @param[in] id_ew east west wrap 822 !> @param[in] dd_scf scale factor 823 !> @param[in] dd_ofs add offset 824 !> @param[in] id_rec record id (for rstdimg file) 825 !> @param[in] dd_min minimum value 826 !> @param[in] dd_max maximum value 827 !> @param[in] ld_contiguous use contiguous storage or not 828 !> @param[in] ld_shuffle shuffle filter is turned on or not 829 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 830 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 831 !> @param[in] id_chunksz chunk size 832 !> @param[in] cd_interp interpolation method 833 !> @param[in] cd_extrap extrapolation method 834 !> @param[in] cd_filter filter method 835 !> @return variable structure 836 !------------------------------------------------------------------- 549 837 TYPE(TVAR) FUNCTION var__init( cd_name, id_type, td_dim, & 550 838 & td_att, dd_fill, cd_units, cd_axis, & … … 586 874 587 875 ! local variable 588 INTEGER(i4) :: il_ attid876 INTEGER(i4) :: il_ind 589 877 590 878 TYPE(TATT) :: tl_att … … 637 925 ! add _FillValue 638 926 IF( PRESENT(dd_fill) )THEN 639 tl_att=att_init('_FillValue',dd_fill) 927 SELECT CASE( var__init%i_type ) 928 CASE(NF90_BYTE) 929 tl_att=att_init('_FillValue', INT(dd_fill,i1) ) 930 CASE(NF90_SHORT) 931 tl_att=att_init('_FillValue', INT(dd_fill,i2) ) 932 CASE(NF90_INT) 933 tl_att=att_init('_FillValue', INT(dd_fill,i4) ) 934 CASE(NF90_FLOAT) 935 tl_att=att_init('_FillValue', INT(dd_fill,sp) ) 936 CASE DEFAULT ! NF90_DOUBLE 937 tl_att=att_init('_FillValue', dd_fill ) 938 END SELECT 640 939 CALL var_move_att(var__init, tl_att) 641 940 ELSE 642 il_ attid=0941 il_ind=0 643 942 IF( ASSOCIATED(var__init%t_att) )THEN 644 il_ attid=att_get_id(var__init%t_att(:),'_FillValue')943 il_ind=att_get_index(var__init%t_att(:),'_FillValue') 645 944 ENDIF 646 IF( il_ attid == 0 )THEN945 IF( il_ind == 0 )THEN 647 946 SELECT CASE( var__init%i_type ) 648 649 947 CASE(NF90_BYTE) 650 948 tl_att=att_init('_FillValue',NF90_FILL_BYTE) … … 657 955 CASE DEFAULT ! NF90_DOUBLE 658 956 tl_att=att_init('_FillValue',NF90_FILL_DOUBLE) 659 660 957 END SELECT 661 958 CALL var_add_att(var__init, tl_att) … … 687 984 IF( PRESENT(td_dim) )THEN 688 985 CALL var_add_dim(var__init, td_dim(:)) 986 ELSE 987 CALL var_add_dim(var__init, dim_fill_unused()) 689 988 ENDIF 690 989 … … 703 1002 ENDIF 704 1003 1004 ! netcdf4 705 1005 IF( PRESENT(ld_contiguous) )THEN 706 1006 var__init%l_contiguous=ld_contiguous … … 723 1023 ENDIF 724 1024 1025 ! interp 725 1026 IF( PRESENT(cd_interp) )THEN 726 1027 var__init%c_interp(:)=cd_interp(:) 727 1028 ENDIF 728 1029 1030 !extrap 729 1031 IF( PRESENT(cd_extrap) )THEN 730 1032 var__init%c_extrap(:)=cd_extrap(:) 731 1033 ENDIF 732 1034 1035 !filter 733 1036 IF( PRESENT(cd_filter) )THEN 734 1037 var__init%c_filter(:)=cd_filter(:) … … 738 1041 CALL var__get_extra(var__init) 739 1042 740 ! delete some attribute 741 il_attid=att_get_id(var__init%t_att(:),'interpolation') 742 IF( il_attid /= 0 )THEN 743 tl_att=var__init%t_att(il_attid) 744 CALL var_del_att(var__init, tl_att) 745 ENDIF 746 il_attid=att_get_id(var__init%t_att(:),'extrapolation') 747 IF( il_attid /= 0 )THEN 748 tl_att=var__init%t_att(il_attid) 749 CALL var_del_att(var__init, tl_att) 750 ENDIF 751 il_attid=att_get_id(var__init%t_att(:),'filter') 752 IF( il_attid /= 0 )THEN 753 tl_att=var__init%t_att(il_attid) 754 CALL var_del_att(var__init, tl_att) 755 ENDIF 756 il_attid=att_get_id(var__init%t_att(:),'src_file') 757 IF( il_attid /= 0 )THEN 758 tl_att=var__init%t_att(il_attid) 759 CALL var_del_att(var__init, tl_att) 760 ENDIF 761 ! those attribute are deleted cause seems not to be informed correctly 762 il_attid=att_get_id(var__init%t_att(:),'valid_min') 763 IF( il_attid /= 0 )THEN 764 tl_att=var__init%t_att(il_attid) 765 CALL var_del_att(var__init, tl_att) 766 ENDIF 767 il_attid=att_get_id(var__init%t_att(:),'valid_max') 768 IF( il_attid /= 0 )THEN 769 tl_att=var__init%t_att(il_attid) 770 CALL var_del_att(var__init, tl_att) 771 ENDIF 772 il_attid=att_get_id(var__init%t_att(:),'missing_value') 773 IF( il_attid /= 0 )THEN 774 tl_att=var__init%t_att(il_attid) 775 CALL var_del_att(var__init, tl_att) 776 ENDIF 1043 ! delete some attribute cause linked to file where variable come from 1044 CALL var_del_att(var__init, 'refinment_factor') 1045 CALL var_del_att(var__init, 'interpolation') 1046 CALL var_del_att(var__init, 'extrapolation') 1047 CALL var_del_att(var__init, 'filter') 1048 CALL var_del_att(var__init, 'src_file') 1049 CALL var_del_att(var__init, 'valid_min') 1050 CALL var_del_att(var__init, 'valid_max') 1051 CALL var_del_att(var__init, 'missing_value') 1052 1053 ! clean 1054 CALL att_clean(tl_att) 777 1055 778 1056 END FUNCTION var__init 779 !> @endcode 780 !------------------------------------------------------------------- 781 !> @brief This function initalise a variable structure. 782 !> - real(8) 1D table of value could be added. 783 !> - dimension structure could be added. 784 !> - attribute structure could be added 785 ! 1057 !------------------------------------------------------------------- 1058 !> @brief This function initialize a variable structure, 1059 !> with a real(8) 1D array of value. 786 1060 !> @details 1061 !> Optionally could be added:<br/> 1062 !> - dimension structure. 1063 !> - attribute structure. 1064 ! 787 1065 !> Dimension structure is needed to put value in variable structure. 788 !> If none is given, we assume tableis ordered as ('z') and we789 !> use tablesize as lentgh dimension.1066 !> If none is given, we assume array is ordered as ('z') and we 1067 !> use array size as lentgh dimension. 790 1068 !> 791 1069 !> indices in the variable where value will be written could be specify if 792 !> start and count tableare given. Dimension structure is needed in that1070 !> start and count array are given. Dimension structure is needed in that 793 1071 !> case. 794 1072 ! 795 1073 !> @author J.Paul 796 !> - Nov , 2013- Initial Version797 ! 798 !> @param[in] cd_name :variable name799 !> @param[in] dd_value : 1D tableof real(8) value800 !> @param[in] id_start :index in the variable from which the data values1074 !> - November, 2013- Initial Version 1075 ! 1076 !> @param[in] cd_name variable name 1077 !> @param[in] dd_value 1D array of real(8) value 1078 !> @param[in] id_start index in the variable from which the data values 801 1079 !> will be read 802 !> @param[in] id_count : number of indices selected along each dimension 803 !> @param[in] id_type : variable type 804 !> @param[in] td_dim : dimension structure 805 !> @param[in] td_att : table of attribute structure 806 !> @param[in] dd_fill : fill value 807 !> @param[in] cd_units : units 808 !> @param[in] cd_stdname : variable standard name 809 !> @param[in] cd_longname : variable long name 810 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 811 !> @param[in] id_id : variable id 812 !> @param[in] id_ew : east west wrap 813 !> @param[in] dd_scf : scale factor 814 !> @param[in] dd_ofs : add offset 815 !> @param[in] id_rec : record id (for rstdimg file) 816 !> @param[in] dd_min : minimum value 817 !> @param[in] dd_max : maximum value 818 !> @param[in] ld_contiguous : use contiguous storage or not 819 !> @param[in] ld_shuffle : shuffle filter is turned on or not 820 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 821 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 822 !> @param[in] id_chunksz : chunk size 823 !------------------------------------------------------------------- 824 !> @code 1080 !> @param[in] id_count number of indices selected along each dimension 1081 !> @param[in] id_type variable type 1082 !> @param[in] td_dim dimension structure 1083 !> @param[in] td_att array of attribute structure 1084 !> @param[in] dd_fill fill value 1085 !> @param[in] cd_units units 1086 !> @param[in] cd_axis axis expected to be used 1087 !> @param[in] cd_stdname variable standard name 1088 !> @param[in] cd_longname variable long name 1089 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 1090 !> @param[in] id_id variable id 1091 !> @param[in] id_ew east west wrap 1092 !> @param[in] dd_scf scale factor 1093 !> @param[in] dd_ofs add offset 1094 !> @param[in] id_rec record id (for rstdimg file) 1095 !> @param[in] dd_min minimum value 1096 !> @param[in] dd_max maximum value 1097 !> @param[in] ld_contiguous use contiguous storage or not 1098 !> @param[in] ld_shuffle shuffle filter is turned on or not 1099 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 1100 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 1101 !> @param[in] id_chunksz chunk size 1102 !> @return variable structure 1103 !------------------------------------------------------------------- 825 1104 TYPE(TVAR) FUNCTION var__init_1D_dp( cd_name, dd_value, & 826 1105 & id_start, id_count, id_type, td_dim, & 827 & td_att, dd_fill, cd_units, &1106 & td_att, dd_fill, cd_units, cd_axis, & 828 1107 & cd_stdname, cd_longname, & 829 1108 & cd_point, id_id, id_ew, & … … 843 1122 REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill 844 1123 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 1124 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 845 1125 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 846 1126 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 874 1154 CALL var_clean(var__init_1D_dp) 875 1155 876 ! ugly call to avoid warning1156 ! dummy call to avoid warning 877 1157 il_type=NF90_DOUBLE 878 1158 IF( PRESENT(id_type) ) il_type=id_type … … 880 1160 tl_dim(1)=dim_init( 'Z', id_len=SIZE(dd_value(:)) ) 881 1161 IF( PRESENT(td_dim) )THEN 882 tl_dim(1)= td_dim1162 tl_dim(1)=dim_copy(td_dim) 883 1163 ENDIF 884 1164 … … 895 1175 ! reorder dimension 896 1176 CALL dim_reorder(tl_dim(:)) 897 ! reorder table1177 ! reorder array 898 1178 il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:)) 899 1179 il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:)) … … 902 1182 & td_dim=tl_dim(:), td_att=td_att, & 903 1183 & dd_fill=dd_fill, cd_units=cd_units, & 1184 & cd_axis=cd_axis, & 904 1185 & cd_stdname=cd_stdname, & 905 1186 & cd_longname=cd_longname, & … … 934 1215 935 1216 CALL var_add_value( var__init_1D_dp, dl_value(:,:,:,:), & 936 & il_start(:), il_count(:) ) 937 1217 & il_type, il_start(:), il_count(:) ) 1218 1219 ! clean 938 1220 DEALLOCATE( dl_value ) 1221 CALL dim_clean(tl_dim) 939 1222 940 1223 END FUNCTION var__init_1D_dp 941 ! > @endcode942 ! -------------------------------------------------------------------943 !> @brief This function initalise a variable structure.944 !> - real(8) 2D table of value could be added.945 !> - dimension structure could be added.946 !> - attribute structure could be added1224 !------------------------------------------------------------------- 1225 !> @brief This function initialize a variable structure, 1226 !> with a real(8) 2D array of value. 1227 !> optionally could be added:<br/> 1228 !> - dimension structure. 1229 !> - attribute structure. 947 1230 ! 948 1231 !> @details 949 !> tableof 2 dimension structure is needed to put value in variable structure.950 !> If none is given, we assume tableis ordered as ('x','y') and we951 !> use tablesize as lentgh dimension.1232 !> array of 2 dimension structure is needed to put value in variable structure. 1233 !> If none is given, we assume array is ordered as ('x','y') and we 1234 !> use array size as lentgh dimension. 952 1235 !> 953 1236 !> indices in the variable where value will be written could be specify if 954 !> start and count tableare given. Dimension structure is needed in that1237 !> start and count array are given. Dimension structure is needed in that 955 1238 !> case. 956 1239 ! 957 1240 !> @author J.Paul 958 !> - Nov, 2013- Initial Version 959 ! 960 !> @param[in] cd_name : variable name 961 !> @param[in] dd_value : 1D table of real(8) value 962 !> @param[in] id_start : index in the variable from which the data values 963 !> will be read 964 !> @param[in] id_count : number of indices selected along each dimension 965 !> @param[in] id_type : variable type 966 !> @param[in] td_dim : dimension structure 967 !> @param[in] td_att : table of attribute structure 968 !> @param[in] dd_fill : fill value 969 !> @param[in] cd_units : units 970 !> @param[in] cd_stdname : variable standard name 971 !> @param[in] cd_longname : variable long name 972 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 973 !> @param[in] id_id : variable id 974 !> @param[in] id_ew : east west wrap 975 !> @param[in] dd_scf : scale factor 976 !> @param[in] dd_ofs : add offset 977 !> @param[in] id_rec : record id (for rstdimg file) 978 !> @param[in] dd_min : minimum value 979 !> @param[in] dd_max : maximum value 980 !> @param[in] ld_contiguous : use contiguous storage or not 981 !> @param[in] ld_shuffle : shuffle filter is turned on or not 982 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 983 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 984 !> @param[in] id_chunksz : chunk size 985 !------------------------------------------------------------------- 986 !> @code 1241 !> - November, 2013- Initial Version 1242 ! 1243 !> @param[in] cd_name variable name 1244 !> @param[in] dd_value 1D array of real(8) value 1245 !> @param[in] id_start index in the variable from which the 1246 !> data values will be read 1247 !> @param[in] id_count number of indices selected along 1248 !> each dimension 1249 !> @param[in] id_type variable type 1250 !> @param[in] td_dim dimension structure 1251 !> @param[in] td_att array of attribute structure 1252 !> @param[in] dd_fill fill value 1253 !> @param[in] cd_units units 1254 !> @param[in] cd_axis axis expected to be used 1255 !> @param[in] cd_stdname variable standard name 1256 !> @param[in] cd_longname variable long name 1257 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 1258 !> @param[in] id_id variable id 1259 !> @param[in] id_ew east west wrap 1260 !> @param[in] dd_scf scale factor 1261 !> @param[in] dd_ofs add offset 1262 !> @param[in] id_rec record id (for rstdimg file) 1263 !> @param[in] dd_min minimum value 1264 !> @param[in] dd_max maximum value 1265 !> @param[in] ld_contiguous use contiguous storage or not 1266 !> @param[in] ld_shuffle shuffle filter is turned on or not 1267 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 1268 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates 1269 !> no deflation is in use 1270 !> @param[in] id_chunksz chunk size 1271 !> @return variable structure 1272 !------------------------------------------------------------------- 987 1273 TYPE(TVAR) FUNCTION var__init_2D_dp( cd_name, dd_value, & 988 1274 & id_start, id_count, id_type, td_dim, & 989 & td_att, dd_fill, cd_units, &1275 & td_att, dd_fill, cd_units, cd_axis,& 990 1276 & cd_stdname, cd_longname, & 991 1277 & cd_point, id_id, id_ew, & … … 1005 1291 REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill 1006 1292 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 1293 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1007 1294 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1008 1295 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1036 1323 CALL var_clean(var__init_2D_dp) 1037 1324 1038 ! ugly call to avoid warning1325 ! dummy call to avoid warning 1039 1326 il_type=NF90_DOUBLE 1040 1327 IF( PRESENT(id_type) ) il_type=id_type … … 1047 1334 & " not conform") 1048 1335 ELSE 1049 tl_dim(1)= td_dim(1)1050 tl_dim(2)= td_dim(2)1336 tl_dim(1)=dim_copy(td_dim(1)) 1337 tl_dim(2)=dim_copy(td_dim(2)) 1051 1338 ENDIF 1052 1339 ENDIF … … 1055 1342 IF( PRESENT(id_start) )THEN 1056 1343 IF( SIZE(id_start(:)) /= 2 )THEN 1057 CALL logger_error("VAR INIT: dimension of start table"//&1344 CALL logger_error("VAR INIT: dimension of start array "//& 1058 1345 & " not conform") 1059 1346 ELSE … … 1066 1353 IF( PRESENT(id_count) )THEN 1067 1354 IF( SIZE(id_count(:)) /= 2 )THEN 1068 CALL logger_error("VAR INIT: dimension of count table"//&1355 CALL logger_error("VAR INIT: dimension of count array "//& 1069 1356 & " not conform") 1070 1357 ELSE … … 1076 1363 ! reorder dimension 1077 1364 CALL dim_reorder(tl_dim(:)) 1078 ! reorder table1365 ! reorder array 1079 1366 il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:)) 1080 1367 il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:)) … … 1083 1370 & td_dim=tl_dim(:), td_att=td_att, & 1084 1371 & dd_fill=dd_fill, cd_units=cd_units, & 1372 & cd_axis=cd_axis, & 1085 1373 & cd_stdname=cd_stdname, & 1086 1374 & cd_longname=cd_longname, & … … 1119 1407 1120 1408 CALL var_add_value( var__init_2D_dp, dl_value(:,:,:,:), & 1121 & il_start(:), il_count(:) ) 1122 1409 & il_type, il_start(:), il_count(:) ) 1410 1411 ! clean 1123 1412 DEALLOCATE( dl_value ) 1413 CALL dim_clean(tl_dim) 1124 1414 1125 1415 END FUNCTION var__init_2D_dp 1126 !> @endcode 1127 !------------------------------------------------------------------- 1128 !> @brief This function initalise a variable structure. 1129 !> - real(8) 3D table of value could be added. 1130 !> - dimension structure could be added. 1131 !> - attribute structure could be added 1132 ! 1416 !------------------------------------------------------------------- 1417 !> @brief This function initialize a variable structure, 1418 !> with a real(8) 3D array of value. 1133 1419 !> @details 1134 !> table of 3 dimension structure is needed to put value in variable structure. 1135 !> If none is given, we assume table is ordered as ('x','y','z') and we 1136 !> use table size as lentgh dimension. 1420 !> optionally could be added:<br/> 1421 !> - dimension structure. 1422 !> - attribute structure. 1423 !> 1424 !> array of 3 dimension structure is needed to put value in variable structure. 1425 !> If none is given, we assume array is ordered as ('x','y','z') and we 1426 !> use array size as lentgh dimension. 1137 1427 !> 1138 1428 !> indices in the variable where value will be written could be specify if 1139 !> start and count tableare given. Dimension structure is needed in that1429 !> start and count array are given. Dimension structure is needed in that 1140 1430 !> case. 1141 1431 ! 1142 1432 !> @author J.Paul 1143 !> - Nov, 2013- Initial Version 1144 ! 1145 !> @param[in] cd_name : variable name 1146 !> @param[in] dd_value : 1D table of real(8) value 1147 !> @param[in] id_start : index in the variable from which the data values 1148 !> will be read 1149 !> @param[in] id_count : number of indices selected along each dimension 1150 !> @param[in] id_type : variable type 1151 !> @param[in] td_dim : dimension structure 1152 !> @param[in] td_att : table of attribute structure 1153 !> @param[in] dd_fill : fill value 1154 !> @param[in] cd_units : units 1155 !> @param[in] cd_stdname : variable standard name 1156 !> @param[in] cd_longname : variable long name 1157 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1158 !> @param[in] id_id : variable id 1159 !> @param[in] id_ew : east west wrap 1160 !> @param[in] dd_scf : scale factor 1161 !> @param[in] dd_ofs : add offset 1162 !> @param[in] id_rec : record id (for rstdimg file) 1163 !> @param[in] dd_min : minimum value 1164 !> @param[in] dd_max : maximum value 1165 !> @param[in] ld_contiguous : use contiguous storage or not 1166 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1167 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1168 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 1169 !> @param[in] id_chunksz : chunk size 1170 !------------------------------------------------------------------- 1171 !> @code 1433 !> - November, 2013- Initial Version 1434 ! 1435 !> @param[in] cd_name variable name 1436 !> @param[in] dd_value 1D array of real(8) value 1437 !> @param[in] id_start index in the variable from which the 1438 !> data values will be read 1439 !> @param[in] id_count number of indices selected along 1440 !> each dimension 1441 !> @param[in] id_type variable type 1442 !> @param[in] td_dim dimension structure 1443 !> @param[in] td_att array of attribute structure 1444 !> @param[in] dd_fill fill value 1445 !> @param[in] cd_units units 1446 !> @param[in] cd_axis axis expected to be used 1447 !> @param[in] cd_stdname variable standard name 1448 !> @param[in] cd_longname variable long name 1449 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 1450 !> @param[in] id_id variable id 1451 !> @param[in] id_ew east west wrap 1452 !> @param[in] dd_scf scale factor 1453 !> @param[in] dd_ofs add offset 1454 !> @param[in] id_rec record id (for rstdimg file) 1455 !> @param[in] dd_min minimum value 1456 !> @param[in] dd_max maximum value 1457 !> @param[in] ld_contiguous use contiguous storage or not 1458 !> @param[in] ld_shuffle shuffle filter is turned on or not 1459 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 1460 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 1461 !> deflation is in use 1462 !> @param[in] id_chunksz chunk size 1463 !> @return variable structure 1464 !------------------------------------------------------------------- 1172 1465 TYPE(TVAR) FUNCTION var__init_3D_dp( cd_name, dd_value, & 1173 1466 & id_start, id_count, id_type, td_dim, & 1174 & td_att, dd_fill, cd_units, &1467 & td_att, dd_fill, cd_units, cd_axis,& 1175 1468 & cd_stdname, cd_longname, & 1176 1469 & cd_point, id_id, id_ew, & … … 1190 1483 REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill 1191 1484 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 1485 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1192 1486 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1193 1487 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1221 1515 CALL var_clean(var__init_3D_dp) 1222 1516 1223 ! ugly call to avoid warning1517 ! dummy call to avoid warning 1224 1518 il_type=NF90_DOUBLE 1225 1519 IF( PRESENT(id_type) ) il_type=id_type … … 1233 1527 & " not conform") 1234 1528 ELSE 1235 tl_dim(1)= td_dim(1)1236 tl_dim(2)= td_dim(2)1237 tl_dim(3)= td_dim(3)1529 tl_dim(1)=dim_copy(td_dim(1)) 1530 tl_dim(2)=dim_copy(td_dim(2)) 1531 tl_dim(3)=dim_copy(td_dim(3)) 1238 1532 ENDIF 1239 1533 ENDIF … … 1242 1536 IF( PRESENT(id_start) )THEN 1243 1537 IF( SIZE(id_start(:)) /= 3 )THEN 1244 CALL logger_error("VAR INIT: dimension of start table"//&1538 CALL logger_error("VAR INIT: dimension of start array "//& 1245 1539 & " not conform") 1246 1540 ELSE … … 1254 1548 IF( PRESENT(id_count) )THEN 1255 1549 IF( SIZE(id_count(:)) /= 3 )THEN 1256 CALL logger_error("VAR INIT: dimension of count table"//&1550 CALL logger_error("VAR INIT: dimension of count array "//& 1257 1551 & " not conform") 1258 1552 ELSE … … 1265 1559 ! reorder dimension 1266 1560 CALL dim_reorder(tl_dim(:)) 1267 ! reorder table1561 ! reorder array 1268 1562 il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:)) 1269 1563 il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:)) … … 1272 1566 & td_dim=tl_dim(:), td_att=td_att, & 1273 1567 & dd_fill=dd_fill, cd_units=cd_units, & 1568 & cd_axis=cd_axis, & 1274 1569 & cd_stdname=cd_stdname, & 1275 1570 & cd_longname=cd_longname, & … … 1304 1599 1305 1600 CALL var_add_value( var__init_3D_dp, dl_value(:,:,:,:), & 1306 & il_start(:), il_count(:) ) 1307 1601 & il_type, il_start(:), il_count(:) ) 1602 1603 ! clean 1308 1604 DEALLOCATE( dl_value ) 1605 CALL dim_clean(tl_dim) 1309 1606 1310 1607 END FUNCTION var__init_3D_dp 1311 !> @endcode 1312 !------------------------------------------------------------------- 1313 !> @brief This function initalise a variable structure. 1314 !> - real(8) 4D table of value could be added. 1315 !> - dimension structure could be added. 1316 !> - attribute structure could be added 1317 ! 1608 !------------------------------------------------------------------- 1609 !> @brief This function initialize a variable structure, 1610 !> with a real(8) 4D array of value. 1318 1611 !> @details 1612 !> optionally could be added:<br/> 1613 !> - dimension structure. 1614 !> - attribute structure. 1615 !> 1319 1616 !> Dimension structure is needed to put value in variable structure. 1320 !> If none is given, we assume tableis ordered as ('x','y','z','t') and we1321 !> use tablesize as lentgh dimension.1617 !> If none is given, we assume array is ordered as ('x','y','z','t') and we 1618 !> use array size as lentgh dimension. 1322 1619 !> 1323 1620 !> indices in the variable where value will be written could be specify if 1324 !> start and count tableare given. Dimension structure is needed in that1621 !> start and count array are given. Dimension structure is needed in that 1325 1622 !> case. 1326 1623 ! 1327 1624 !> @author J.Paul 1328 !> - Nov, 2013- Initial Version 1329 ! 1330 !> @param[in] cd_name : variable name 1331 !> @param[in] dd_value : 4D table of real(8) value 1332 !> @param[in] id_start : index in the variable from which the data values 1333 !> will be read 1334 !> @param[in] id_count : number of indices selected along each dimension 1335 !> @param[in] id_type : variable type 1336 !> @param[in] td_dim : table of dimension structure 1337 !> @param[in] td_att : table of attribute structure 1338 !> @param[in] dd_fill : fill value 1339 !> @param[in] cd_units : units 1340 !> @param[in] cd_stdname : variable standard name 1341 !> @param[in] cd_longname : variable long name 1342 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1343 !> @param[in] id_id : variable id 1344 !> @param[in] id_ew : east west wrap 1345 !> @param[in] dd_scf : scale factor 1346 !> @param[in] dd_ofs : add offset 1347 !> @param[in] id_rec : record id (for rstdimg file) 1348 !> @param[in] dd_min : minimum value 1349 !> @param[in] dd_max : maximum value 1350 !> @param[in] ld_contiguous : use contiguous storage or not 1351 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1352 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1353 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 1354 !> @param[in] id_chunksz : chunk size 1355 !------------------------------------------------------------------- 1356 !> @code 1625 !> - November, 2013- Initial Version 1626 ! 1627 !> @param[in] cd_name variable name 1628 !> @param[in] dd_value 4D array of real(8) value 1629 !> @param[in] id_start index in the variable from which the 1630 !> data values will be read 1631 !> @param[in] id_count number of indices selected along 1632 !> each dimension 1633 !> @param[in] id_type variable type 1634 !> @param[in] td_dim array of dimension structure 1635 !> @param[in] td_att array of attribute structure 1636 !> @param[in] dd_fill fill value 1637 !> @param[in] cd_units units 1638 !> @param[in] cd_axis axis expected to be used 1639 !> @param[in] cd_stdname variable standard name 1640 !> @param[in] cd_longname variable long name 1641 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 1642 !> @param[in] id_id variable id 1643 !> @param[in] id_ew east west wrap 1644 !> @param[in] dd_scf scale factor 1645 !> @param[in] dd_ofs add offset 1646 !> @param[in] id_rec record id (for rstdimg file) 1647 !> @param[in] dd_min minimum value 1648 !> @param[in] dd_max maximum value 1649 !> @param[in] ld_contiguous use contiguous storage or not 1650 !> @param[in] ld_shuffle shuffle filter is turned on or not 1651 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 1652 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 1653 !> deflation is in use 1654 !> @param[in] id_chunksz chunk size 1655 !> @return variable structure 1656 !------------------------------------------------------------------- 1357 1657 TYPE(TVAR) FUNCTION var__init_dp( cd_name, dd_value, & 1358 1658 & id_start, id_count, id_type, td_dim, & 1359 & td_att, dd_fill, cd_units, &1659 & td_att, dd_fill, cd_units, cd_axis,& 1360 1660 & cd_stdname, cd_longname, & 1361 1661 & cd_point, id_id, id_ew, & … … 1375 1675 REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill 1376 1676 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 1677 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1377 1678 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1378 1679 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1404 1705 CALL var_clean(var__init_dp) 1405 1706 1406 ! ugly call to avoid warning1707 ! dummy call to avoid warning 1407 1708 il_type=NF90_DOUBLE 1408 1709 IF( PRESENT(id_type) ) il_type=id_type … … 1411 1712 & td_dim=td_dim, td_att=td_att, & 1412 1713 & dd_fill=dd_fill, cd_units=cd_units, & 1714 & cd_axis=cd_axis, & 1413 1715 & cd_stdname=cd_stdname, & 1414 1716 & cd_longname=cd_longname, & … … 1422 1724 & id_deflvl=id_deflvl, & 1423 1725 & id_chunksz=id_chunksz(:)) 1424 1726 1425 1727 ! add value 1426 1728 IF( .NOT. PRESENT(td_dim) )THEN … … 1433 1735 1434 1736 CALL var_add_value( var__init_dp, dd_value(:,:,:,:), & 1435 & id_start(:), id_count(:) ) 1737 & il_type, id_start(:), id_count(:) ) 1738 1739 ! clean 1740 CALL dim_clean(tl_dim) 1436 1741 1437 1742 END FUNCTION var__init_dp 1438 !> @endcode 1439 !------------------------------------------------------------------- 1440 !> @brief This function initalise a variable structure. 1441 !> - real(4) 1D table of value could be added. 1442 !> - dimension structure could be added. 1443 !> - attribute structure could be added 1444 ! 1743 !------------------------------------------------------------------- 1744 !> @brief This function initialize a variable structure, 1745 !> with a real(4) 1D array of value. 1445 1746 !> @details 1747 !> optionally could be added:<br/> 1748 !> - dimension structure. 1749 !> - attribute structure. 1750 !> 1446 1751 !> dimension structure is needed to put value in variable structure. 1447 !> If none is given, we assume tableis ordered as ('z') and we1448 !> use tablesize as lentgh dimension.1752 !> If none is given, we assume array is ordered as ('z') and we 1753 !> use array size as lentgh dimension. 1449 1754 !> 1450 1755 !> indices in the variable where value will be written could be specify if 1451 !> start and count tableare given. Dimension structure is needed in that1756 !> start and count array are given. Dimension structure is needed in that 1452 1757 !> case. 1453 1758 ! 1454 1759 !> @author J.Paul 1455 !> - Nov, 2013- Initial Version 1456 ! 1457 !> @param[in] cd_name : variable name 1458 !> @param[in] rd_value : 1D table of real(4) value 1459 !> @param[in] id_start : index in the variable from which the data values 1460 !> will be read 1461 !> @param[in] id_count : number of indices selected along each dimension 1462 !> @param[in] id_type : variable type 1463 !> @param[in] td_dim : table of dimension structure 1464 !> @param[in] td_att : table of attribute structure 1465 !> @param[in] rd_fill : fill value 1466 !> @param[in] cd_units : units 1467 !> @param[in] cd_stdname : variable standard name 1468 !> @param[in] cd_longname : variable long name 1469 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1470 !> @param[in] id_id : variable id 1471 !> @param[in] id_ew : east west wrap 1472 !> @param[in] dd_scf : scale factor 1473 !> @param[in] dd_ofs : add offset 1474 !> @param[in] id_rec : record id (for rstdimg file) 1475 !> @param[in] dd_min : minimum value 1476 !> @param[in] dd_max : maximum value 1477 !> @param[in] ld_contiguous : use contiguous storage or not 1478 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1479 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1480 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 1481 !> @param[in] id_chunksz : chunk size 1482 !------------------------------------------------------------------- 1483 !> @code 1760 !> - November, 2013- Initial Version 1761 ! 1762 !> @param[in] cd_name variable name 1763 !> @param[in] rd_value 1D array of real(4) value 1764 !> @param[in] id_start index in the variable from which the 1765 !> data values will be read 1766 !> @param[in] id_count number of indices selected along 1767 !> each dimension 1768 !> @param[in] id_type variable type 1769 !> @param[in] td_dim array of dimension structure 1770 !> @param[in] td_att array of attribute structure 1771 !> @param[in] rd_fill fill value 1772 !> @param[in] cd_units units 1773 !> @param[in] cd_axis axis expected to be used 1774 !> @param[in] cd_stdname variable standard name 1775 !> @param[in] cd_longname variable long name 1776 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 1777 !> @param[in] id_id variable id 1778 !> @param[in] id_ew east west wrap 1779 !> @param[in] dd_scf scale factor 1780 !> @param[in] dd_ofs add offset 1781 !> @param[in] id_rec record id (for rstdimg file) 1782 !> @param[in] dd_min minimum value 1783 !> @param[in] dd_max maximum value 1784 !> @param[in] ld_contiguous use contiguous storage or not 1785 !> @param[in] ld_shuffle shuffle filter is turned on or not 1786 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 1787 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 1788 !> deflation is in use 1789 !> @param[in] id_chunksz chunk size 1790 !> @return variable structure 1791 !------------------------------------------------------------------- 1484 1792 TYPE(TVAR) FUNCTION var__init_1D_sp( cd_name, rd_value, & 1485 1793 & id_start, id_count, id_type, td_dim, & 1486 & td_att, rd_fill, cd_units, &1794 & td_att, rd_fill, cd_units, cd_axis,& 1487 1795 & cd_stdname, cd_longname, & 1488 1796 & cd_point, id_id, id_ew, & … … 1503 1811 REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill 1504 1812 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 1813 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1505 1814 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1506 1815 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1550 1859 & dd_fill=dl_fill, & 1551 1860 & cd_units=cd_units, & 1861 & cd_axis=cd_axis, & 1552 1862 & cd_stdname=cd_stdname, & 1553 1863 & cd_longname=cd_longname, & … … 1565 1875 1566 1876 END FUNCTION var__init_1D_sp 1567 !> @endcode 1568 !------------------------------------------------------------------- 1569 !> @brief This function initalise a variable structure. 1570 !> - real(4) 2D table of value could be added. 1571 !> - dimension structure could be added. 1572 !> - attribute structure could be added 1573 ! 1877 !------------------------------------------------------------------- 1878 !> @brief This function initialize a variable structure, 1879 !> with a real(4) 2D array of value. 1574 1880 !> @details 1575 !> table of 2 dimension structure is needed to put value in variable structure. 1576 !> If none is given, we assume table is ordered as ('x','y') and we 1577 !> use table size as lentgh dimension. 1881 !> optionally could be added:<br/> 1882 !> - dimension structure. 1883 !> - attribute structure. 1884 !> 1885 !> array of 2 dimension structure is needed to put value in variable structure. 1886 !> If none is given, we assume array is ordered as ('x','y') and we 1887 !> use array size as lentgh dimension. 1578 1888 !> 1579 1889 !> indices in the variable where value will be written could be specify if 1580 !> start and count tableare given. Dimension structure is needed in that1890 !> start and count array are given. Dimension structure is needed in that 1581 1891 !> case. 1582 1892 ! 1583 1893 !> @author J.Paul 1584 !> - Nov, 2013- Initial Version 1585 ! 1586 !> @param[in] cd_name : variable name 1587 !> @param[in] rd_value : 2D table of real(4) value 1588 !> @param[in] id_start : index in the variable from which the data values 1589 !> will be read 1590 !> @param[in] id_count : number of indices selected along each dimension 1591 !> @param[in] id_type : variable type 1592 !> @param[in] td_dim : table of dimension structure 1593 !> @param[in] td_att : table of attribute structure 1594 !> @param[in] rd_fill : fill value 1595 !> @param[in] cd_units : units 1596 !> @param[in] cd_stdname : variable standard name 1597 !> @param[in] cd_longname : variable long name 1598 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1599 !> @param[in] id_id : variable id 1600 !> @param[in] id_ew : east west wrap 1601 !> @param[in] dd_scf : scale factor 1602 !> @param[in] dd_ofs : add offset 1603 !> @param[in] id_rec : record id (for rstdimg file) 1604 !> @param[in] dd_min : minimum value 1605 !> @param[in] dd_max : maximum value 1606 !> @param[in] ld_contiguous : use contiguous storage or not 1607 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1608 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1609 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 1610 !> @param[in] id_chunksz : chunk size 1611 !------------------------------------------------------------------- 1612 !> @code 1894 !> - November, 2013- Initial Version 1895 ! 1896 !> @param[in] cd_name : variable name 1897 !> @param[in] rd_value : 2D array of real(4) value 1898 !> @param[in] id_start : index in the variable from which the 1899 !> data values will be read 1900 !> @param[in] id_count : number of indices selected along 1901 !> each dimension 1902 !> @param[in] id_type : variable type 1903 !> @param[in] td_dim : array of dimension structure 1904 !> @param[in] td_att : array of attribute structure 1905 !> @param[in] rd_fill : fill value 1906 !> @param[in] cd_units : units 1907 !> @param[in] cd_axis axis expected to be used 1908 !> @param[in] cd_stdname : variable standard name 1909 !> @param[in] cd_longname : variable long name 1910 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1911 !> @param[in] id_id : variable id 1912 !> @param[in] id_ew : east west wrap 1913 !> @param[in] dd_scf : scale factor 1914 !> @param[in] dd_ofs : add offset 1915 !> @param[in] id_rec : record id (for rstdimg file) 1916 !> @param[in] dd_min : minimum value 1917 !> @param[in] dd_max : maximum value 1918 !> @param[in] ld_contiguous : use contiguous storage or not 1919 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1920 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1921 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no 1922 !> deflation is in use 1923 !> @param[in] id_chunksz : chunk size 1924 !> @return variable structure 1925 !------------------------------------------------------------------- 1613 1926 TYPE(TVAR) FUNCTION var__init_2D_sp( cd_name, rd_value, & 1614 1927 & id_start, id_count, id_type, td_dim, & 1615 & td_att, rd_fill, cd_units, &1928 & td_att, rd_fill, cd_units, cd_axis,& 1616 1929 & cd_stdname, cd_longname, & 1617 1930 & cd_point, id_id, id_ew, & … … 1625 1938 CHARACTER(LEN=*), INTENT(IN) :: cd_name 1626 1939 REAL(sp) , DIMENSION(:,:) , INTENT(IN) :: rd_value 1627 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start1628 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count1940 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 1941 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 1629 1942 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 1630 1943 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 1632 1945 REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill 1633 1946 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 1947 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1634 1948 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1635 1949 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1681 1995 & dd_fill=dl_fill, & 1682 1996 & cd_units=cd_units, & 1997 & cd_axis=cd_axis, & 1683 1998 & cd_stdname=cd_stdname, & 1684 1999 & cd_longname=cd_longname, & … … 1696 2011 1697 2012 END FUNCTION var__init_2D_sp 1698 !> @endcode 1699 !------------------------------------------------------------------- 1700 !> @brief This function initalise a variable structure. 1701 !> - real(4) 2D table of value could be added. 1702 !> - dimension structure could be added. 1703 !> - attribute structure could be added 1704 ! 2013 !------------------------------------------------------------------- 2014 !> @brief This function initialize a variable structure, 2015 !> with a real(4) 3D array of value. 1705 2016 !> @details 1706 !> table of 2 dimension structure is needed to put value in variable structure. 1707 !> If none is given, we assume table is ordered as ('x','y') and we 1708 !> use table size as lentgh dimension. 2017 !> optionally could be added:<br/> 2018 !> - dimension structure. 2019 !> - attribute structure. 2020 !> 2021 !> array of 3 dimension structure is needed to put value in variable structure. 2022 !> If none is given, we assume array is ordered as ('x','y','z') and we 2023 !> use array size as lentgh dimension. 1709 2024 !> 1710 2025 !> indices in the variable where value will be written could be specify if 1711 !> start and count tableare given. Dimension structure is needed in that2026 !> start and count array are given. Dimension structure is needed in that 1712 2027 !> case. 1713 2028 ! 1714 2029 !> @author J.Paul 1715 !> - Nov, 2013- Initial Version 1716 ! 1717 !> @param[in] cd_name : variable name 1718 !> @param[in] rd_value : 2D table of real(4) value 1719 !> @param[in] id_start : index in the variable from which the data values 1720 !> will be read 1721 !> @param[in] id_count : number of indices selected along each dimension 1722 !> @param[in] id_type : variable type 1723 !> @param[in] td_dim : table of dimension structure 1724 !> @param[in] td_att : table of attribute structure 1725 !> @param[in] rd_fill : fill value 1726 !> @param[in] cd_units : units 1727 !> @param[in] cd_stdname : variable standard name 1728 !> @param[in] cd_longname : variable long name 1729 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1730 !> @param[in] id_id : variable id 1731 !> @param[in] id_ew : east west wrap 1732 !> @param[in] dd_scf : scale factor 1733 !> @param[in] dd_ofs : add offset 1734 !> @param[in] id_rec : record id (for rstdimg file) 1735 !> @param[in] dd_min : minimum value 1736 !> @param[in] dd_max : maximum value 1737 !> @param[in] ld_contiguous : use contiguous storage or not 1738 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1739 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1740 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 1741 !> @param[in] id_chunksz : chunk size 1742 !------------------------------------------------------------------- 1743 !> @code 2030 !> - November, 2013- Initial Version 2031 ! 2032 !> @param[in] cd_name : variable name 2033 !> @param[in] rd_value : 2D array of real(4) value 2034 !> @param[in] id_start : index in the variable from which the 2035 !> data values will be read 2036 !> @param[in] id_count : number of indices selected along 2037 !> each dimension 2038 !> @param[in] id_type : variable type 2039 !> @param[in] td_dim : array of dimension structure 2040 !> @param[in] td_att : array of attribute structure 2041 !> @param[in] rd_fill : fill value 2042 !> @param[in] cd_units : units 2043 !> @param[in] cd_axis axis expected to be used 2044 !> @param[in] cd_stdname : variable standard name 2045 !> @param[in] cd_longname : variable long name 2046 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2047 !> @param[in] id_id : variable id 2048 !> @param[in] id_ew : east west wrap 2049 !> @param[in] dd_scf : scale factor 2050 !> @param[in] dd_ofs : add offset 2051 !> @param[in] id_rec : record id (for rstdimg file) 2052 !> @param[in] dd_min : minimum value 2053 !> @param[in] dd_max : maximum value 2054 !> @param[in] ld_contiguous : use contiguous storage or not 2055 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2056 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2057 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no 2058 !> deflation is in use 2059 !> @param[in] id_chunksz : chunk size 2060 !> @return variable structure 2061 !------------------------------------------------------------------- 1744 2062 TYPE(TVAR) FUNCTION var__init_3D_sp( cd_name, rd_value, & 1745 2063 & id_start, id_count, id_type, td_dim, & 1746 & td_att, rd_fill, cd_units, &2064 & td_att, rd_fill, cd_units, cd_axis,& 1747 2065 & cd_stdname, cd_longname, & 1748 2066 & cd_point, id_id, id_ew, & … … 1756 2074 CHARACTER(LEN=*), INTENT(IN) :: cd_name 1757 2075 REAL(sp) , DIMENSION(:,:,:) , INTENT(IN) :: rd_value 1758 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start1759 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count2076 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 2077 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 1760 2078 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 1761 2079 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 1763 2081 REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill 1764 2082 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2083 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1765 2084 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1766 2085 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1813 2132 & dd_fill=dl_fill, & 1814 2133 & cd_units=cd_units, & 2134 & cd_axis=cd_axis, & 1815 2135 & cd_stdname=cd_stdname, & 1816 2136 & cd_longname=cd_longname, & … … 1828 2148 1829 2149 END FUNCTION var__init_3D_sp 1830 !> @endcode 1831 !------------------------------------------------------------------- 1832 !> @brief This function initalise a variable structure. 1833 !> - real(4) 4D table of value could be added. 1834 !> - dimension structure could be added. 1835 !> - attribute structure could be added 1836 ! 2150 !------------------------------------------------------------------- 2151 !> @brief This function initialize a variable structure, 2152 !> with a real(4) 4D array of value. 1837 2153 !> @details 2154 !> optionally could be added:<br/> 2155 !> - dimension structure. 2156 !> - attribute structure. 2157 !> 1838 2158 !> Dimension structure is needed to put value in variable structure. 1839 !> If none is given, we assume tableis ordered as ('x','y','z','t') and we1840 !> use tablesize as lentgh dimension.2159 !> If none is given, we assume array is ordered as ('x','y','z','t') and we 2160 !> use array size as lentgh dimension. 1841 2161 !> 1842 2162 !> indices in the variable where value will be written could be specify if 1843 !> start and count tableare given. Dimension structure is needed in that2163 !> start and count array are given. Dimension structure is needed in that 1844 2164 !> case. 1845 2165 ! 1846 2166 !> @author J.Paul 1847 !> - Nov, 2013- Initial Version 1848 ! 1849 !> @param[in] cd_name : variable name 1850 !> @param[in] rd_value : 4D table of real(4) value 1851 !> @param[in] id_start : index in the variable from which the data values 1852 !> will be read 1853 !> @param[in] id_count : number of indices selected along each dimension 1854 !> @param[in] id_type : variable type 1855 !> @param[in] td_dim : table of dimension structure 1856 !> @param[in] td_att : table of attribute structure 1857 !> @param[in] rd_fill : fill value 1858 !> @param[in] cd_units : units 1859 !> @param[in] cd_stdname : variable standard name 1860 !> @param[in] cd_longname : variable long name 1861 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1862 !> @param[in] id_id : variable id 1863 !> @param[in] id_ew : east west wrap 1864 !> @param[in] dd_scf : scale factor 1865 !> @param[in] dd_ofs : add offset 1866 !> @param[in] id_rec : record id (for rstdimg file) 1867 !> @param[in] dd_min : minimum value 1868 !> @param[in] dd_max : maximum value 1869 !> @param[in] ld_contiguous : use contiguous storage or not 1870 !> @param[in] ld_shuffle : shuffle filter is turned on or not 1871 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 1872 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 1873 !> @param[in] id_chunksz : chunk size 1874 !------------------------------------------------------------------- 1875 !> @code 2167 !> - November, 2013- Initial Version 2168 ! 2169 !> @param[in] cd_name variable name 2170 !> @param[in] rd_value 4D array of real(4) value 2171 !> @param[in] id_start index in the variable from which the 2172 !> data values will be read 2173 !> @param[in] id_count number of indices selected along 2174 !> each dimension 2175 !> @param[in] id_type variable type 2176 !> @param[in] td_dim array of dimension structure 2177 !> @param[in] td_att array of attribute structure 2178 !> @param[in] rd_fill fill value 2179 !> @param[in] cd_units units 2180 !> @param[in] cd_axis axis expected to be used 2181 !> @param[in] cd_stdname variable standard name 2182 !> @param[in] cd_longname variable long name 2183 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 2184 !> @param[in] id_id variable id 2185 !> @param[in] id_ew east west wrap 2186 !> @param[in] dd_scf scale factor 2187 !> @param[in] dd_ofs add offset 2188 !> @param[in] id_rec record id (for rstdimg file) 2189 !> @param[in] dd_min minimum value 2190 !> @param[in] dd_max maximum value 2191 !> @param[in] ld_contiguous use contiguous storage or not 2192 !> @param[in] ld_shuffle shuffle filter is turned on or not 2193 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 2194 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 2195 !> deflation is in use 2196 !> @param[in] id_chunksz chunk size 2197 !> @return variable structure 2198 !------------------------------------------------------------------- 1876 2199 TYPE(TVAR) FUNCTION var__init_sp( cd_name, rd_value, & 1877 2200 & id_start, id_count, id_type, td_dim, & 1878 & td_att, rd_fill, cd_units, &2201 & td_att, rd_fill, cd_units, cd_axis,& 1879 2202 & cd_stdname, cd_longname, & 1880 2203 & cd_point, id_id, id_ew, & … … 1895 2218 REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill 1896 2219 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2220 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 1897 2221 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 1898 2222 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 1946 2270 & dd_fill=dl_fill, & 1947 2271 & cd_units=cd_units, & 2272 & cd_axis=cd_axis, & 1948 2273 & cd_stdname=cd_stdname, & 1949 2274 & cd_longname=cd_longname, & … … 1961 2286 1962 2287 END FUNCTION var__init_sp 1963 !> @endcode 1964 !------------------------------------------------------------------- 1965 !> @brief This function initalise a variable structure. 1966 !> - integer(8) 1D table of value could be added. 1967 !> - dimension structure could be added. 1968 !> - attribute structure could be added 1969 ! 2288 !------------------------------------------------------------------- 2289 !> @brief This function initialize a variable structure, 2290 !> with a integer(8) 1D array of value. 1970 2291 !> @details 2292 !> optionally could be added:<br/> 2293 !> - dimension structure. 2294 !> - attribute structure. 2295 !> 1971 2296 !> dimension structure is needed to put value in variable structure. 1972 !> If none is given, we assume tableis ordered as ('z') and we1973 !> use tablesize as lentgh dimension.2297 !> If none is given, we assume array is ordered as ('z') and we 2298 !> use array size as lentgh dimension. 1974 2299 !> 1975 2300 !> indices in the variable where value will be written could be specify if 1976 !> start and count tableare given. Dimension structure is needed in that2301 !> start and count array are given. Dimension structure is needed in that 1977 2302 !> case. 1978 2303 ! 1979 2304 !> @author J.Paul 1980 !> - Nov, 2013- Initial Version 1981 ! 1982 !> @param[in] cd_name : variable name 1983 !> @param[in] kd_value : 1D table of integer(8) value 1984 !> @param[in] id_start : index in the variable from which the data values 1985 !> will be read 1986 !> @param[in] id_count : number of indices selected along each dimension 1987 !> @param[in] id_type : variable type 1988 !> @param[in] td_dim : table of dimension structure 1989 !> @param[in] td_att : table of attribute structure 1990 !> @param[in] kd_fill : fill value 1991 !> @param[in] cd_units : units 1992 !> @param[in] cd_stdname : variable standard name 1993 !> @param[in] cd_longname : variable long name 1994 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 1995 !> @param[in] id_id : variable id 1996 !> @param[in] id_ew : east west wrap 1997 !> @param[in] dd_scf : scale factor 1998 !> @param[in] dd_ofs : add offset 1999 !> @param[in] id_rec : record id (for rstdimg file) 2000 !> @param[in] dd_min : minimum value 2001 !> @param[in] dd_max : maximum value 2002 !> @param[in] ld_contiguous : use contiguous storage or not 2003 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2004 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2005 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2006 !> @param[in] id_chunksz : chunk size 2007 !------------------------------------------------------------------- 2008 !> @code 2305 !> - November, 2013- Initial Version 2306 ! 2307 !> @param[in] cd_name : variable name 2308 !> @param[in] kd_value : 1D array of integer(8) value 2309 !> @param[in] id_start : index in the variable from which the 2310 !> data values will be read 2311 !> @param[in] id_count : number of indices selected along 2312 !> each dimension 2313 !> @param[in] id_type : variable type 2314 !> @param[in] td_dim : array of dimension structure 2315 !> @param[in] td_att : array of attribute structure 2316 !> @param[in] kd_fill : fill value 2317 !> @param[in] cd_units : units 2318 !> @param[in] cd_axis axis expected to be used 2319 !> @param[in] cd_stdname : variable standard name 2320 !> @param[in] cd_longname : variable long name 2321 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2322 !> @param[in] id_id : variable id 2323 !> @param[in] id_ew : east west wrap 2324 !> @param[in] dd_scf : scale factor 2325 !> @param[in] dd_ofs : add offset 2326 !> @param[in] id_rec : record id (for rstdimg file) 2327 !> @param[in] dd_min : minimum value 2328 !> @param[in] dd_max : maximum value 2329 !> @param[in] ld_contiguous : use contiguous storage or not 2330 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2331 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2332 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no 2333 !> deflation is in use 2334 !> @param[in] id_chunksz : chunk size 2335 !> @return variable structure 2336 !------------------------------------------------------------------- 2009 2337 TYPE(TVAR) FUNCTION var__init_1D_i8( cd_name, kd_value, & 2010 2338 & id_start, id_count, id_type, td_dim, & 2011 & td_att, kd_fill, cd_units, &2339 & td_att, kd_fill, cd_units, cd_axis,& 2012 2340 & cd_stdname, cd_longname, & 2013 2341 & cd_point, id_id, id_ew, & … … 2028 2356 INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill 2029 2357 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2358 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2030 2359 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2031 2360 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2075 2404 & dd_fill=dl_fill, & 2076 2405 & cd_units=cd_units, & 2406 & cd_axis=cd_axis, & 2077 2407 & cd_stdname=cd_stdname, & 2078 2408 & cd_longname=cd_longname, & … … 2090 2420 2091 2421 END FUNCTION var__init_1D_i8 2092 !> @endcode 2093 !------------------------------------------------------------------- 2094 !> @brief This function initalise a variable structure. 2095 !> - integer(8) 2D table of value could be added. 2096 !> - dimension structure could be added. 2097 !> - attribute structure could be added 2098 ! 2422 !------------------------------------------------------------------- 2423 !> @brief This function initialize a variable structure, 2424 !> with a integer(8) 2D array of value. 2099 2425 !> @details 2100 !> table of 2 dimension structure is needed to put value in variable structure. 2101 !> If none is given, we assume table is ordered as ('x','y') and we 2102 !> use table size as lentgh dimension. 2426 !> optionally could be added:<br/> 2427 !> - dimension structure. 2428 !> - attribute structure. 2429 !> 2430 !> array of 2 dimension structure is needed to put value in variable structure. 2431 !> If none is given, we assume array is ordered as ('x','y') and we 2432 !> use array size as lentgh dimension. 2103 2433 !> 2104 2434 !> indices in the variable where value will be written could be specify if 2105 !> start and count tableare given. Dimension structure is needed in that2435 !> start and count array are given. Dimension structure is needed in that 2106 2436 !> case. 2107 2437 ! 2108 2438 !> @author J.Paul 2109 !> - Nov , 2013- Initial Version2110 ! 2111 !> @param[in] cd_name :variable name2112 !> @param[in] kd_value : 2D tableof integer(8) value2113 !> @param[in] id_start :index in the variable from which the data values2439 !> - November, 2013- Initial Version 2440 ! 2441 !> @param[in] cd_name variable name 2442 !> @param[in] kd_value 2D array of integer(8) value 2443 !> @param[in] id_start index in the variable from which the data values 2114 2444 !> will be read 2115 !> @param[in] id_count : number of indices selected along each dimension 2116 !> @param[in] id_type : variable type 2117 !> @param[in] td_dim : table of dimension structure 2118 !> @param[in] td_att : table of attribute structure 2119 !> @param[in] kd_fill : fill value 2120 !> @param[in] cd_units : units 2121 !> @param[in] cd_stdname : variable standard name 2122 !> @param[in] cd_longname : variable long name 2123 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2124 !> @param[in] id_id : variable id 2125 !> @param[in] id_ew : east west wrap 2126 !> @param[in] dd_scf : scale factor 2127 !> @param[in] dd_ofs : add offset 2128 !> @param[in] id_rec : record id (for rstdimg file) 2129 !> @param[in] dd_min : minimum value 2130 !> @param[in] dd_max : maximum value 2131 !> @param[in] ld_contiguous : use contiguous storage or not 2132 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2133 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2134 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2135 !> @param[in] id_chunksz : chunk size 2136 !------------------------------------------------------------------- 2137 !> @code 2445 !> @param[in] id_count number of indices selected along each dimension 2446 !> @param[in] id_type variable type 2447 !> @param[in] td_dim array of dimension structure 2448 !> @param[in] td_att array of attribute structure 2449 !> @param[in] kd_fill fill value 2450 !> @param[in] cd_units units 2451 !> @param[in] cd_axis axis expected to be used 2452 !> @param[in] cd_stdname variable standard name 2453 !> @param[in] cd_longname variable long name 2454 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 2455 !> @param[in] id_id variable id 2456 !> @param[in] id_ew east west wrap 2457 !> @param[in] dd_scf scale factor 2458 !> @param[in] dd_ofs add offset 2459 !> @param[in] id_rec record id (for rstdimg file) 2460 !> @param[in] dd_min minimum value 2461 !> @param[in] dd_max maximum value 2462 !> @param[in] ld_contiguous use contiguous storage or not 2463 !> @param[in] ld_shuffle shuffle filter is turned on or not 2464 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 2465 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use 2466 !> @param[in] id_chunksz chunk size 2467 !> @return variable structure 2468 !------------------------------------------------------------------- 2138 2469 TYPE(TVAR) FUNCTION var__init_2D_i8( cd_name, kd_value, & 2139 2470 & id_start, id_count, id_type, td_dim, & 2140 & td_att, kd_fill, cd_units, &2471 & td_att, kd_fill, cd_units, cd_axis,& 2141 2472 & cd_stdname, cd_longname, & 2142 2473 & cd_point, id_id, id_ew, & … … 2150 2481 CHARACTER(LEN=*), INTENT(IN) :: cd_name 2151 2482 INTEGER(i8) , DIMENSION(:,:) , INTENT(IN) :: kd_value 2152 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start2153 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count2483 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 2484 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 2154 2485 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 2155 2486 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 2157 2488 INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill 2158 2489 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2490 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2159 2491 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2160 2492 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2206 2538 & dd_fill=dl_fill, & 2207 2539 & cd_units=cd_units, & 2540 & cd_axis=cd_axis, & 2208 2541 & cd_stdname=cd_stdname, & 2209 2542 & cd_longname=cd_longname, & … … 2221 2554 2222 2555 END FUNCTION var__init_2D_i8 2223 !> @endcode 2224 !------------------------------------------------------------------- 2225 !> @brief This function initalise a variable structure. 2226 !> - integer(8) 2D table of value could be added. 2227 !> - dimension structure could be added. 2228 !> - attribute structure could be added 2229 ! 2556 !------------------------------------------------------------------- 2557 !> @brief This function initialize a variable structure, 2558 !> with a integer(8) 3D array of value. 2230 2559 !> @details 2231 !> table of 2 dimension structure is needed to put value in variable structure. 2232 !> If none is given, we assume table is ordered as ('x','y') and we 2233 !> use table size as lentgh dimension. 2560 !> optionally could be added:<br/> 2561 !> - dimension structure. 2562 !> - attribute structure. 2563 !> 2564 !> array of 3 dimension structure is needed to put value in variable structure. 2565 !> If none is given, we assume array is ordered as ('x','y','z') and we 2566 !> use array size as lentgh dimension. 2234 2567 !> 2235 2568 !> indices in the variable where value will be written could be specify if 2236 !> start and count tableare given. Dimension structure is needed in that2569 !> start and count array are given. Dimension structure is needed in that 2237 2570 !> case. 2238 2571 ! 2239 2572 !> @author J.Paul 2240 !> - Nov, 2013- Initial Version 2241 ! 2242 !> @param[in] cd_name : variable name 2243 !> @param[in] kd_value : 2D table of integer(8) value 2244 !> @param[in] id_start : index in the variable from which the data values 2245 !> will be read 2246 !> @param[in] id_count : number of indices selected along each dimension 2247 !> @param[in] id_type : variable type 2248 !> @param[in] td_dim : table of dimension structure 2249 !> @param[in] td_att : table of attribute structure 2250 !> @param[in] kd_fill : fill value 2251 !> @param[in] cd_units : units 2252 !> @param[in] cd_stdname : variable standard name 2253 !> @param[in] cd_longname : variable long name 2254 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2255 !> @param[in] id_id : variable id 2256 !> @param[in] id_ew : east west wrap 2257 !> @param[in] dd_scf : scale factor 2258 !> @param[in] dd_ofs : add offset 2259 !> @param[in] id_rec : record id (for rstdimg file) 2260 !> @param[in] dd_min : minimum value 2261 !> @param[in] dd_max : maximum value 2262 !> @param[in] ld_contiguous : use contiguous storage or not 2263 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2264 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2265 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2266 !> @param[in] id_chunksz : chunk size 2267 !------------------------------------------------------------------- 2268 !> @code 2573 !> - November, 2013- Initial Version 2574 ! 2575 !> @param[in] cd_name variable name 2576 !> @param[in] kd_value 2D array of integer(8) value 2577 !> @param[in] id_start index in the variable from which the 2578 !> data values will be read 2579 !> @param[in] id_count number of indices selected along 2580 !> each dimension 2581 !> @param[in] id_type variable type 2582 !> @param[in] td_dim array of dimension structure 2583 !> @param[in] td_att array of attribute structure 2584 !> @param[in] kd_fill fill value 2585 !> @param[in] cd_units units 2586 !> @param[in] cd_axis axis expected to be used 2587 !> @param[in] cd_stdname variable standard name 2588 !> @param[in] cd_longname variable long name 2589 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 2590 !> @param[in] id_id variable id 2591 !> @param[in] id_ew east west wrap 2592 !> @param[in] dd_scf scale factor 2593 !> @param[in] dd_ofs add offset 2594 !> @param[in] id_rec record id (for rstdimg file) 2595 !> @param[in] dd_min minimum value 2596 !> @param[in] dd_max maximum value 2597 !> @param[in] ld_contiguous use contiguous storage or not 2598 !> @param[in] ld_shuffle shuffle filter is turned on or not 2599 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 2600 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 2601 !> deflation is in use 2602 !> @param[in] id_chunksz chunk size 2603 !> @return variable structure 2604 !------------------------------------------------------------------- 2269 2605 TYPE(TVAR) FUNCTION var__init_3D_i8( cd_name, kd_value, & 2270 2606 & id_start, id_count, id_type, td_dim, & 2271 & td_att, kd_fill, cd_units, &2607 & td_att, kd_fill, cd_units, cd_axis,& 2272 2608 & cd_stdname, cd_longname, & 2273 2609 & cd_point, id_id, id_ew, & … … 2281 2617 CHARACTER(LEN=*), INTENT(IN) :: cd_name 2282 2618 INTEGER(i8) , DIMENSION(:,:,:) , INTENT(IN) :: kd_value 2283 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start2284 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count2619 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 2620 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 2285 2621 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 2286 2622 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 2288 2624 INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill 2289 2625 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2626 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2290 2627 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2291 2628 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2338 2675 & dd_fill=dl_fill, & 2339 2676 & cd_units=cd_units, & 2677 & cd_axis=cd_axis, & 2340 2678 & cd_stdname=cd_stdname, & 2341 2679 & cd_longname=cd_longname, & … … 2353 2691 2354 2692 END FUNCTION var__init_3D_i8 2355 !> @endcode 2356 !------------------------------------------------------------------- 2357 !> @brief This function initalise a variable structure. 2358 !> - integer(8) 4D table of value could be added. 2359 !> - dimension structure could be added. 2360 !> - attribute structure could be added 2361 ! 2693 !------------------------------------------------------------------- 2694 !> @brief This function initialize a variable structure, 2695 !> with a integer(8) 4D array of value. 2362 2696 !> @details 2697 !> optionally could be added:<br/> 2698 !> - dimension structure. 2699 !> - attribute structure. 2700 !> 2363 2701 !> Dimension structure is needed to put value in variable structure. 2364 !> If none is given, we assume tableis ordered as ('x','y','z','t') and we2365 !> use tablesize as lentgh dimension.2702 !> If none is given, we assume array is ordered as ('x','y','z','t') and we 2703 !> use array size as lentgh dimension. 2366 2704 !> 2367 2705 !> indices in the variable where value will be written could be specify if 2368 !> start and count tableare given. Dimension structure is needed in that2706 !> start and count array are given. Dimension structure is needed in that 2369 2707 !> case. 2370 2708 ! 2371 2709 !> @author J.Paul 2372 !> - Nov, 2013- Initial Version 2373 ! 2374 !> @param[in] cd_name : variable name 2375 !> @param[in] kd_value : 4D table of integer(8) value 2376 !> @param[in] id_start : index in the variable from which the data values 2377 !> will be read 2378 !> @param[in] id_count : number of indices selected along each dimension 2379 !> @param[in] id_type : variable type 2380 !> @param[in] td_dim : table of dimension structure 2381 !> @param[in] td_att : table of attribute structure 2382 !> @param[in] kd_fill : fill value 2383 !> @param[in] cd_units : units 2384 !> @param[in] cd_stdname : variable standard name 2385 !> @param[in] cd_longname : variable long name 2386 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2387 !> @param[in] id_id : variable id 2388 !> @param[in] id_ew : east west wrap 2389 !> @param[in] dd_scf : scale factor 2390 !> @param[in] dd_ofs : add offset 2391 !> @param[in] id_rec : record id (for rstdimg file) 2392 !> @param[in] dd_min : minimum value 2393 !> @param[in] dd_max : maximum value 2394 !> @param[in] ld_contiguous : use contiguous storage or not 2395 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2396 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2397 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2398 !> @param[in] id_chunksz : chunk size 2399 !------------------------------------------------------------------- 2400 !> @code 2710 !> - November, 2013- Initial Version 2711 ! 2712 !> @param[in] cd_name variable name 2713 !> @param[in] kd_value 4D array of integer(8) value 2714 !> @param[in] id_start index in the variable from which the 2715 !> data values will be read 2716 !> @param[in] id_count number of indices selected along 2717 !> each dimension 2718 !> @param[in] id_type variable type 2719 !> @param[in] td_dim array of dimension structure 2720 !> @param[in] td_att array of attribute structure 2721 !> @param[in] kd_fill fill value 2722 !> @param[in] cd_units units 2723 !> @param[in] cd_axis axis expected to be used 2724 !> @param[in] cd_stdname variable standard name 2725 !> @param[in] cd_longname variable long name 2726 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 2727 !> @param[in] id_id variable id 2728 !> @param[in] id_ew east west wrap 2729 !> @param[in] dd_scf scale factor 2730 !> @param[in] dd_ofs add offset 2731 !> @param[in] id_rec record id (for rstdimg file) 2732 !> @param[in] dd_min minimum value 2733 !> @param[in] dd_max maximum value 2734 !> @param[in] ld_contiguous use contiguous storage or not 2735 !> @param[in] ld_shuffle shuffle filter is turned on or not 2736 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 2737 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 2738 !> deflation is in use 2739 !> @param[in] id_chunksz chunk size 2740 !> @return variable structure 2741 !------------------------------------------------------------------- 2401 2742 TYPE(TVAR) FUNCTION var__init_i8( cd_name, kd_value, & 2402 2743 & id_start, id_count, id_type, td_dim, & 2403 & td_att, kd_fill, cd_units, &2744 & td_att, kd_fill, cd_units, cd_axis,& 2404 2745 & cd_stdname, cd_longname, & 2405 2746 & cd_point, id_id, id_ew, & … … 2420 2761 INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill 2421 2762 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2763 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2422 2764 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2423 2765 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2471 2813 & dd_fill=dl_fill, & 2472 2814 & cd_units=cd_units, & 2815 & cd_axis=cd_axis, & 2473 2816 & cd_stdname=cd_stdname, & 2474 2817 & cd_longname=cd_longname, & … … 2486 2829 2487 2830 END FUNCTION var__init_i8 2488 !> @endcode 2489 !------------------------------------------------------------------- 2490 !> @brief This function initalise a variable structure. 2491 !> - integer(4) 1D table of value could be added. 2492 !> - dimension structure could be added. 2493 !> - attribute structure could be added 2494 ! 2831 !------------------------------------------------------------------- 2832 !> @brief This function initialize a variable structure, 2833 !> with a integer(4) 1D array of value. 2495 2834 !> @details 2835 !> optionally could be added:<br/> 2836 !> - dimension structure. 2837 !> - attribute structure. 2838 !> 2496 2839 !> dimension structure is needed to put value in variable structure. 2497 !> If none is given, we assume tableis ordered as ('z') and we2498 !> use tablesize as lentgh dimension.2840 !> If none is given, we assume array is ordered as ('z') and we 2841 !> use array size as lentgh dimension. 2499 2842 !> 2500 2843 !> indices in the variable where value will be written could be specify if 2501 !> start and count tableare given. Dimension structure is needed in that2844 !> start and count array are given. Dimension structure is needed in that 2502 2845 !> case. 2503 2846 ! 2504 2847 !> @author J.Paul 2505 !> - Nov, 2013- Initial Version 2506 ! 2507 !> @param[in] cd_name : variable name 2508 !> @param[in] id_value : 1D table of integer(4) value 2509 !> @param[in] id_start : index in the variable from which the data values 2510 !> will be read 2511 !> @param[in] id_count : number of indices selected along each dimension 2512 !> @param[in] id_type : variable type 2513 !> @param[in] td_dim : table of dimension structure 2514 !> @param[in] td_att : table of attribute structure 2515 !> @param[in] id_fill : fill value 2516 !> @param[in] cd_units : units 2517 !> @param[in] cd_stdname : variable standard name 2518 !> @param[in] cd_longname : variable long name 2519 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2520 !> @param[in] id_id : variable id 2521 !> @param[in] id_ew : east west wrap 2522 !> @param[in] dd_scf : scale factor 2523 !> @param[in] dd_ofs : add offset 2524 !> @param[in] id_rec : record id (for rstdimg file) 2525 !> @param[in] dd_min : minimum value 2526 !> @param[in] dd_max : maximum value 2527 !> @param[in] ld_contiguous : use contiguous storage or not 2528 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2529 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2530 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2531 !> @param[in] id_chunksz : chunk size 2532 !------------------------------------------------------------------- 2533 !> @code 2848 !> - November, 2013- Initial Version 2849 ! 2850 !> @param[in] cd_name variable name 2851 !> @param[in] id_value 1D array of integer(4) value 2852 !> @param[in] id_start index in the variable from which the 2853 !> data values will be read 2854 !> @param[in] id_count number of indices selected along 2855 !> each dimension 2856 !> @param[in] id_type variable type 2857 !> @param[in] td_dim array of dimension structure 2858 !> @param[in] td_att array of attribute structure 2859 !> @param[in] id_fill fill value 2860 !> @param[in] cd_units units 2861 !> @param[in] cd_axis axis expected to be used 2862 !> @param[in] cd_stdname variable standard name 2863 !> @param[in] cd_longname variable long name 2864 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 2865 !> @param[in] id_id variable id 2866 !> @param[in] id_ew east west wrap 2867 !> @param[in] dd_scf scale factor 2868 !> @param[in] dd_ofs add offset 2869 !> @param[in] id_rec record id (for rstdimg file) 2870 !> @param[in] dd_min minimum value 2871 !> @param[in] dd_max maximum value 2872 !> @param[in] ld_contiguous use contiguous storage or not 2873 !> @param[in] ld_shuffle shuffle filter is turned on or not 2874 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 2875 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 2876 !> deflation is in use 2877 !> @param[in] id_chunksz chunk size 2878 !> @return variable structure 2879 !------------------------------------------------------------------- 2534 2880 TYPE(TVAR) FUNCTION var__init_1D_i4( cd_name, id_value, & 2535 2881 & id_start, id_count, id_type, td_dim, & 2536 & td_att, id_fill, cd_units, &2882 & td_att, id_fill, cd_units, cd_axis,& 2537 2883 & cd_stdname, cd_longname, & 2538 2884 & cd_point, id_id, id_ew, & … … 2553 2899 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill 2554 2900 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 2901 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2555 2902 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2556 2903 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2600 2947 & dd_fill=dl_fill, & 2601 2948 & cd_units=cd_units, & 2949 & cd_axis=cd_axis, & 2602 2950 & cd_stdname=cd_stdname, & 2603 2951 & cd_longname=cd_longname, & … … 2615 2963 2616 2964 END FUNCTION var__init_1D_i4 2617 !> @endcode 2618 !------------------------------------------------------------------- 2619 !> @brief This function initalise a variable structure. 2620 !> - integer(4) 2D table of value could be added. 2621 !> - dimension structure could be added. 2622 !> - attribute structure could be added 2623 ! 2965 !------------------------------------------------------------------- 2966 !> @brief This function initialize a variable structure, 2967 !> with a integer(4) 2D array of value. 2624 2968 !> @details 2625 !> table of 2 dimension structure is needed to put value in variable structure. 2626 !> If none is given, we assume table is ordered as ('x','y') and we 2627 !> use table size as lentgh dimension. 2969 !> optionally could be added:<br/> 2970 !> - dimension structure. 2971 !> - attribute structure. 2972 !> 2973 !> array of 2 dimension structure is needed to put value in variable structure. 2974 !> If none is given, we assume array is ordered as ('x','y') and we 2975 !> use array size as lentgh dimension. 2628 2976 !> 2629 2977 !> indices in the variable where value will be written could be specify if 2630 !> start and count tableare given. Dimension structure is needed in that2978 !> start and count array are given. Dimension structure is needed in that 2631 2979 !> case. 2632 2980 ! 2633 2981 !> @author J.Paul 2634 !> - Nov, 2013- Initial Version 2635 ! 2636 !> @param[in] cd_name : variable name 2637 !> @param[in] id_value : 2D table of integer(4) value 2638 !> @param[in] id_start : index in the variable from which the data values 2639 !> will be read 2640 !> @param[in] id_count : number of indices selected along each dimension 2641 !> @param[in] id_type : variable type 2642 !> @param[in] td_dim : table of dimension structure 2643 !> @param[in] td_att : table of attribute structure 2644 !> @param[in] id_fill : fill value 2645 !> @param[in] cd_units : units 2646 !> @param[in] cd_stdname : variable standard name 2647 !> @param[in] cd_longname : variable long name 2648 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2649 !> @param[in] id_id : variable id 2650 !> @param[in] id_ew : east west wrap 2651 !> @param[in] dd_scf : scale factor 2652 !> @param[in] dd_ofs : add offset 2653 !> @param[in] id_rec : record id (for rstdimg file) 2654 !> @param[in] dd_min : minimum value 2655 !> @param[in] dd_max : maximum value 2656 !> @param[in] ld_contiguous : use contiguous storage or not 2657 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2658 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2659 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2660 !> @param[in] id_chunksz : chunk size 2661 !------------------------------------------------------------------- 2662 !> @code 2982 !> - November, 2013- Initial Version 2983 ! 2984 !> @param[in] cd_name variable name 2985 !> @param[in] id_value 2D array of integer(4) value 2986 !> @param[in] id_start index in the variable from which the 2987 !> data values will be read 2988 !> @param[in] id_count number of indices selected along 2989 !> each dimension 2990 !> @param[in] id_type variable type 2991 !> @param[in] td_dim array of dimension structure 2992 !> @param[in] td_att array of attribute structure 2993 !> @param[in] id_fill fill value 2994 !> @param[in] cd_units units 2995 !> @param[in] cd_axis axis expected to be used 2996 !> @param[in] cd_stdname variable standard name 2997 !> @param[in] cd_longname variable long name 2998 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 2999 !> @param[in] id_id variable id 3000 !> @param[in] id_ew east west wrap 3001 !> @param[in] dd_scf scale factor 3002 !> @param[in] dd_ofs add offset 3003 !> @param[in] id_rec record id (for rstdimg file) 3004 !> @param[in] dd_min minimum value 3005 !> @param[in] dd_max maximum value 3006 !> @param[in] ld_contiguous use contiguous storage or not 3007 !> @param[in] ld_shuffle shuffle filter is turned on or not 3008 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3009 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3010 !> deflation is in use 3011 !> @param[in] id_chunksz chunk size 3012 !> @return variable structure 3013 !------------------------------------------------------------------- 2663 3014 TYPE(TVAR) FUNCTION var__init_2D_i4( cd_name, id_value, & 2664 3015 & id_start, id_count, id_type, td_dim, & 2665 & td_att, id_fill, cd_units, &3016 & td_att, id_fill, cd_units, cd_axis,& 2666 3017 & cd_stdname, cd_longname, & 2667 3018 & cd_point, id_id, id_ew, & … … 2675 3026 CHARACTER(LEN=*), INTENT(IN) :: cd_name 2676 3027 INTEGER(i4) , DIMENSION(:,:) , INTENT(IN) :: id_value 2677 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start2678 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count3028 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 3029 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 2679 3030 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 2680 3031 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 2682 3033 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill 2683 3034 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3035 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2684 3036 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2685 3037 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2731 3083 & dd_fill=dl_fill, & 2732 3084 & cd_units=cd_units, & 3085 & cd_axis=cd_axis, & 2733 3086 & cd_stdname=cd_stdname, & 2734 3087 & cd_longname=cd_longname, & … … 2746 3099 2747 3100 END FUNCTION var__init_2D_i4 2748 !> @endcode 2749 !------------------------------------------------------------------- 2750 !> @brief This function initalise a variable structure. 2751 !> - integer(4) 2D table of value could be added. 2752 !> - dimension structure could be added. 2753 !> - attribute structure could be added 2754 ! 3101 !------------------------------------------------------------------- 3102 !> @brief This function initialize a variable structure, 3103 !> with a integer(4) 3D array of value. 2755 3104 !> @details 2756 !> table of 2 dimension structure is needed to put value in variable structure. 2757 !> If none is given, we assume table is ordered as ('x','y') and we 2758 !> use table size as lentgh dimension. 3105 !> optionally could be added:<br/> 3106 !> - dimension structure. 3107 !> - attribute structure. 3108 !> 3109 !> array of 3 dimension structure is needed to put value in variable structure. 3110 !> If none is given, we assume array is ordered as ('x','y','z') and we 3111 !> use array size as lentgh dimension. 2759 3112 !> 2760 3113 !> indices in the variable where value will be written could be specify if 2761 !> start and count tableare given. Dimension structure is needed in that3114 !> start and count array are given. Dimension structure is needed in that 2762 3115 !> case. 2763 3116 ! 2764 3117 !> @author J.Paul 2765 !> - Nov, 2013- Initial Version 2766 ! 2767 !> @param[in] cd_name : variable name 2768 !> @param[in] id_value : 2D table of integer(4) value 2769 !> @param[in] id_start : index in the variable from which the data values 2770 !> will be read 2771 !> @param[in] id_count : number of indices selected along each dimension 2772 !> @param[in] id_type : variable type 2773 !> @param[in] td_dim : table of dimension structure 2774 !> @param[in] td_att : table of attribute structure 2775 !> @param[in] id_fill : fill value 2776 !> @param[in] cd_units : units 2777 !> @param[in] cd_stdname : variable standard name 2778 !> @param[in] cd_longname : variable long name 2779 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2780 !> @param[in] id_id : variable id 2781 !> @param[in] id_ew : east west wrap 2782 !> @param[in] dd_scf : scale factor 2783 !> @param[in] dd_ofs : add offset 2784 !> @param[in] id_rec : record id (for rstdimg file) 2785 !> @param[in] dd_min : minimum value 2786 !> @param[in] dd_max : maximum value 2787 !> @param[in] ld_contiguous : use contiguous storage or not 2788 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2789 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2790 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2791 !> @param[in] id_chunksz : chunk size 2792 !------------------------------------------------------------------- 2793 !> @code 3118 !> - November, 2013- Initial Version 3119 ! 3120 !> @param[in] cd_name variable name 3121 !> @param[in] id_value 3D array of integer(4) value 3122 !> @param[in] id_start index in the variable from which the 3123 !> data values will be read 3124 !> @param[in] id_count number of indices selected along 3125 !> each dimension 3126 !> @param[in] id_type variable type 3127 !> @param[in] td_dim array of dimension structure 3128 !> @param[in] td_att array of attribute structure 3129 !> @param[in] id_fill fill value 3130 !> @param[in] cd_units units 3131 !> @param[in] cd_axis axis expected to be used 3132 !> @param[in] cd_stdname variable standard name 3133 !> @param[in] cd_longname variable long name 3134 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3135 !> @param[in] id_id variable id 3136 !> @param[in] id_ew east west wrap 3137 !> @param[in] dd_scf scale factor 3138 !> @param[in] dd_ofs add offset 3139 !> @param[in] id_rec record id (for rstdimg file) 3140 !> @param[in] dd_min minimum value 3141 !> @param[in] dd_max maximum value 3142 !> @param[in] ld_contiguous use contiguous storage or not 3143 !> @param[in] ld_shuffle shuffle filter is turned on or not 3144 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3145 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3146 !> deflation is in use 3147 !> @param[in] id_chunksz chunk size 3148 !> @return variable structure 3149 !------------------------------------------------------------------- 2794 3150 TYPE(TVAR) FUNCTION var__init_3D_i4( cd_name, id_value, & 2795 3151 & id_start, id_count, id_type, td_dim, & 2796 & td_att, id_fill, cd_units, &3152 & td_att, id_fill, cd_units, cd_axis,& 2797 3153 & cd_stdname, cd_longname, & 2798 3154 & cd_point, id_id, id_ew, & … … 2806 3162 CHARACTER(LEN=*), INTENT(IN) :: cd_name 2807 3163 INTEGER(i4) , DIMENSION(:,:,:) , INTENT(IN) :: id_value 2808 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start2809 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count3164 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 3165 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 2810 3166 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 2811 3167 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 2813 3169 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill 2814 3170 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3171 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2815 3172 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2816 3173 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2863 3220 & dd_fill=dl_fill, & 2864 3221 & cd_units=cd_units, & 3222 & cd_axis=cd_axis, & 2865 3223 & cd_stdname=cd_stdname, & 2866 3224 & cd_longname=cd_longname, & … … 2878 3236 2879 3237 END FUNCTION var__init_3D_i4 2880 !> @endcode 2881 !------------------------------------------------------------------- 2882 !> @brief This function initalise a variable structure. 2883 !> - integer(4) 4D table of value could be added. 2884 !> - dimension structure could be added. 2885 !> - attribute structure could be added 2886 ! 3238 !------------------------------------------------------------------- 3239 !> @brief This function initialize a variable structure, 3240 !> with a integer(4) 4D array of value. 2887 3241 !> @details 3242 !> optionally could be added:<br/> 3243 !> - dimension structure. 3244 !> - attribute structure. 3245 !> 2888 3246 !> Dimension structure is needed to put value in variable structure. 2889 !> If none is given, we assume tableis ordered as ('x','y','z','t') and we2890 !> use tablesize as lentgh dimension.3247 !> If none is given, we assume array is ordered as ('x','y','z','t') and we 3248 !> use array size as lentgh dimension. 2891 3249 !> 2892 3250 !> indices in the variable where value will be written could be specify if 2893 !> start and count tableare given. Dimension structure is needed in that3251 !> start and count array are given. Dimension structure is needed in that 2894 3252 !> case. 2895 3253 ! 2896 3254 !> @author J.Paul 2897 !> - Nov, 2013- Initial Version 2898 ! 2899 !> @param[in] cd_name : variable name 2900 !> @param[in] id_value : 4D table of integer(4) value 2901 !> @param[in] id_start : index in the variable from which the data values 2902 !> will be read 2903 !> @param[in] id_count : number of indices selected along each dimension 2904 !> @param[in] id_type : variable type 2905 !> @param[in] td_dim : table of dimension structure 2906 !> @param[in] td_att : table of attribute structure 2907 !> @param[in] id_fill : fill value 2908 !> @param[in] cd_units : units 2909 !> @param[in] cd_stdname : variable standard name 2910 !> @param[in] cd_longname : variable long name 2911 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 2912 !> @param[in] id_id : variable id 2913 !> @param[in] id_ew : east west wrap 2914 !> @param[in] dd_scf : scale factor 2915 !> @param[in] dd_ofs : add offset 2916 !> @param[in] id_rec : record id (for rstdimg file) 2917 !> @param[in] dd_min : minimum value 2918 !> @param[in] dd_max : maximum value 2919 !> @param[in] ld_contiguous : use contiguous storage or not 2920 !> @param[in] ld_shuffle : shuffle filter is turned on or not 2921 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 2922 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 2923 !> @param[in] id_chunksz : chunk size 2924 !------------------------------------------------------------------- 2925 !> @code 3255 !> - November, 2013- Initial Version 3256 ! 3257 !> @param[in] cd_name variable name 3258 !> @param[in] id_value 4D array of integer(4) value 3259 !> @param[in] id_start index in the variable from which the 3260 !> data values will be read 3261 !> @param[in] id_count number of indices selected along 3262 !> each dimension 3263 !> @param[in] id_type variable type 3264 !> @param[in] td_dim array of dimension structure 3265 !> @param[in] td_att array of attribute structure 3266 !> @param[in] id_fill fill value 3267 !> @param[in] cd_units units 3268 !> @param[in] cd_axis axis expected to be used 3269 !> @param[in] cd_stdname variable standard name 3270 !> @param[in] cd_longname variable long name 3271 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3272 !> @param[in] id_id variable id 3273 !> @param[in] id_ew east west wrap 3274 !> @param[in] dd_scf scale factor 3275 !> @param[in] dd_ofs add offset 3276 !> @param[in] id_rec record id (for rstdimg file) 3277 !> @param[in] dd_min minimum value 3278 !> @param[in] dd_max maximum value 3279 !> @param[in] ld_contiguous use contiguous storage or not 3280 !> @param[in] ld_shuffle shuffle filter is turned on or not 3281 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3282 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3283 !> deflation is in use 3284 !> @param[in] id_chunksz chunk size 3285 !> @return variable structure 3286 !------------------------------------------------------------------- 2926 3287 TYPE(TVAR) FUNCTION var__init_i4( cd_name, id_value, & 2927 3288 & id_start, id_count, id_type, td_dim, & 2928 & td_att, id_fill, cd_units, &3289 & td_att, id_fill, cd_units, cd_axis,& 2929 3290 & cd_stdname, cd_longname, & 2930 3291 & cd_point, id_id, id_ew, & … … 2945 3306 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill 2946 3307 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3308 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 2947 3309 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 2948 3310 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 2996 3358 & dd_fill=dl_fill, & 2997 3359 & cd_units=cd_units, & 3360 & cd_axis=cd_axis, & 2998 3361 & cd_stdname=cd_stdname, & 2999 3362 & cd_longname=cd_longname, & … … 3010 3373 DEALLOCATE( dl_value ) 3011 3374 3012 ! ! add value3013 ! IF( .NOT. PRESENT(td_dim) )THEN3014 ! il_shape(:)=SHAPE(id_value(:,:,:,:))3015 ! DO ji=1,ip_maxdim3016 ! tl_dim=dim_init( cp_dimorder(ji:ji), id_len=il_shape(ji))3017 ! CALL var_add_dim(var__init_i4, tl_dim)3018 ! ENDDO3019 ! ENDIF3020 ! CALL var_add_value(var__init_i4, id_value(:,:,:,:), &3021 ! & id_start(:), id_count(:))3022 3023 3375 END FUNCTION var__init_i4 3024 !> @endcode 3025 !------------------------------------------------------------------- 3026 !> @brief This function initalise a variable structure. 3027 !> - integer(2) 1D table of value could be added. 3028 !> - dimension structure could be added. 3029 !> - attribute structure could be added 3030 ! 3376 !------------------------------------------------------------------- 3377 !> @brief This function initialize a variable structure, 3378 !> with a integer(2) 1D array of value. 3031 3379 !> @details 3380 !> optionally could be added:<br/> 3381 !> - dimension structure. 3382 !> - attribute structure. 3383 !> 3032 3384 !> dimension structure is needed to put value in variable structure. 3033 !> If none is given, we assume tableis ordered as ('z') and we3034 !> use tablesize as lentgh dimension.3385 !> If none is given, we assume array is ordered as ('z') and we 3386 !> use array size as lentgh dimension. 3035 3387 !> 3036 3388 !> indices in the variable where value will be written could be specify if 3037 !> start and count tableare given. Dimension structure is needed in that3389 !> start and count array are given. Dimension structure is needed in that 3038 3390 !> case. 3039 3391 ! 3040 3392 !> @author J.Paul 3041 !> - Nov, 2013- Initial Version 3042 ! 3043 !> @param[in] cd_name : variable name 3044 !> @param[in] sd_value : 1D table of integer(2) value 3045 !> @param[in] id_start : index in the variable from which the data values 3046 !> will be read 3047 !> @param[in] id_count : number of indices selected along each dimension 3048 !> @param[in] id_type : variable type 3049 !> @param[in] td_dim : table of dimension structure 3050 !> @param[in] td_att : table of attribute structure 3051 !> @param[in] sd_fill : fill value 3052 !> @param[in] cd_units : units 3053 !> @param[in] cd_stdname : variable standard name 3054 !> @param[in] cd_longname : variable long name 3055 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3056 !> @param[in] id_id : variable id 3057 !> @param[in] id_ew : east west wrap 3058 !> @param[in] dd_scf : scale factor 3059 !> @param[in] dd_ofs : add offset 3060 !> @param[in] id_rec : record id (for rstdimg file) 3061 !> @param[in] dd_min : minimum value 3062 !> @param[in] dd_max : maximum value 3063 !> @param[in] ld_contiguous : use contiguous storage or not 3064 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3065 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3066 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3067 !> @param[in] id_chunksz : chunk size 3068 !------------------------------------------------------------------- 3069 !> @code 3393 !> - November, 2013- Initial Version 3394 ! 3395 !> @param[in] cd_name variable name 3396 !> @param[in] sd_value 1D array of integer(2) value 3397 !> @param[in] id_start index in the variable from which the 3398 !> data values will be read 3399 !> @param[in] id_count number of indices selected along 3400 !> each dimension 3401 !> @param[in] id_type variable type 3402 !> @param[in] td_dim array of dimension structure 3403 !> @param[in] td_att array of attribute structure 3404 !> @param[in] sd_fill fill value 3405 !> @param[in] cd_units units 3406 !> @param[in] cd_axis axis expected to be used 3407 !> @param[in] cd_stdname variable standard name 3408 !> @param[in] cd_longname variable long name 3409 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3410 !> @param[in] id_id variable id 3411 !> @param[in] id_ew east west wrap 3412 !> @param[in] dd_scf scale factor 3413 !> @param[in] dd_ofs add offset 3414 !> @param[in] id_rec record id (for rstdimg file) 3415 !> @param[in] dd_min minimum value 3416 !> @param[in] dd_max maximum value 3417 !> @param[in] ld_contiguous use contiguous storage or not 3418 !> @param[in] ld_shuffle shuffle filter is turned on or not 3419 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3420 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3421 !> deflation is in use 3422 !> @param[in] id_chunksz chunk size 3423 !> @return variable structure 3424 !------------------------------------------------------------------- 3070 3425 TYPE(TVAR) FUNCTION var__init_1D_i2( cd_name, sd_value, & 3071 3426 & id_start, id_count, id_type, td_dim, & 3072 & td_att, sd_fill, cd_units, &3427 & td_att, sd_fill, cd_units, cd_axis,& 3073 3428 & cd_stdname, cd_longname, & 3074 3429 & cd_point, id_id, id_ew, & … … 3089 3444 INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill 3090 3445 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3446 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3091 3447 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3092 3448 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3136 3492 & dd_fill=dl_fill, & 3137 3493 & cd_units=cd_units, & 3494 & cd_axis=cd_axis, & 3138 3495 & cd_stdname=cd_stdname, & 3139 3496 & cd_longname=cd_longname, & … … 3151 3508 3152 3509 END FUNCTION var__init_1D_i2 3153 !> @endcode 3154 !------------------------------------------------------------------- 3155 !> @brief This function initalise a variable structure. 3156 !> - integer(2) 2D table of value could be added. 3157 !> - dimension structure could be added. 3158 !> - attribute structure could be added 3159 ! 3510 !------------------------------------------------------------------- 3511 !> @brief This function initialize a variable structure, 3512 !> with a integer(2) 2D array of value. 3160 3513 !> @details 3161 !> table of 2 dimension structure is needed to put value in variable structure. 3162 !> If none is given, we assume table is ordered as ('x','y') and we 3163 !> use table size as lentgh dimension. 3514 !> optionally could be added:<br/> 3515 !> - dimension structure. 3516 !> - attribute structure. 3517 !> 3518 !> array of 2 dimension structure is needed to put value in variable structure. 3519 !> If none is given, we assume array is ordered as ('x','y') and we 3520 !> use array size as lentgh dimension. 3164 3521 !> 3165 3522 !> indices in the variable where value will be written could be specify if 3166 !> start and count tableare given. Dimension structure is needed in that3523 !> start and count array are given. Dimension structure is needed in that 3167 3524 !> case. 3168 3525 ! 3169 3526 !> @author J.Paul 3170 !> - Nov, 2013- Initial Version 3171 ! 3172 !> @param[in] cd_name : variable name 3173 !> @param[in] sd_value : 2D table of integer(2) value 3174 !> @param[in] id_start : index in the variable from which the data values 3175 !> will be read 3176 !> @param[in] id_count : number of indices selected along each dimension 3177 !> @param[in] id_type : variable type 3178 !> @param[in] td_dim : table of dimension structure 3179 !> @param[in] td_att : table of attribute structure 3180 !> @param[in] sd_fill : fill value 3181 !> @param[in] cd_units : units 3182 !> @param[in] cd_stdname : variable standard name 3183 !> @param[in] cd_longname : variable long name 3184 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3185 !> @param[in] id_id : variable id 3186 !> @param[in] id_ew : east west wrap 3187 !> @param[in] dd_scf : scale factor 3188 !> @param[in] dd_ofs : add offset 3189 !> @param[in] id_rec : record id (for rstdimg file) 3190 !> @param[in] dd_min : minimum value 3191 !> @param[in] dd_max : maximum value 3192 !> @param[in] ld_contiguous : use contiguous storage or not 3193 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3194 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3195 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3196 !> @param[in] id_chunksz : chunk size 3197 !------------------------------------------------------------------- 3198 !> @code 3527 !> - November, 2013- Initial Version 3528 ! 3529 !> @param[in] cd_name variable name 3530 !> @param[in] sd_value 2D array of integer(2) value 3531 !> @param[in] id_start index in the variable from which the 3532 !> data values will be read 3533 !> @param[in] id_count number of indices selected along 3534 !> each dimension 3535 !> @param[in] id_type variable type 3536 !> @param[in] td_dim array of dimension structure 3537 !> @param[in] td_att array of attribute structure 3538 !> @param[in] sd_fill fill value 3539 !> @param[in] cd_units units 3540 !> @param[in] cd_axis axis expected to be used 3541 !> @param[in] cd_stdname variable standard name 3542 !> @param[in] cd_longname variable long name 3543 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3544 !> @param[in] id_id variable id 3545 !> @param[in] id_ew east west wrap 3546 !> @param[in] dd_scf scale factor 3547 !> @param[in] dd_ofs add offset 3548 !> @param[in] id_rec record id (for rstdimg file) 3549 !> @param[in] dd_min minimum value 3550 !> @param[in] dd_max maximum value 3551 !> @param[in] ld_contiguous use contiguous storage or not 3552 !> @param[in] ld_shuffle shuffle filter is turned on or not 3553 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3554 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3555 !> deflation is in use 3556 !> @param[in] id_chunksz chunk size 3557 !> @return variable structure 3558 !------------------------------------------------------------------- 3199 3559 TYPE(TVAR) FUNCTION var__init_2D_i2( cd_name, sd_value, & 3200 3560 & id_start, id_count, id_type, td_dim, & 3201 & td_att, sd_fill, cd_units, &3561 & td_att, sd_fill, cd_units, cd_axis,& 3202 3562 & cd_stdname, cd_longname, & 3203 3563 & cd_point, id_id, id_ew, & … … 3211 3571 CHARACTER(LEN=*), INTENT(IN) :: cd_name 3212 3572 INTEGER(i2) , DIMENSION(:,:) , INTENT(IN) :: sd_value 3213 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start3214 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count3573 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 3574 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 3215 3575 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 3216 3576 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 3218 3578 INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill 3219 3579 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3580 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3220 3581 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3221 3582 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3267 3628 & dd_fill=dl_fill, & 3268 3629 & cd_units=cd_units, & 3630 & cd_axis=cd_axis, & 3269 3631 & cd_stdname=cd_stdname, & 3270 3632 & cd_longname=cd_longname, & … … 3282 3644 3283 3645 END FUNCTION var__init_2D_i2 3284 !> @endcode 3285 !------------------------------------------------------------------- 3286 !> @brief This function initalise a variable structure. 3287 !> - integer(2) 2D table of value could be added. 3288 !> - dimension structure could be added. 3289 !> - attribute structure could be added 3290 ! 3646 !------------------------------------------------------------------- 3647 !> @brief This function initialize a variable structure, 3648 !> with a integer(2) 3D array of value. 3291 3649 !> @details 3292 !> table of 2 dimension structure is needed to put value in variable structure. 3293 !> If none is given, we assume table is ordered as ('x','y') and we 3294 !> use table size as lentgh dimension. 3650 !> optionally could be added:<br/> 3651 !> - dimension structure. 3652 !> - attribute structure. 3653 !> 3654 !> array of 3 dimension structure is needed to put value in variable structure. 3655 !> If none is given, we assume array is ordered as ('x','y','z') and we 3656 !> use array size as lentgh dimension. 3295 3657 !> 3296 3658 !> indices in the variable where value will be written could be specify if 3297 !> start and count tableare given. Dimension structure is needed in that3659 !> start and count array are given. Dimension structure is needed in that 3298 3660 !> case. 3299 3661 ! 3300 3662 !> @author J.Paul 3301 !> - Nov, 2013- Initial Version 3302 ! 3303 !> @param[in] cd_name : variable name 3304 !> @param[in] sd_value : 2D table of integer(2) value 3305 !> @param[in] id_start : index in the variable from which the data values 3306 !> will be read 3307 !> @param[in] id_count : number of indices selected along each dimension 3308 !> @param[in] id_type : variable type 3309 !> @param[in] td_dim : table of dimension structure 3310 !> @param[in] td_att : table of attribute structure 3311 !> @param[in] sd_fill : fill value 3312 !> @param[in] cd_units : units 3313 !> @param[in] cd_stdname : variable standard name 3314 !> @param[in] cd_longname : variable long name 3315 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3316 !> @param[in] id_id : variable id 3317 !> @param[in] id_ew : east west wrap 3318 !> @param[in] dd_scf : scale factor 3319 !> @param[in] dd_ofs : add offset 3320 !> @param[in] id_rec : record id (for rstdimg file) 3321 !> @param[in] dd_min : minimum value 3322 !> @param[in] dd_max : maximum value 3323 !> @param[in] ld_contiguous : use contiguous storage or not 3324 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3325 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3326 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3327 !> @param[in] id_chunksz : chunk size 3328 !------------------------------------------------------------------- 3329 !> @code 3663 !> - November, 2013- Initial Version 3664 ! 3665 !> @param[in] cd_name variable name 3666 !> @param[in] sd_value 3D array of integer(2) value 3667 !> @param[in] id_start index in the variable from which the 3668 !> data values will be read 3669 !> @param[in] id_count number of indices selected along 3670 !> each dimension 3671 !> @param[in] id_type variable type 3672 !> @param[in] td_dim array of dimension structure 3673 !> @param[in] td_att array of attribute structure 3674 !> @param[in] sd_fill fill value 3675 !> @param[in] cd_units units 3676 !> @param[in] cd_axis axis expected to be used 3677 !> @param[in] cd_stdname variable standard name 3678 !> @param[in] cd_longname variable long name 3679 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3680 !> @param[in] id_id variable id 3681 !> @param[in] id_ew east west wrap 3682 !> @param[in] dd_scf scale factor 3683 !> @param[in] dd_ofs add offset 3684 !> @param[in] id_rec record id (for rstdimg file) 3685 !> @param[in] dd_min minimum value 3686 !> @param[in] dd_max maximum value 3687 !> @param[in] ld_contiguous use contiguous storage or not 3688 !> @param[in] ld_shuffle shuffle filter is turned on or not 3689 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3690 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3691 !> deflation is in use 3692 !> @param[in] id_chunksz chunk size 3693 !> @return variable structure 3694 !------------------------------------------------------------------- 3330 3695 TYPE(TVAR) FUNCTION var__init_3D_i2( cd_name, sd_value, & 3331 3696 & id_start, id_count, id_type, td_dim, & 3332 & td_att, sd_fill, cd_units, &3697 & td_att, sd_fill, cd_units, cd_axis,& 3333 3698 & cd_stdname, cd_longname, & 3334 3699 & cd_point, id_id, id_ew, & … … 3342 3707 CHARACTER(LEN=*), INTENT(IN) :: cd_name 3343 3708 INTEGER(i2) , DIMENSION(:,:,:) , INTENT(IN) :: sd_value 3344 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start3345 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count3709 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 3710 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 3346 3711 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 3347 3712 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 3349 3714 INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill 3350 3715 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3716 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3351 3717 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3352 3718 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3399 3765 & dd_fill=dl_fill, & 3400 3766 & cd_units=cd_units, & 3767 & cd_axis=cd_axis, & 3401 3768 & cd_stdname=cd_stdname, & 3402 3769 & cd_longname=cd_longname, & … … 3414 3781 3415 3782 END FUNCTION var__init_3D_i2 3416 !> @endcode 3417 !------------------------------------------------------------------- 3418 !> @brief This function initalise a variable structure. 3419 !> - integer(2) 4D table of value could be added. 3420 !> - dimension structure could be added. 3421 !> - attribute structure could be added 3422 ! 3783 !------------------------------------------------------------------- 3784 !> @brief This function initialize a variable structure, 3785 !> with a integer(2) 4D array of value. 3423 3786 !> @details 3787 !> optionally could be added:<br/> 3788 !> - dimension structure. 3789 !> - attribute structure. 3790 !> 3424 3791 !> Dimension structure is needed to put value in variable structure. 3425 !> If none is given, we assume tableis ordered as ('x','y','z','t') and we3426 !> use tablesize as lentgh dimension.3792 !> If none is given, we assume array is ordered as ('x','y','z','t') and we 3793 !> use array size as lentgh dimension. 3427 3794 !> 3428 3795 !> indices in the variable where value will be written could be specify if 3429 !> start and count tableare given. Dimension structure is needed in that3796 !> start and count array are given. Dimension structure is needed in that 3430 3797 !> case. 3431 3798 ! 3432 3799 !> @author J.Paul 3433 !> - Nov, 2013- Initial Version 3434 ! 3435 !> @param[in] cd_name : variable name 3436 !> @param[in] sd_value : 4D table of integer(2) value 3437 !> @param[in] id_start : index in the variable from which the data values 3438 !> will be read 3439 !> @param[in] id_count : number of indices selected along each dimension 3440 !> @param[in] id_type : variable type 3441 !> @param[in] td_dim : table of dimension structure 3442 !> @param[in] td_att : table of attribute structure 3443 !> @param[in] sd_fill : fill value 3444 !> @param[in] cd_units : units 3445 !> @param[in] cd_stdname : variable standard name 3446 !> @param[in] cd_longname : variable long name 3447 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3448 !> @param[in] id_id : variable id 3449 !> @param[in] id_ew : east west wrap 3450 !> @param[in] dd_scf : scale factor 3451 !> @param[in] dd_ofs : add offset 3452 !> @param[in] id_rec : record id (for rstdimg file) 3453 !> @param[in] dd_min : minimum value 3454 !> @param[in] dd_max : maximum value 3455 !> @param[in] ld_contiguous : use contiguous storage or not 3456 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3457 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3458 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3459 !> @param[in] id_chunksz : chunk size 3460 !------------------------------------------------------------------- 3461 !> @code 3800 !> - November, 2013- Initial Version 3801 ! 3802 !> @param[in] cd_name variable name 3803 !> @param[in] sd_value 4D array of integer(2) value 3804 !> @param[in] id_start index in the variable from which the 3805 !> data values will be read 3806 !> @param[in] id_count number of indices selected along 3807 !> each dimension 3808 !> @param[in] id_type variable type 3809 !> @param[in] td_dim array of dimension structure 3810 !> @param[in] td_att array of attribute structure 3811 !> @param[in] sd_fill fill value 3812 !> @param[in] cd_units units 3813 !> @param[in] cd_axis axis expected to be used 3814 !> @param[in] cd_stdname variable standard name 3815 !> @param[in] cd_longname variable long name 3816 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3817 !> @param[in] id_id variable id 3818 !> @param[in] id_ew east west wrap 3819 !> @param[in] dd_scf scale factor 3820 !> @param[in] dd_ofs add offset 3821 !> @param[in] id_rec record id (for rstdimg file) 3822 !> @param[in] dd_min minimum value 3823 !> @param[in] dd_max maximum value 3824 !> @param[in] ld_contiguous use contiguous storage or not 3825 !> @param[in] ld_shuffle shuffle filter is turned on or not 3826 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3827 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3828 !> deflation is in use 3829 !> @param[in] id_chunksz chunk size 3830 !> @return variable structure 3831 !------------------------------------------------------------------- 3462 3832 TYPE(TVAR) FUNCTION var__init_i2( cd_name, sd_value, & 3463 3833 & id_start, id_count, id_type, td_dim, & 3464 & td_att, sd_fill, cd_units, &3834 & td_att, sd_fill, cd_units, cd_axis,& 3465 3835 & cd_stdname, cd_longname, & 3466 3836 & cd_point, id_id, id_ew, & … … 3481 3851 INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill 3482 3852 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3853 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3483 3854 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3484 3855 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3532 3903 & dd_fill=dl_fill, & 3533 3904 & cd_units=cd_units, & 3905 & cd_axis=cd_axis, & 3534 3906 & cd_stdname=cd_stdname, & 3535 3907 & cd_longname=cd_longname, & … … 3546 3918 DEALLOCATE( dl_value ) 3547 3919 3548 ! ! add value3549 ! IF( .NOT. PRESENT(td_dim) )THEN3550 ! il_shape(:)=SHAPE(sd_value(:,:,:,:))3551 ! DO ji=1,ip_maxdim3552 ! tl_dim=dim_init( cp_dimorder(ji:ji), id_len=il_shape(ji))3553 ! CALL var_add_dim(var__init_i2, tl_dim)3554 ! ENDDO3555 ! ENDIF3556 ! CALL var_add_value(var__init_i2, sd_value(:,:,:,:), &3557 ! & id_start(:), id_count(:))3558 3559 3920 END FUNCTION var__init_i2 3560 !> @endcode 3561 !------------------------------------------------------------------- 3562 !> @brief This function initalise a variable structure. 3563 !> - integer(1) 1D table of value could be added. 3564 !> - dimension structure could be added. 3565 !> - attribute structure could be added 3566 ! 3921 !------------------------------------------------------------------- 3922 !> @brief This function initialize a variable structure, 3923 !> with a integer(1) 1D array of value. 3567 3924 !> @details 3925 !> optionally could be added:<br/> 3926 !> - dimension structure. 3927 !> - attribute structure. 3928 !> 3568 3929 !> dimension structure is needed to put value in variable structure. 3569 !> If none is given, we assume tableis ordered as ('z') and we3570 !> use tablesize as lentgh dimension.3930 !> If none is given, we assume array is ordered as ('z') and we 3931 !> use array size as lentgh dimension. 3571 3932 !> 3572 3933 !> indices in the variable where value will be written could be specify if 3573 !> start and count tableare given. Dimension structure is needed in that3934 !> start and count array are given. Dimension structure is needed in that 3574 3935 !> case. 3575 3936 ! 3576 3937 !> @author J.Paul 3577 !> - Nov, 2013- Initial Version 3578 ! 3579 !> @param[in] cd_name : variable name 3580 !> @param[in] bd_value : 1D table of integer(1) value 3581 !> @param[in] id_start : index in the variable from which the data values 3582 !> will be read 3583 !> @param[in] id_count : number of indices selected along each dimension 3584 !> @param[in] id_type : variable type 3585 !> @param[in] td_dim : table of dimension structure 3586 !> @param[in] td_att : table of attribute structure 3587 !> @param[in] bd_fill : fill value 3588 !> @param[in] cd_units : units 3589 !> @param[in] cd_stdname : variable standard name 3590 !> @param[in] cd_longname : variable long name 3591 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3592 !> @param[in] id_id : variable id 3593 !> @param[in] id_ew : east west wrap 3594 !> @param[in] dd_scf : scale factor 3595 !> @param[in] dd_ofs : add offset 3596 !> @param[in] id_rec : record id (for rstdimg file) 3597 !> @param[in] dd_min : minimum value 3598 !> @param[in] dd_max : maximum value 3599 !> @param[in] ld_contiguous : use contiguous storage or not 3600 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3601 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3602 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3603 !> @param[in] id_chunksz : chunk size 3604 !------------------------------------------------------------------- 3605 !> @code 3938 !> - November, 2013- Initial Version 3939 ! 3940 !> @param[in] cd_name variable name 3941 !> @param[in] bd_value 1D array of integer(1) value 3942 !> @param[in] id_start index in the variable from which the 3943 !> data values will be read 3944 !> @param[in] id_count number of indices selected along 3945 !> each dimension 3946 !> @param[in] id_type variable type 3947 !> @param[in] td_dim array of dimension structure 3948 !> @param[in] td_att array of attribute structure 3949 !> @param[in] bd_fill fill value 3950 !> @param[in] cd_units units 3951 !> @param[in] cd_axis axis expected to be used 3952 !> @param[in] cd_stdname variable standard name 3953 !> @param[in] cd_longname variable long name 3954 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 3955 !> @param[in] id_id variable id 3956 !> @param[in] id_ew east west wrap 3957 !> @param[in] dd_scf scale factor 3958 !> @param[in] dd_ofs add offset 3959 !> @param[in] id_rec record id (for rstdimg file) 3960 !> @param[in] dd_min minimum value 3961 !> @param[in] dd_max maximum value 3962 !> @param[in] ld_contiguous use contiguous storage or not 3963 !> @param[in] ld_shuffle shuffle filter is turned on or not 3964 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 3965 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 3966 !> deflation is in use 3967 !> @param[in] id_chunksz chunk size 3968 !> @return variable structure 3969 !------------------------------------------------------------------- 3606 3970 TYPE(TVAR) FUNCTION var__init_1D_i1( cd_name, bd_value, & 3607 3971 & id_start, id_count, id_type, td_dim, & 3608 & td_att, bd_fill, cd_units, &3972 & td_att, bd_fill, cd_units, cd_axis,& 3609 3973 & cd_stdname, cd_longname, & 3610 3974 & cd_point, id_id, id_ew, & … … 3625 3989 INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill 3626 3990 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 3991 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3627 3992 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3628 3993 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3672 4037 & dd_fill=dl_fill, & 3673 4038 & cd_units=cd_units, & 4039 & cd_axis=cd_axis, & 3674 4040 & cd_stdname=cd_stdname, & 3675 4041 & cd_longname=cd_longname, & … … 3687 4053 3688 4054 END FUNCTION var__init_1D_i1 3689 !> @endcode 3690 !------------------------------------------------------------------- 3691 !> @brief This function initalise a variable structure. 3692 !> - integer(1) 2D table of value could be added. 3693 !> - dimension structure could be added. 3694 !> - attribute structure could be added 3695 ! 4055 !------------------------------------------------------------------- 4056 !> @brief This function initialize a variable structure, 4057 !> with a integer(1) 2D array of value. 3696 4058 !> @details 3697 !> table of 2 dimension structure is needed to put value in variable structure. 3698 !> If none is given, we assume table is ordered as ('x','y') and we 3699 !> use table size as lentgh dimension. 4059 !> optionally could be added:<br/> 4060 !> - dimension structure. 4061 !> - attribute structure. 4062 !> 4063 !> array of 2 dimension structure is needed to put value in variable structure. 4064 !> If none is given, we assume array is ordered as ('x','y') and we 4065 !> use array size as lentgh dimension. 3700 4066 !> 3701 4067 !> indices in the variable where value will be written could be specify if 3702 !> start and count tableare given. Dimension structure is needed in that4068 !> start and count array are given. Dimension structure is needed in that 3703 4069 !> case. 3704 4070 ! 3705 4071 !> @author J.Paul 3706 !> - Nov, 2013- Initial Version 3707 ! 3708 !> @param[in] cd_name : variable name 3709 !> @param[in] bd_value : 2D table of integer(1) value 3710 !> @param[in] id_start : index in the variable from which the data values 3711 !> will be read 3712 !> @param[in] id_count : number of indices selected along each dimension 3713 !> @param[in] id_type : variable type 3714 !> @param[in] td_dim : table of dimension structure 3715 !> @param[in] td_att : table of attribute structure 3716 !> @param[in] bd_fill : fill value 3717 !> @param[in] cd_units : units 3718 !> @param[in] cd_stdname : variable standard name 3719 !> @param[in] cd_longname : variable long name 3720 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3721 !> @param[in] id_id : variable id 3722 !> @param[in] id_ew : east west wrap 3723 !> @param[in] dd_scf : scale factor 3724 !> @param[in] dd_ofs : add offset 3725 !> @param[in] id_rec : record id (for rstdimg file) 3726 !> @param[in] dd_min : minimum value 3727 !> @param[in] dd_max : maximum value 3728 !> @param[in] ld_contiguous : use contiguous storage or not 3729 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3730 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3731 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3732 !> @param[in] id_chunksz : chunk size 3733 !------------------------------------------------------------------- 3734 !> @code 4072 !> - November, 2013- Initial Version 4073 ! 4074 !> @param[in] cd_name variable name 4075 !> @param[in] bd_value 2D array of integer(1) value 4076 !> @param[in] id_start index in the variable from which the 4077 !> data values will be read 4078 !> @param[in] id_count number of indices selected along 4079 !> each dimension 4080 !> @param[in] id_type variable type 4081 !> @param[in] td_dim array of dimension structure 4082 !> @param[in] td_att array of attribute structure 4083 !> @param[in] bd_fill fill value 4084 !> @param[in] cd_units units 4085 !> @param[in] cd_axis axis expected to be used 4086 !> @param[in] cd_stdname variable standard name 4087 !> @param[in] cd_longname variable long name 4088 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 4089 !> @param[in] id_id variable id 4090 !> @param[in] id_ew east west wrap 4091 !> @param[in] dd_scf scale factor 4092 !> @param[in] dd_ofs add offset 4093 !> @param[in] id_rec record id (for rstdimg file) 4094 !> @param[in] dd_min minimum value 4095 !> @param[in] dd_max maximum value 4096 !> @param[in] ld_contiguous use contiguous storage or not 4097 !> @param[in] ld_shuffle shuffle filter is turned on or not 4098 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 4099 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 4100 !> deflation is in use 4101 !> @param[in] id_chunksz chunk size 4102 !> @return variable structure 4103 !------------------------------------------------------------------- 3735 4104 TYPE(TVAR) FUNCTION var__init_2D_i1( cd_name, bd_value, & 3736 4105 & id_start, id_count, id_type, td_dim, & 3737 & td_att, bd_fill, cd_units, &4106 & td_att, bd_fill, cd_units, cd_axis,& 3738 4107 & cd_stdname, cd_longname, & 3739 4108 & cd_point, id_id, id_ew, & … … 3747 4116 CHARACTER(LEN=*), INTENT(IN) :: cd_name 3748 4117 INTEGER(i1) , DIMENSION(:,:) , INTENT(IN) :: bd_value 3749 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start3750 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count4118 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 4119 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 3751 4120 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 3752 4121 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 3754 4123 INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill 3755 4124 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 4125 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3756 4126 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3757 4127 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3803 4173 & dd_fill=dl_fill, & 3804 4174 & cd_units=cd_units, & 4175 & cd_axis=cd_axis, & 3805 4176 & cd_stdname=cd_stdname, & 3806 4177 & cd_longname=cd_longname, & … … 3818 4189 3819 4190 END FUNCTION var__init_2D_i1 3820 !> @endcode 3821 !------------------------------------------------------------------- 3822 !> @brief This function initalise a variable structure. 3823 !> - integer(1) 2D table of value could be added. 3824 !> - dimension structure could be added. 3825 !> - attribute structure could be added 3826 ! 4191 !------------------------------------------------------------------- 4192 !> @brief This function initialize a variable structure, 4193 !> with a integer(1) 3D array of value. 3827 4194 !> @details 3828 !> table of 2 dimension structure is needed to put value in variable structure. 3829 !> If none is given, we assume table is ordered as ('x','y') and we 3830 !> use table size as lentgh dimension. 4195 !> optionally could be added:<br/> 4196 !> - dimension structure. 4197 !> - attribute structure. 4198 !> 4199 !> array of 3 dimension structure is needed to put value in variable structure. 4200 !> If none is given, we assume array is ordered as ('x','y','z') and we 4201 !> use array size as lentgh dimension. 3831 4202 !> 3832 4203 !> indices in the variable where value will be written could be specify if 3833 !> start and count tableare given. Dimension structure is needed in that4204 !> start and count array are given. Dimension structure is needed in that 3834 4205 !> case. 3835 4206 ! 3836 4207 !> @author J.Paul 3837 !> - Nov, 2013- Initial Version 3838 ! 3839 !> @param[in] cd_name : variable name 3840 !> @param[in] bd_value : 2D table of integer(1) value 3841 !> @param[in] id_start : index in the variable from which the data values 3842 !> will be read 3843 !> @param[in] id_count : number of indices selected along each dimension 3844 !> @param[in] id_type : variable type 3845 !> @param[in] td_dim : table of dimension structure 3846 !> @param[in] td_att : table of attribute structure 3847 !> @param[in] bd_fill : fill value 3848 !> @param[in] cd_units : units 3849 !> @param[in] cd_stdname : variable standard name 3850 !> @param[in] cd_longname : variable long name 3851 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3852 !> @param[in] id_id : variable id 3853 !> @param[in] id_ew : east west wrap 3854 !> @param[in] dd_scf : scale factor 3855 !> @param[in] dd_ofs : add offset 3856 !> @param[in] id_rec : record id (for rstdimg file) 3857 !> @param[in] dd_min : minimum value 3858 !> @param[in] dd_max : maximum value 3859 !> @param[in] ld_contiguous : use contiguous storage or not 3860 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3861 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3862 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3863 !> @param[in] id_chunksz : chunk size 3864 !------------------------------------------------------------------- 3865 !> @code 4208 !> - November, 2013- Initial Version 4209 ! 4210 !> @param[in] cd_name variable name 4211 !> @param[in] bd_value 3D array of integer(1) value 4212 !> @param[in] id_start index in the variable from which the 4213 !> data values will be read 4214 !> @param[in] id_count number of indices selected along 4215 !> each dimension 4216 !> @param[in] id_type variable type 4217 !> @param[in] td_dim array of dimension structure 4218 !> @param[in] td_att array of attribute structure 4219 !> @param[in] bd_fill fill value 4220 !> @param[in] cd_units units 4221 !> @param[in] cd_axis axis expected to be used 4222 !> @param[in] cd_stdname variable standard name 4223 !> @param[in] cd_longname variable long name 4224 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 4225 !> @param[in] id_id variable id 4226 !> @param[in] id_ew east west wrap 4227 !> @param[in] dd_scf scale factor 4228 !> @param[in] dd_ofs add offset 4229 !> @param[in] id_rec record id (for rstdimg file) 4230 !> @param[in] dd_min minimum value 4231 !> @param[in] dd_max maximum value 4232 !> @param[in] ld_contiguous use contiguous storage or not 4233 !> @param[in] ld_shuffle shuffle filter is turned on or not 4234 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 4235 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 4236 !> deflation is in use 4237 !> @param[in] id_chunksz chunk size 4238 !> @return variable structure 4239 !------------------------------------------------------------------- 3866 4240 TYPE(TVAR) FUNCTION var__init_3D_i1( cd_name, bd_value, & 3867 4241 & id_start, id_count, id_type, td_dim, & 3868 & td_att, bd_fill, cd_units, &4242 & td_att, bd_fill, cd_units, cd_axis,& 3869 4243 & cd_stdname, cd_longname, & 3870 4244 & cd_point, id_id, id_ew, & … … 3878 4252 CHARACTER(LEN=*), INTENT(IN) :: cd_name 3879 4253 INTEGER(i1) , DIMENSION(:,:,:) , INTENT(IN) :: bd_value 3880 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start3881 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count4254 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start 4255 INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count 3882 4256 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 3883 4257 TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim … … 3885 4259 INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill 3886 4260 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 4261 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 3887 4262 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 3888 4263 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 3935 4310 & dd_fill=dl_fill, & 3936 4311 & cd_units=cd_units, & 4312 & cd_axis=cd_axis, & 3937 4313 & cd_stdname=cd_stdname, & 3938 4314 & cd_longname=cd_longname, & … … 3950 4326 3951 4327 END FUNCTION var__init_3D_i1 3952 !> @endcode 3953 !------------------------------------------------------------------- 3954 !> @brief This function initalise a variable structure. 3955 !> - integer(1) 4D table of value could be added. 3956 !> - dimension structure could be added. 3957 !> - attribute structure could be added 3958 ! 4328 !------------------------------------------------------------------- 4329 !> @brief This function initialize a variable structure, 4330 !> with a integer(1) 4D array of value. 3959 4331 !> @details 4332 !> optionally could be added:<br/> 4333 !> - dimension structure. 4334 !> - attribute structure. 4335 !> 3960 4336 !> Dimension structure is needed to put value in variable structure. 3961 !> If none is given, we assume tableis ordered as ('x','y','z','t') and we3962 !> use tablesize as lentgh dimension.4337 !> If none is given, we assume array is ordered as ('x','y','z','t') and we 4338 !> use array size as lentgh dimension. 3963 4339 !> 3964 4340 !> indices in the variable where value will be written could be specify if 3965 !> start and count tableare given. Dimension structure is needed in that3966 !> case. 4341 !> start and count array are given. Dimension structure is needed in that 4342 !> case. 3967 4343 ! 3968 4344 !> @author J.Paul 3969 !> - Nov, 2013- Initial Version 3970 ! 3971 !> @param[in] cd_name : variable name 3972 !> @param[in] bd_value : 4D table of integer(1) value 3973 !> @param[in] id_start : index in the variable from which the data values 3974 !> will be read 3975 !> @param[in] id_count : number of indices selected along each dimension 3976 !> @param[in] id_type : variable type 3977 !> @param[in] td_dim : table of dimension structure 3978 !> @param[in] td_att : table of attribute structure 3979 !> @param[in] bd_fill : fill value 3980 !> @param[in] cd_units : units 3981 !> @param[in] cd_stdname : variable standard name 3982 !> @param[in] cd_longname : variable long name 3983 !> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F) 3984 !> @param[in] id_id : variable id 3985 !> @param[in] id_ew : east west wrap 3986 !> @param[in] dd_scf : scale factor 3987 !> @param[in] dd_ofs : add offset 3988 !> @param[in] id_rec : record id (for rstdimg file) 3989 !> @param[in] dd_min : minimum value 3990 !> @param[in] dd_max : maximum value 3991 !> @param[in] ld_contiguous : use contiguous storage or not 3992 !> @param[in] ld_shuffle : shuffle filter is turned on or not 3993 !> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not 3994 !> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use 3995 !> @param[in] id_chunksz : chunk size 3996 !------------------------------------------------------------------- 3997 !> @code 4345 !> - November, 2013- Initial Version 4346 ! 4347 !> @param[in] cd_name variable name 4348 !> @param[in] bd_value 4D array of integer(1) value 4349 !> @param[in] id_start index in the variable from which the 4350 !> data values will be read 4351 !> @param[in] id_count number of indices selected along 4352 !> each dimension 4353 !> @param[in] id_type variable type 4354 !> @param[in] td_dim array of dimension structure 4355 !> @param[in] td_att array of attribute structure 4356 !> @param[in] bd_fill fill value 4357 !> @param[in] cd_units units 4358 !> @param[in] cd_axis axis expected to be used 4359 !> @param[in] cd_stdname variable standard name 4360 !> @param[in] cd_longname variable long name 4361 !> @param[in] cd_point point on Arakawa-C grid (T,U,V,F) 4362 !> @param[in] id_id variable id 4363 !> @param[in] id_ew east west wrap 4364 !> @param[in] dd_scf scale factor 4365 !> @param[in] dd_ofs add offset 4366 !> @param[in] id_rec record id (for rstdimg file) 4367 !> @param[in] dd_min minimum value 4368 !> @param[in] dd_max maximum value 4369 !> @param[in] ld_contiguous use contiguous storage or not 4370 !> @param[in] ld_shuffle shuffle filter is turned on or not 4371 !> @param[in] ld_fletcher32 fletcher32 filter is turned on or not 4372 !> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no 4373 !> deflation is in use 4374 !> @param[in] id_chunksz chunk size 4375 !> @return variable structure 4376 !------------------------------------------------------------------- 3998 4377 TYPE(TVAR) FUNCTION var__init_i1( cd_name, bd_value, & 3999 4378 & id_start, id_count, id_type, td_dim, & 4000 & td_att, bd_fill, cd_units, &4379 & td_att, bd_fill, cd_units, cd_axis,& 4001 4380 & cd_stdname, cd_longname, & 4002 4381 & cd_point, id_id, id_ew, & … … 4017 4396 INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill 4018 4397 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units 4398 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis 4019 4399 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 4020 4400 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname … … 4068 4448 & dd_fill=dl_fill, & 4069 4449 & cd_units=cd_units, & 4450 & cd_axis=cd_axis, & 4070 4451 & cd_stdname=cd_stdname, & 4071 4452 & cd_longname=cd_longname, & … … 4082 4463 DEALLOCATE( dl_value ) 4083 4464 4084 ! ! add value4085 ! IF( .NOT. PRESENT(td_dim) )THEN4086 ! il_shape(:)=SHAPE(bd_value(:,:,:,:))4087 ! DO ji=1,ip_maxdim4088 ! tl_dim=dim_init( cp_dimorder(ji:ji), id_len=il_shape(ji))4089 ! CALL var_add_dim(var__init_i1, tl_dim)4090 ! ENDDO4091 ! ENDIF4092 ! CALL var_add_value(var__init_i1, bd_value(:,:,:,:), &4093 ! & id_start(:), id_count(:))4094 4095 4465 END FUNCTION var__init_i1 4096 !> @endcode4097 4466 !------------------------------------------------------------------- 4098 4467 !> @brief This function concatenate variable value following DIM direction. … … 4101 4470 !> By default variable are concatenate following time dimension. To 4102 4471 !> concatenate following another dimension, specify DIM=x where x is the 4103 !> dimension number ( 1,2,3,4)4472 !> dimension number (jp_I, jp_J,jp_K, jp_L). 4104 4473 !> 4105 4474 !> @author J.Paul 4106 !> - Nov , 2013- Initial Version4107 ! 4108 !> @param[in] td_var1 :variable structure4109 !> @param[in] td_var2 :variable structure4110 !> @param[in] DIM : dimension following which concatenate4111 ! -------------------------------------------------------------------4112 ! > @code4475 !> - November, 2013- Initial Version 4476 ! 4477 !> @param[in] td_var1 variable structure 4478 !> @param[in] td_var2 variable structure 4479 !> @param[in] DIM dimension following which concatenate 4480 !> @return variable structure 4481 !------------------------------------------------------------------- 4113 4482 FUNCTION var_concat(td_var1, td_var2, DIM) 4114 4483 IMPLICIT NONE … … 4125 4494 !---------------------------------------------------------------- 4126 4495 il_dim=4 4127 IF( PRESENT(DIM) ) il_dim=DIM4496 IF( PRESENT(DIM) ) il_dim=DIM 4128 4497 4129 4498 IF( .NOT. ASSOCIATED(td_var1%d_value) )THEN … … 4138 4507 ! check other dimension 4139 4508 SELECT CASE(il_dim) 4140 CASE( 1)4509 CASE(jp_I) 4141 4510 var_concat=var__concat_i(td_var1, td_var2) 4142 CASE( 2)4511 CASE(jp_J) 4143 4512 var_concat=var__concat_j(td_var1, td_var2) 4144 CASE( 3)4513 CASE(jp_K) 4145 4514 var_concat=var__concat_k(td_var1, td_var2) 4146 CASE( 4)4515 CASE(jp_L) 4147 4516 var_concat=var__concat_l(td_var1, td_var2) 4148 4517 END SELECT 4149 4150 4518 ENDIF 4151 4519 4152 4520 END FUNCTION var_concat 4153 !> @endcode4154 4521 !------------------------------------------------------------------- 4155 4522 !> @brief This function concatenate variable value following i-direction. 4156 4523 !> 4157 4524 !> @author J.Paul 4158 !> - Nov , 2013- Initial Version4159 ! 4160 !> @param[in] td_var1 :variable structure4161 !> @param[in] td_var2 :variable structure4162 ! -------------------------------------------------------------------4163 ! > @code4525 !> - November, 2013- Initial Version 4526 ! 4527 !> @param[in] td_var1 variable structure 4528 !> @param[in] td_var2 variable structure 4529 !> @return variable structure 4530 !------------------------------------------------------------------- 4164 4531 FUNCTION var__concat_i(td_var1, td_var2) 4165 4532 IMPLICIT NONE … … 4176 4543 4177 4544 !---------------------------------------------------------------- 4178 IF( ANY(td_var1%t_dim(2:4)%i_len /= td_var2%t_dim(2:4)%i_len) )THEN 4179 CALL logger_error("VAR CONCAT: dimension not conform") 4545 IF( .NOT. td_var1%t_dim(1)%l_use .OR. & 4546 & .NOT. td_var1%t_dim(1)%l_use )THEN 4547 CALL logger_error("VAR CONCAT: can not concatenate variable "//& 4548 & TRIM(td_var1%c_name)//" on an unused dimension I") 4549 ELSEIF( ANY(td_var1%t_dim(2:4)%i_len /= td_var2%t_dim(2:4)%i_len) )THEN 4180 4550 4181 4551 cl_tmp='('//":"//","//& … … 4191 4561 CALL logger_debug("VAR CONCAT: second variable dimensions "//& 4192 4562 & TRIM(cl_tmp) ) 4563 4564 CALL logger_error("VAR CONCAT: dimension not conform") 4193 4565 ELSE 4194 tl_var= td_var14566 tl_var=var_copy(td_var1) 4195 4567 4196 4568 DEALLOCATE(tl_var%d_value) … … 4212 4584 4213 4585 ! save result 4214 var__concat_i=tl_var 4215 4586 var__concat_i=var_copy(tl_var) 4587 4588 ! clean 4216 4589 CALL var_clean(tl_var) 4217 4590 ENDIF 4218 4591 4219 4592 END FUNCTION var__concat_i 4220 !> @endcode4221 4593 !------------------------------------------------------------------- 4222 4594 !> @brief This function concatenate variable value following j-direction. 4223 4595 !> 4224 4596 !> @author J.Paul 4225 !> - Nov , 2013- Initial Version4226 ! 4227 !> @param[in] td_var1 :variable structure4228 !> @param[in] td_var2 :variable structure4229 ! -------------------------------------------------------------------4230 ! > @code4597 !> - November, 2013- Initial Version 4598 ! 4599 !> @param[in] td_var1 variable structure 4600 !> @param[in] td_var2 variable structure 4601 !> @return variable structure 4602 !------------------------------------------------------------------- 4231 4603 FUNCTION var__concat_j(td_var1, td_var2) 4232 4604 IMPLICIT NONE … … 4243 4615 4244 4616 !---------------------------------------------------------------- 4245 IF( td_var1%t_dim(1)%i_len /= td_var2%t_dim(1)%i_len .OR. & 4617 IF( .NOT. td_var1%t_dim(2)%l_use .OR. & 4618 & .NOT. td_var1%t_dim(2)%l_use )THEN 4619 CALL logger_error("VAR CONCAT: can not concatenate variable "//& 4620 & TRIM(td_var1%c_name)//" on an unused dimension J") 4621 ELSEIF( td_var1%t_dim(1)%i_len /= td_var2%t_dim(1)%i_len .OR. & 4246 4622 & ANY(td_var1%t_dim(3:4)%i_len /= td_var2%t_dim(3:4)%i_len) )THEN 4247 CALL logger_error("VAR CONCAT: dimension not conform")4248 4623 4249 4624 cl_tmp='('//& … … 4261 4636 CALL logger_debug("VAR CONCAT: second variable dimensions "//& 4262 4637 & TRIM(cl_tmp) ) 4638 4639 CALL logger_error("VAR CONCAT: dimension not conform") 4263 4640 ELSE 4264 tl_var= td_var14641 tl_var=var_copy(td_var1) 4265 4642 4266 4643 DEALLOCATE(tl_var%d_value) … … 4282 4659 4283 4660 ! save result 4284 var__concat_j=tl_var 4285 4661 var__concat_j=var_copy(tl_var) 4662 4663 ! clean 4286 4664 CALL var_clean(tl_var) 4287 4665 ENDIF 4288 4666 4289 4667 END FUNCTION var__concat_j 4290 !> @endcode4291 4668 !------------------------------------------------------------------- 4292 4669 !> @brief This function concatenate variable value following k-direction. 4293 4670 !> 4294 4671 !> @author J.Paul 4295 !> - Nov , 2013- Initial Version4296 ! 4297 !> @param[in] td_var1 :variable structure4298 !> @param[in] td_var2 :variable structure4299 ! -------------------------------------------------------------------4300 ! > @code4672 !> - November, 2013- Initial Version 4673 ! 4674 !> @param[in] td_var1 variable structure 4675 !> @param[in] td_var2 variable structure 4676 !> @return variable structure 4677 !------------------------------------------------------------------- 4301 4678 FUNCTION var__concat_k(td_var1, td_var2) 4302 4679 IMPLICIT NONE … … 4313 4690 4314 4691 !---------------------------------------------------------------- 4315 IF( td_var1%t_dim(4)%i_len /= td_var2%t_dim(4)%i_len .OR. & 4692 IF( .NOT. td_var1%t_dim(3)%l_use .OR. & 4693 & .NOT. td_var1%t_dim(3)%l_use )THEN 4694 CALL logger_error("VAR CONCAT: can not concatenate variable "//& 4695 & TRIM(td_var1%c_name)//" on an unused dimension K") 4696 ELSEIF( td_var1%t_dim(4)%i_len /= td_var2%t_dim(4)%i_len .OR. & 4316 4697 & ANY(td_var1%t_dim(1:2)%i_len /= td_var2%t_dim(1:2)%i_len) )THEN 4317 CALL logger_error("VAR CONCAT: dimension not conform")4318 4698 4319 4699 cl_tmp='('//& … … 4331 4711 CALL logger_debug("VAR CONCAT: second variable dimensions "//& 4332 4712 & TRIM(cl_tmp) ) 4713 4714 CALL logger_error("VAR CONCAT: dimension not conform") 4333 4715 ELSE 4334 tl_var= td_var14716 tl_var=var_copy(td_var1) 4335 4717 4336 4718 DEALLOCATE(tl_var%d_value) … … 4352 4734 4353 4735 ! save result 4354 var__concat_k=tl_var 4355 4736 var__concat_k=var_copy(tl_var) 4737 4738 ! clean 4356 4739 CALL var_clean(tl_var) 4357 4740 ENDIF 4358 4741 4359 4742 END FUNCTION var__concat_k 4360 !> @endcode4361 4743 !------------------------------------------------------------------- 4362 4744 !> @brief This function concatenate variable value following l-direction. 4363 4745 !> 4364 4746 !> @author J.Paul 4365 !> - Nov , 2013- Initial Version4366 ! 4367 !> @param[in] td_var1 :variable structure4368 !> @param[in] td_var2 :variable structure4369 ! -------------------------------------------------------------------4370 ! > @code4747 !> - November, 2013- Initial Version 4748 ! 4749 !> @param[in] td_var1 variable structure 4750 !> @param[in] td_var2 variable structure 4751 !> @return variable structure 4752 !------------------------------------------------------------------- 4371 4753 FUNCTION var__concat_l(td_var1, td_var2) 4372 4754 IMPLICIT NONE … … 4383 4765 4384 4766 !---------------------------------------------------------------- 4385 IF( ANY(td_var1%t_dim(1:3)%i_len /= td_var2%t_dim(1:3)%i_len) )THEN 4386 CALL logger_error("VAR CONCAT: dimension not conform") 4767 IF( .NOT. td_var1%t_dim(4)%l_use .OR. & 4768 & .NOT. td_var1%t_dim(4)%l_use )THEN 4769 CALL logger_error("VAR CONCAT: can not concatenate variable "//& 4770 & TRIM(td_var1%c_name)//" on an unused dimension L") 4771 ELSEIF( ANY(td_var1%t_dim(1:3)%i_len /= td_var2%t_dim(1:3)%i_len) )THEN 4387 4772 4388 4773 cl_tmp='('//& … … 4400 4785 CALL logger_debug("VAR CONCAT: second variable dimensions "//& 4401 4786 & TRIM(cl_tmp) ) 4787 4788 CALL logger_error("VAR CONCAT: dimension not conform") 4402 4789 ELSE 4403 tl_var= td_var14790 tl_var=var_copy(td_var1) 4404 4791 4405 4792 DEALLOCATE(tl_var%d_value) … … 4421 4808 4422 4809 ! save result 4423 var__concat_l=tl_var 4424 4810 var__concat_l=var_copy(tl_var) 4811 4812 ! clean 4425 4813 CALL var_clean(tl_var) 4426 4814 ENDIF 4427 4815 4428 4816 END FUNCTION var__concat_l 4429 !> @endcode 4430 !------------------------------------------------------------------- 4431 !> @brief This subroutine add a table of attribute structure 4817 !------------------------------------------------------------------- 4818 !> @brief This subroutine add an array of attribute structure 4432 4819 !> in a variable structure. 4433 ! 4820 !> 4434 4821 !> @author J.Paul 4435 !> - Nov, 2013- Initial Version 4436 ! 4437 !> @param[inout] td_var : variable structure 4438 !> @param[in] td_att : table of attribute structure 4439 !------------------------------------------------------------------- 4440 !> @code 4441 SUBROUTINE var__add_att_tab(td_var, td_att) 4822 !> - November, 2013- Initial Version 4823 !> 4824 !> @param[inout] td_var variable structure 4825 !> @param[in] td_att array of attribute structure 4826 !------------------------------------------------------------------- 4827 SUBROUTINE var__add_att_arr(td_var, td_att) 4442 4828 IMPLICIT NONE 4443 4829 ! Argument … … 4458 4844 ENDDO 4459 4845 4460 END SUBROUTINE var__add_att_tab 4461 !> @endcode 4846 END SUBROUTINE var__add_att_arr 4462 4847 !------------------------------------------------------------------- 4463 4848 !> @brief This subroutine add an attribute structure 4464 4849 !> in a variable structure. 4465 4850 ! 4466 !> @details4467 !4468 4851 !> @author J.Paul 4469 !> - Nov, 2013- Initial Version 4470 ! 4471 !> @param[inout] td_var : variable structure 4472 !> @param[in] td_att : attribute structure 4473 !------------------------------------------------------------------- 4474 !> @code 4852 !> - November, 2013- Initial Version 4853 ! 4854 !> @param[inout] td_var variable structure 4855 !> @param[in] td_att attribute structure 4856 !------------------------------------------------------------------- 4475 4857 SUBROUTINE var__add_att_unit(td_var, td_att) 4476 4858 IMPLICIT NONE … … 4481 4863 ! local variable 4482 4864 INTEGER(i4) :: il_status 4483 INTEGER(i4) :: il_ attid4865 INTEGER(i4) :: il_ind 4484 4866 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 4485 4867 … … 4489 4871 4490 4872 ! check if attribute already in variable structure 4491 il_ attid=04873 il_ind=0 4492 4874 IF( ASSOCIATED(td_var%t_att) )THEN 4493 il_ attid=att_get_id( td_var%t_att(:), td_att%c_name )4494 ENDIF 4495 4496 IF( il_ attid /= 0 )THEN4875 il_ind=att_get_index( td_var%t_att(:), td_att%c_name ) 4876 ENDIF 4877 4878 IF( il_ind /= 0 )THEN 4497 4879 4498 4880 CALL logger_error( & 4499 & " ADD ATT: attribute "//TRIM(td_att%c_name)//&4881 & " VAR ADD ATT: attribute "//TRIM(td_att%c_name)//& 4500 4882 & ", already in variable "//TRIM(td_var%c_name) ) 4501 4883 4502 4884 DO ji=1,td_var%i_natt 4503 4885 CALL logger_debug( & 4504 & " ADD ATT: in variable "//TRIM(td_var%t_att(ji)%c_name) )4886 & " VAR ADD ATT: in variable "//TRIM(td_var%t_att(ji)%c_name) ) 4505 4887 ENDDO 4506 4888 4507 4889 ELSE 4508 4890 4509 CALL logger_ debug( &4510 & " ADD ATT: add attribute "//TRIM(td_att%c_name)//&4891 CALL logger_trace( & 4892 & " VAR ADD ATT: add attribute "//TRIM(td_att%c_name)//& 4511 4893 & ", in variable "//TRIM(td_var%c_name) ) 4512 4894 … … 4517 4899 4518 4900 CALL logger_error( & 4519 & " ADD ATT: not enough space to put attributes from "//&4901 & " VAR ADD ATT: not enough space to put attributes from "//& 4520 4902 & TRIM(td_var%c_name)//" in temporary attribute structure") 4521 4903 … … 4523 4905 4524 4906 ! save temporary global attribute's variable structure 4525 tl_att(:)=td_var%t_att(:) 4526 4907 tl_att(:)=att_copy(td_var%t_att(:)) 4908 4909 CALL att_clean(td_var%t_att(:)) 4527 4910 DEALLOCATE( td_var%t_att ) 4528 4911 ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status ) … … 4530 4913 4531 4914 CALL logger_error( & 4532 & " ADD ATT: not enough space to put attributes "//&4915 & " VAR ADD ATT: not enough space to put attributes "//& 4533 4916 & "in variable structure "//TRIM(td_var%c_name) ) 4534 4917 … … 4536 4919 4537 4920 ! copy attribute in variable before 4538 td_var%t_att(1:td_var%i_natt)=tl_att(:) 4539 4921 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 4922 4923 ! clean 4924 CALL att_clean(tl_att(:)) 4540 4925 DEALLOCATE(tl_att) 4541 4926 … … 4544 4929 ! no attribute in variable structure 4545 4930 IF( ASSOCIATED(td_var%t_att) )THEN 4931 CALL att_clean(td_var%t_att(:)) 4546 4932 DEALLOCATE(td_var%t_att) 4547 4933 ENDIF … … 4550 4936 4551 4937 CALL logger_error( & 4552 & " ADD ATT: not enough space to put attributes "//&4938 & " VAR ADD ATT: not enough space to put attributes "//& 4553 4939 & "in variable structure "//TRIM(td_var%c_name) ) 4554 4940 … … 4558 4944 td_var%i_natt=td_var%i_natt+1 4559 4945 4560 ! add new attributes 4561 td_var%t_att(td_var%i_natt)=td_att 4562 4563 ! change attribute id 4564 DO ji=1,td_var%i_natt 4565 td_var%t_att(ji)%i_id=ji 4566 ENDDO 4946 ! add new attribute 4947 td_var%t_att(td_var%i_natt)=att_copy(td_att) 4948 4949 !! add new attribute id 4950 !td_var%t_att(td_var%i_natt)%i_id=att_get_unit(td_var%t_att(:)) 4567 4951 4568 4952 ! highlight some attribute … … 4577 4961 CASE("_FillValue") 4578 4962 td_var%d_fill = td_var%t_att(td_var%i_natt)%d_value(1) 4963 CASE("ew_overlap") 4964 td_var%i_ew = INT(td_var%t_att(td_var%i_natt)%d_value(1),i4) 4579 4965 CASE("standard_name") 4580 4966 td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4967 CASE("long_name") 4968 td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4581 4969 CASE("units") 4582 4970 td_var%c_units = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4971 CASE("grid_point") 4972 td_var%c_point = TRIM(td_var%t_att(td_var%i_natt)%c_value) 4583 4973 4584 4974 END SELECT … … 4587 4977 4588 4978 END SUBROUTINE var__add_att_unit 4589 !> @endcode4590 4979 !------------------------------------------------------------------- 4591 4980 !> @brief This subroutine delete an attribute 4592 4981 !> from variable structure. 4593 4982 ! 4594 !> @details4595 !4596 4983 !> @author J.Paul 4597 !> - Nov, 2013- Initial Version 4598 ! 4599 !> @param[inout] td_var : variable structure 4600 !> @param[in] td_att : attribute structure 4601 !------------------------------------------------------------------- 4602 !> @code 4603 SUBROUTINE var_del_att(td_var, td_att) 4984 !> - November, 2013- Initial Version 4985 ! 4986 !> @param[inout] td_var variable structure 4987 !> @param[in] cd_name attribute name 4988 !------------------------------------------------------------------- 4989 SUBROUTINE var__del_att_name(td_var, cd_name) 4990 IMPLICIT NONE 4991 ! Argument 4992 TYPE(TVAR) , INTENT(INOUT) :: td_var 4993 CHARACTER(LEN=*), INTENT(IN ) :: cd_name 4994 4995 ! local variable 4996 INTEGER(i4) :: il_ind 4997 4998 ! loop indices 4999 !---------------------------------------------------------------- 5000 5001 ! check if attribute already in variable structure 5002 il_ind=0 5003 IF( ASSOCIATED(td_var%t_att) )THEN 5004 il_ind=att_get_index( td_var%t_att(:), TRIM(cd_name) ) 5005 ENDIF 5006 5007 IF( il_ind == 0 )THEN 5008 5009 CALL logger_warn( & 5010 & " VAR DEL ATT: no attribute "//TRIM(cd_name)//& 5011 & ", in variable "//TRIM(td_var%c_name) ) 5012 5013 ELSE 5014 5015 CALL var_del_att(td_var, td_var%t_att(il_ind)) 5016 5017 ENDIF 5018 5019 END SUBROUTINE var__del_att_name 5020 !------------------------------------------------------------------- 5021 !> @brief This subroutine delete an attribute 5022 !> from variable structure. 5023 ! 5024 !> @author J.Paul 5025 !> - November, 2013- Initial Version 5026 ! 5027 !> @param[inout] td_var variable structure 5028 !> @param[in] td_att attribute structure 5029 !------------------------------------------------------------------- 5030 SUBROUTINE var__del_att_str(td_var, td_att) 4604 5031 IMPLICIT NONE 4605 5032 ! Argument … … 4609 5036 ! local variable 4610 5037 INTEGER(i4) :: il_status 4611 INTEGER(i4) :: il_ attid5038 INTEGER(i4) :: il_ind 4612 5039 TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 4613 5040 4614 5041 ! loop indices 4615 INTEGER(i4) :: ji5042 !INTEGER(i4) :: ji 4616 5043 !---------------------------------------------------------------- 4617 5044 4618 5045 ! check if attribute already in variable structure 4619 il_ attid=05046 il_ind=0 4620 5047 IF( ASSOCIATED(td_var%t_att) )THEN 4621 il_ attid=att_get_id( td_var%t_att(:), td_att%c_name )4622 ENDIF 4623 4624 IF( il_ attid == 0 )THEN5048 il_ind=att_get_index( td_var%t_att(:), td_att%c_name ) 5049 ENDIF 5050 5051 IF( il_ind == 0 )THEN 4625 5052 4626 5053 CALL logger_warn( & 4627 & " DEL ATT: no attribute "//TRIM(td_att%c_name)//&5054 & " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//& 4628 5055 & ", in variable "//TRIM(td_var%c_name) ) 4629 5056 4630 5057 ELSE 4631 5058 4632 CALL logger_ debug( &4633 & " DEL ATT: del attribute "//TRIM(td_att%c_name)//&5059 CALL logger_trace( & 5060 & " VAR DEL ATT: del attribute "//TRIM(td_att%c_name)//& 4634 5061 & ", in var "//TRIM(td_var%c_name) ) 4635 5062 4636 5063 IF( td_var%i_natt == 1 )THEN 4637 5064 5065 CALL att_clean(td_var%t_att(:)) 4638 5066 DEALLOCATE(td_var%t_att) 4639 5067 … … 4646 5074 4647 5075 CALL logger_error( & 4648 & " ADD ATT: not enough space to put attributes from "//&5076 & " VAR ADD ATT: not enough space to put attributes from "//& 4649 5077 & TRIM(td_var%c_name)//" in temporary attribute structure") 4650 5078 … … 4652 5080 4653 5081 ! save temporary global attribute's variable structure 4654 tl_att(1:il_ attid-1)=td_var%t_att(1:il_attid-1)4655 IF( il_ attid < td_var%i_natt )THEN4656 tl_att(il_ attid:)=td_var%t_att(il_attid+1:)5082 tl_att(1:il_ind-1)=att_copy(td_var%t_att(1:il_ind-1)) 5083 IF( il_ind < td_var%i_natt )THEN 5084 tl_att(il_ind:)=att_copy(td_var%t_att(il_ind+1:)) 4657 5085 ENDIF 4658 5086 5087 CALL att_clean(td_var%t_att(:)) 4659 5088 DEALLOCATE( td_var%t_att ) 4660 5089 … … 4666 5095 4667 5096 CALL logger_error( & 4668 & " ADD ATT: not enough space to put attributes "//&5097 & " VAR ADD ATT: not enough space to put attributes "//& 4669 5098 & "in variable structure "//TRIM(td_var%c_name) ) 4670 5099 … … 4672 5101 4673 5102 ! copy attribute in variable before 4674 td_var%t_att(1:td_var%i_natt)=tl_att(:) 4675 4676 ! change attribute id 4677 DO ji=1,td_var%i_natt 4678 td_var%t_att(ji)%i_id=ji 4679 ENDDO 4680 5103 td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:)) 5104 5105 !! change attribute id 5106 !DO ji=1,td_var%i_natt 5107 ! td_var%t_att(ji)%i_id=ji 5108 !ENDDO 5109 5110 ! clean 5111 CALL att_clean(tl_att(:)) 4681 5112 DEALLOCATE(tl_att) 4682 5113 ENDIF … … 4684 5115 ENDIF 4685 5116 4686 END SUBROUTINE var_del_att 4687 !> @endcode 4688 !------------------------------------------------------------------- 4689 !> @brief This subroutine move a global attribute structure 5117 END SUBROUTINE var__del_att_str 5118 !------------------------------------------------------------------- 5119 !> @brief This subroutine move an attribute structure 4690 5120 !> from variable structure. 4691 5121 ! 4692 !> @details4693 !4694 5122 !> @author J.Paul 4695 !> - Nov, 2013- Initial Version 4696 ! 4697 !> @param[inout] td_var : variable structure 4698 !> @param[in] td_att : attribute structure 4699 !> @todo 4700 !------------------------------------------------------------------- 4701 !> @code 5123 !> - November, 2013- Initial Version 5124 ! 5125 !> @param[inout] td_var variable structure 5126 !> @param[in] td_att attribute structure 5127 !------------------------------------------------------------------- 4702 5128 SUBROUTINE var_move_att(td_var, td_att) 4703 5129 IMPLICIT NONE … … 4711 5137 !---------------------------------------------------------------- 4712 5138 ! copy attribute 4713 tl_att= td_att5139 tl_att=att_copy(td_att) 4714 5140 4715 5141 ! remove attribute with same name … … 4719 5145 CALL var_add_att(td_var, tl_att) 4720 5146 5147 ! clean 5148 CALL att_clean(tl_att) 5149 4721 5150 END SUBROUTINE var_move_att 4722 !> @endcode 4723 !------------------------------------------------------------------- 4724 !> @brief This subroutine add a table of dimension structure in a variable 5151 !------------------------------------------------------------------- 5152 !> @brief This subroutine add an array of dimension structure in a variable 4725 5153 !> structure. 4726 5154 !> - number of dimension in variable can't be greater than 4 … … 4728 5156 ! 4729 5157 !> @author J.Paul 4730 !> - Nov, 2013- Initial Version 4731 ! 4732 !> @param[inout] td_var : variable structure 4733 !> @param[in] td_dim : dimension structure 4734 ! 4735 !> @todo 4736 !------------------------------------------------------------------- 4737 !> @code 4738 SUBROUTINE var__add_dim_tab(td_var, td_dim) 5158 !> - November, 2013- Initial Version 5159 ! 5160 !> @param[inout] td_var variable structure 5161 !> @param[in] td_dim dimension structure 5162 !------------------------------------------------------------------- 5163 SUBROUTINE var__add_dim_arr(td_var, td_dim) 4739 5164 IMPLICIT NONE 4740 5165 ! Argument … … 4749 5174 !---------------------------------------------------------------- 4750 5175 il_ndim=SIZE(td_dim(:)) 4751 IF( il_ndim <= 4)THEN5176 IF( il_ndim <= ip_maxdim )THEN 4752 5177 4753 5178 DO ji=1,il_ndim … … 4757 5182 ELSE 4758 5183 CALL logger_error( & 4759 & " ADD DIM: too much dimension to put in structure "//&5184 & " VAR ADD DIM: too much dimension to put in structure "//& 4760 5185 & "("//TRIM(fct_str(il_ndim))//")" ) 4761 5186 ENDIF 4762 5187 4763 END SUBROUTINE var__add_dim_tab 4764 !> @endcode 5188 END SUBROUTINE var__add_dim_arr 4765 5189 !------------------------------------------------------------------- 4766 5190 !> @brief This subroutine add one dimension in a variable 4767 !> structure, after some check. 5191 !> structure. 5192 !> @details 4768 5193 !> - number of dimension in variable can't be greater than 4 4769 5194 !> - dimension can't be already uses in variable structure 4770 5195 ! 4771 5196 !> @author J.Paul 4772 !> - Nov, 2013- Initial Version 4773 ! 4774 !> @param[inout] td_var : variable structure 4775 !> @param[in] td_dim : dimension structure 4776 ! 4777 !> @todo 4778 !------------------------------------------------------------------- 4779 !> @code 4780 SUBROUTINE var__add_dim_unit(td_var, td_dim) 5197 !> - November, 2013- Initial Version 5198 ! 5199 !> @param[inout] td_var variable structure 5200 !> @param[in] td_dim dimension structure 5201 !------------------------------------------------------------------- 5202 SUBROUTINE var__add_dim_unit(td_var, td_dim) 4781 5203 IMPLICIT NONE 4782 5204 ! Argument 4783 TYPE(TVAR) , INTENT(INOUT) :: td_var4784 TYPE(TDIM) , INTENT(IN) :: td_dim5205 TYPE(TVAR) , INTENT(INOUT) :: td_var 5206 TYPE(TDIM) , INTENT(IN ) :: td_dim 4785 5207 4786 5208 ! local variable 5209 INTEGER(i4) :: il_ind 5210 5211 !---------------------------------------------------------------- 5212 5213 IF( td_var%i_ndim <= 4 )THEN 5214 5215 ! check if dimension already used in variable structure 5216 il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 5217 IF( il_ind == 0 )THEN 5218 CALL logger_warn( & 5219 & " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//& 5220 & ", short name "//TRIM(td_dim%c_sname)//& 5221 & ", will not be added in variable "//TRIM(td_var%c_name) ) 5222 ELSEIF( td_var%t_dim(il_ind)%l_use )THEN 5223 CALL logger_error( & 5224 & " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//& 5225 & ", short name "//TRIM(td_dim%c_sname)//& 5226 & ", already used in variable "//TRIM(td_var%c_name) ) 5227 ELSE 5228 5229 ! back to unorder dimension array 5230 CALL dim_unorder(td_var%t_dim(:)) 5231 ! add new dimension 5232 td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim) 5233 5234 ! update number of attribute 5235 td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use) 5236 5237 ENDIF 5238 ! reorder dimension to ('x','y','z','t') 5239 CALL dim_reorder(td_var%t_dim(:)) 5240 5241 ELSE 5242 CALL logger_error( & 5243 & " VAR ADD DIM: too much dimension in variable "//& 5244 & TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")") 5245 ENDIF 5246 5247 END SUBROUTINE var__add_dim_unit 5248 !------------------------------------------------------------------- 5249 !> @brief This subroutine delete a dimension structure in a variable 5250 !> structure. 5251 ! 5252 !> @warning delete variable value too. 5253 ! 5254 !> @author J.Paul 5255 !> - November, 2013- Initial Version 5256 ! 5257 !> @param[inout] td_var variable structure 5258 !> @param[in] td_dim dimension structure 5259 !------------------------------------------------------------------- 5260 SUBROUTINE var_del_dim(td_var, td_dim) 5261 IMPLICIT NONE 5262 ! Argument 5263 TYPE(TVAR) , INTENT(INOUT) :: td_var 5264 TYPE(TDIM) , INTENT(IN ) :: td_dim 5265 5266 ! local variable 5267 INTEGER(i4) :: il_ind 5268 INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape 5269 5270 TYPE(TDIM) :: tl_dim ! empty dimension structure 5271 5272 !---------------------------------------------------------------- 5273 5274 IF( td_var%i_ndim <= 4 )THEN 5275 5276 CALL logger_trace( & 5277 & " VAR DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 5278 & ", short name "//TRIM(td_dim%c_sname)//& 5279 & ", in variable "//TRIM(td_var%c_name) ) 5280 5281 ! check if dimension already in variable structure 5282 il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 5283 5284 ! replace dimension by empty one 5285 td_var%t_dim(il_ind)=dim_copy(tl_dim) 5286 5287 ! update number of dimension 5288 td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use) 5289 5290 ! remove variable value using this dimension 5291 IF( ASSOCIATED(td_var%d_value) )THEN 5292 il_shape(:)=SHAPE(td_var%d_value(:,:,:,:)) 5293 IF(il_shape(il_ind)/=td_dim%i_len)THEN 5294 CALL logger_warn("VAR DEL DIM: remove value of variable "//& 5295 & TRIM(td_var%c_name) ) 5296 CALL var_del_value(td_var) 5297 ENDIF 5298 ENDIF 5299 5300 ! reorder dimension to ('x','y','z','t') 5301 CALL dim_reorder(td_var%t_dim) 5302 5303 ELSE 5304 CALL logger_error( & 5305 & " VAR DEL DIM: too much dimension in variable "//& 5306 & TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")") 5307 ENDIF 5308 5309 END SUBROUTINE var_del_dim 5310 !------------------------------------------------------------------- 5311 !> @brief This subroutine move a dimension structure 5312 !> in variable structure. 5313 !> 5314 !> @warning 5315 !> - dimension order could be changed 5316 !> - delete variable value 5317 ! 5318 !> @author J.Paul 5319 !> - November, 2013- Initial Version 5320 ! 5321 !> @param[inout] td_var variable structure 5322 !> @param[in] td_dim dimension structure 5323 !------------------------------------------------------------------- 5324 SUBROUTINE var_move_dim(td_var, td_dim) 5325 IMPLICIT NONE 5326 ! Argument 5327 TYPE(TVAR) , INTENT(INOUT) :: td_var 5328 TYPE(TDIM) , INTENT(IN ) :: td_dim 5329 5330 ! local variable 5331 INTEGER(i4) :: il_ind 4787 5332 INTEGER(i4) :: il_dimid 4788 5333 !---------------------------------------------------------------- 4789 IF( td_var%i_ndim <= 4 )THEN 4790 4791 ! check if dimension already used in variable structure 4792 il_dimid=dim_get_id( td_var%t_dim(:), td_dim%c_name, td_dim%c_sname ) 4793 4794 IF( il_dimid == 0 )THEN 4795 4796 ! add dimension 4797 CALL var__add_dim(td_var, td_dim) 5334 5335 IF( td_var%i_ndim <= ip_maxdim )THEN 5336 5337 ! check if dimension already in mpp structure 5338 il_ind=dim_get_index(td_var%t_dim(:), td_dim%c_name, td_dim%c_sname) 5339 IF( il_ind /= 0 )THEN 5340 5341 il_dimid=td_var%t_dim(il_ind)%i_id 5342 ! replace dimension 5343 td_var%t_dim(il_ind)=dim_copy(td_dim) 5344 td_var%t_dim(il_ind)%i_id=il_dimid 5345 td_var%t_dim(il_ind)%l_use=.TRUE. 4798 5346 4799 5347 ELSE 4800 4801 IF( td_var%t_dim(il_dimid)%l_use )THEN 4802 4803 CALL logger_error( & 4804 & " ADD DIM: dimension "//TRIM(td_dim%c_name)//& 4805 & ", short name "//TRIM(td_dim%c_sname)//& 4806 & ", already used in variable "//TRIM(td_var%c_name) ) 4807 ELSE 4808 ! add dimension 4809 CALL var__add_dim(td_var, td_dim) 4810 ENDIF 4811 5348 CALL var_add_dim(td_var, td_dim) 4812 5349 ENDIF 4813 5350 4814 5351 ELSE 4815 5352 CALL logger_error( & 4816 & " ADD DIM: too much dimension in variable "//&5353 & "VAR MOVE DIM: too much dimension in variale "//& 4817 5354 & TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")") 4818 5355 ENDIF 4819 5356 4820 END SUBROUTINE var__add_dim_unit 4821 !> @endcode 4822 !------------------------------------------------------------------- 4823 !> @brief This subroutine add a dimension structure in a variable 4824 !> structure. 4825 ! 5357 END SUBROUTINE var_move_dim 5358 !------------------------------------------------------------------- 5359 !> @brief This subroutine print informations of an array of variables. 5360 !> 4826 5361 !> @author J.Paul 4827 !> - Nov, 2013- Initial Version 4828 ! 4829 !> @param[inout] td_var : variable structure 4830 !> @param[in] td_dim : dimension structure 4831 ! 4832 !> @todo 4833 !------------------------------------------------------------------- 4834 !> @code 4835 SUBROUTINE var__add_dim(td_var, td_dim) 5362 !> - June, 2014- Initial Version 5363 ! 5364 !> @param[in] td_var array of variables structure 5365 !------------------------------------------------------------------- 5366 SUBROUTINE var__print_arr(td_var) 4836 5367 IMPLICIT NONE 5368 4837 5369 ! Argument 4838 TYPE(TVAR), INTENT(INOUT) :: td_var 4839 TYPE(TDIM), INTENT(IN) :: td_dim 5370 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var 4840 5371 4841 5372 ! loop indices … … 4843 5374 !---------------------------------------------------------------- 4844 5375 4845 CALL logger_info( & 4846 & " ADD DIM: add dimension "//TRIM(td_dim%c_name)//& 4847 & ", short name "//TRIM(td_dim%c_sname)//& 4848 & ", length "//TRIM(fct_str(td_dim%i_len))//& 4849 & ", in variable "//TRIM(td_var%c_name) ) 4850 4851 ! if dimension order already changed 4852 IF( ANY(td_var%t_dim(:)%i_xyzt2 /= 0 ) )THEN 4853 ! unordered dimension structure 4854 CALL dim_unorder(td_var%t_dim(:)) 4855 ENDIF 4856 4857 ! search unused dimension 4858 DO ji=1,ip_maxdim 4859 IF( .NOT. td_var%t_dim(ji)%l_use )THEN 4860 ! add new dimension 4861 td_var%t_dim(ji)=td_dim 4862 td_var%t_dim(ji)%i_id=ji 4863 !!td_var%t_dim(ji)%l_use=.TRUE. 4864 IF( td_var%t_dim(ji)%l_use )THEN 4865 ! update number of attribute 4866 td_var%i_ndim=td_var%i_ndim+1 4867 ENDIF 4868 EXIT 4869 ENDIF 5376 DO ji=1,SIZE(td_var(:)) 5377 CALL var_print(td_var(ji)) 4870 5378 ENDDO 4871 5379 4872 ! reorder dimension to ('x','y','z','t') 4873 CALL dim_reorder(td_var%t_dim(:)) 4874 4875 END SUBROUTINE var__add_dim 4876 !> @endcode 4877 !------------------------------------------------------------------- 4878 !> @brief This subroutine delete a dimension structure in a variable 4879 !> structure.<br/> 4880 ! 4881 !> @warning delete variable value too 4882 ! 4883 !> @author J.Paul 4884 !> - Nov, 2013- Initial Version 4885 ! 4886 !> @param[inout] td_var : variable structure 4887 !> @param[in] td_dim : dimension structure 4888 ! 4889 !> @todo 4890 !------------------------------------------------------------------- 4891 !> @code 4892 SUBROUTINE var_del_dim(td_var, td_dim) 4893 IMPLICIT NONE 4894 ! Argument 4895 TYPE(TVAR), INTENT(INOUT) :: td_var 4896 TYPE(TDIM), INTENT(IN) :: td_dim 4897 4898 ! local variable 4899 INTEGER(i4) :: il_dimid 4900 TYPE(TDIM) :: tl_dim ! empty dimension structure 4901 4902 INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape 4903 4904 !---------------------------------------------------------------- 4905 IF( td_var%i_ndim <= 4 )THEN 4906 4907 ! check if dimension already in variable structure 4908 il_dimid=dim_get_id( td_var%t_dim(:), td_dim%c_name, td_dim%c_sname ) 4909 IF( il_dimid == 0 )THEN 4910 4911 CALL logger_warn( & 4912 & " DEL DIM: no dimension "//TRIM(td_dim%c_name)//& 4913 & ", short name "//TRIM(td_dim%c_sname)//& 4914 & ", in variable "//TRIM(td_var%c_name) ) 4915 4916 ELSE 4917 4918 CALL logger_debug( & 4919 & " DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 4920 & ", short name "//TRIM(td_dim%c_sname)//& 4921 & ", in variable "//TRIM(td_var%c_name)//& 4922 & " id "//TRIM(fct_str(il_dimid)) ) 4923 4924 ! replace dimension by empty one 4925 td_var%t_dim(il_dimid)=tl_dim 4926 4927 ! update number of dimension 4928 td_var%i_ndim=td_var%i_ndim-1 4929 4930 IF( ASSOCIATED(td_var%d_value) )THEN 4931 il_shape(:)=SHAPE(td_var%d_value(:,:,:,:)) 4932 IF(il_shape(il_dimid)/=td_dim%i_len)THEN 4933 CALL logger_warn("VAR DEL DIM: remove value of variable "//& 4934 & TRIM(td_var%c_name) ) 4935 CALL var_del_value(td_var) 4936 ENDIF 4937 ENDIF 4938 4939 ! reorder dimension to ('x','y','z','t') 4940 CALL dim_reorder(td_var%t_dim) 4941 4942 ENDIF 4943 ELSE 4944 CALL logger_error( & 4945 & " DEL DIM: too much dimension in variable "//& 4946 & TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")") 4947 ENDIF 4948 4949 END SUBROUTINE var_del_dim 4950 !> @endcode 4951 !------------------------------------------------------------------- 4952 !> @brief This subroutine move a dimension structure 4953 !> in variable structure. 4954 !> 4955 !> @warning 4956 !> - dimension order could be changed 4957 !> - delete variable value 4958 ! 4959 !> @author J.Paul 4960 !> - Nov, 2013- Initial Version 4961 ! 4962 !> @param[inout] td_var : variable structure 4963 !> @param[in] td_dim : dimension structure 4964 !> @todo 4965 !------------------------------------------------------------------- 4966 !> @code 4967 SUBROUTINE var_move_dim(td_var, td_dim) 4968 IMPLICIT NONE 4969 ! Argument 4970 TYPE(TVAR), INTENT(INOUT) :: td_var 4971 TYPE(TDIM), INTENT(IN) :: td_dim 4972 4973 ! local variable 4974 TYPE(TDIM) :: tl_dim 4975 !---------------------------------------------------------------- 4976 4977 ! copy dimension 4978 tl_dim=td_dim 4979 4980 ! remove dimension with same name 4981 CALL var_del_dim(td_var, tl_dim) 4982 4983 ! add new dimension 4984 CALL var_add_dim(td_var, tl_dim) 4985 4986 END SUBROUTINE var_move_dim 4987 !> @endcode 5380 END SUBROUTINE var__print_arr 4988 5381 !------------------------------------------------------------------- 4989 5382 !> @brief This subroutine print variable information.</br/> 5383 !> @details 4990 5384 !> If ld_more is TRUE (default), print information about variable dimensions 4991 5385 !> and variable attributes. 4992 5386 !> 4993 5387 !> @author J.Paul 4994 !> - Nov, 2013- Initial Version 4995 ! 4996 !> @param[in] td_var : variable structure 4997 !> @param[in] ld_more : print more infomration about variable 4998 !------------------------------------------------------------------- 4999 !> @code 5000 SUBROUTINE var_print(td_var, ld_more) 5388 !> - November, 2013- Initial Version 5389 ! 5390 !> @param[in] td_var variable structure 5391 !> @param[in] ld_more print more infomration about variable 5392 !------------------------------------------------------------------- 5393 SUBROUTINE var__print_unit(td_var, ld_more) 5001 5394 IMPLICIT NONE 5002 5395 … … 5039 5432 END SELECT 5040 5433 5434 WRITE(*,'((/a,a),4(/3x,a,a),4(/3x,a,i3),& 5435 & (/3x,a,a),3(/3x,a,ES12.4))')& 5436 & " Variable : ",TRIM(td_var%c_name), & 5437 & " standard name : ",TRIM(td_var%c_stdname), & 5438 & " long name : ",TRIM(td_var%c_longname), & 5439 & " units : ",TRIM(td_var%c_units), & 5440 & " point : ",TRIM(td_var%c_point), & 5441 & " id : ",td_var%i_id, & 5442 & " rec : ",td_var%i_rec, & 5443 & " ndim : ",td_var%i_ndim, & 5444 & " natt : ",td_var%i_natt, & 5445 & " type : ",TRIM(cl_type), & 5446 & " scale factor : ",td_var%d_scf, & 5447 & " add offset : ",td_var%d_ofs, & 5448 & " _FillValue : ",td_var%d_fill 5449 5041 5450 IF( ASSOCIATED(td_var%d_value) )THEN 5042 WRITE(*,*) "ASSOCIATED"5043 5451 dl_min=MINVAL(td_var%d_value(:,:,:,:), & 5044 5452 & mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )& … … 5047 5455 & mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )& 5048 5456 & *td_var%d_scf+td_var%d_ofs 5049 ELSE 5050 WRITE(*,*) "NOT ASSOCIATED" 5051 dl_min=0. 5052 dl_max=0. 5053 ENDIF 5054 5055 WRITE(*,'((a,a),3(/3x,a,a),3(/3x,a,i3),& 5056 & (/3x,a,a),5(/3x,a,ES12.4))')& 5057 & " Variable : ",TRIM(td_var%c_name), & 5058 & " standard name : ",TRIM(td_var%c_stdname), & 5059 & " units : ",TRIM(td_var%c_units), & 5060 & " point : ",TRIM(td_var%c_point), & 5061 & " id : ",td_var%i_id, & 5062 & " ndim : ",td_var%i_ndim, & 5063 & " natt : ",td_var%i_natt, & 5064 & " type : ",TRIM(cl_type), & 5065 & " scale factor : ",td_var%d_scf, & 5066 & " add offset : ",td_var%d_ofs, & 5067 & " _FillValue : ",td_var%d_fill, & 5068 & " min value : ",dl_min, & 5069 & " max value : ",dl_max 5457 5458 WRITE(*,'((3x,a),2(/3x,a,ES12.4))')& 5459 & "VALUE ASSOCIATED" , & 5460 & " min value : ",dl_min,& 5461 & " max value : ",dl_max 5462 ENDIF 5070 5463 5071 5464 IF( ll_more )THEN 5072 5465 ! print dimension 5073 5466 IF( td_var%i_ndim /= 0 )THEN 5074 WRITE(*,'( /a)') " Variable dimension"5467 WRITE(*,'(a)') " Variable dimension" 5075 5468 DO ji=1,ip_maxdim 5076 5469 IF( td_var%t_dim(ji)%l_use )THEN … … 5082 5475 ! print attribute 5083 5476 IF( td_var%i_natt /= 0 )THEN 5084 WRITE(*,'( /a)') " Variable attribute"5477 WRITE(*,'(a)') " Variable attribute" 5085 5478 DO ji=1,td_var%i_natt 5086 5479 CALL att_print(td_var%t_att(ji)) … … 5089 5482 ENDIF 5090 5483 5091 END SUBROUTINE var_print 5092 !> @endcode 5093 !------------------------------------------------------------------- 5094 !> @brief This subroutine add a 4D table of double value in a variable 5484 END SUBROUTINE var__print_unit 5485 !------------------------------------------------------------------- 5486 !> @brief This subroutine add a 4D array of real(8) value in a variable 5095 5487 !> structure. 5096 !>5097 !> @warning Dimension of the table must be ordered as ('x','y','z','t')5098 5488 ! 5099 5489 !> @details 5100 5490 !> indices in the variable where value will be written could be specify if 5101 !> start and count table are given. 5102 ! 5491 !> start and count array are given. 5492 !> @warning Dimension of the array must be ordered as ('x','y','z','t') 5493 !> 5103 5494 !> @author J.Paul 5104 !> - Nov , 2013- Initial Version5105 ! 5106 !> @param[inout] td_var :variable structure5107 !> @param[in] dd_value : tableof variable value5108 !> @param[in] id_start :index in the variable from which the data values5495 !> - November, 2013- Initial Version 5496 !> 5497 !> @param[inout] td_var variable structure 5498 !> @param[in] dd_value array of variable value 5499 !> @param[in] id_start index in the variable from which the data values 5109 5500 !> will be read 5110 !> @param[in] id_count : number of indices selected along each dimension 5111 ! 5112 !> @todo 5113 !------------------------------------------------------------------- 5114 !> @code 5501 !> @param[in] id_count number of indices selected along each dimension 5502 !------------------------------------------------------------------- 5115 5503 SUBROUTINE var__add_value(td_var, dd_value, id_start, id_count) 5116 5504 IMPLICIT NONE … … 5135 5523 ((.NOT. PRESENT(id_start)) .AND. PRESENT(id_count) ) )THEN 5136 5524 CALL logger_warn( & 5137 & " ADD VALUE: id_start and id_count should be both specified")5525 & " VAR ADD VALUE: id_start and id_count should be both specified") 5138 5526 ENDIF 5139 5527 5140 5528 IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN 5141 5529 5142 ! keep ordered table('x','y','z','t')5530 ! keep ordered array ('x','y','z','t') 5143 5531 il_start(:)=id_start(:) 5144 5532 il_count(:)=id_count(:) … … 5146 5534 ELSE 5147 5535 5148 ! keep ordered table('x','y','z','t')5536 ! keep ordered array ('x','y','z','t') 5149 5537 il_start(:)=(/1,1,1,1/) 5150 5538 il_count(:)=td_var%t_dim(:)%i_len … … 5152 5540 ENDIF 5153 5541 5154 ! check dimension of input table5542 ! check dimension of input array 5155 5543 il_shape(:)=SHAPE(dd_value(:,:,:,:)) 5156 5544 IF(.NOT.ALL( il_count(:) == il_shape(:)) )THEN 5157 CALL logger_error( &5158 & " ADD VALUE: dimension of input table, and count table differ " )5159 5545 5160 5546 CALL logger_debug(" ADD VALUE: check dimension order !!") 5161 5547 DO ji = 1, ip_maxdim 5162 5548 CALL logger_debug( & 5163 & " ADD VALUE: count : "//TRIM(fct_str(il_count(ji)))//&5164 & " tabledimension : "//TRIM(fct_str(il_shape(ji))))5549 & " VAR ADD VALUE: count : "//TRIM(fct_str(il_count(ji)))//& 5550 & " array dimension : "//TRIM(fct_str(il_shape(ji)))) 5165 5551 ENDDO 5552 CALL logger_error( & 5553 & " VAR ADD VALUE: dimension of input array, and count array differ " ) 5166 5554 5167 5555 ELSE … … 5169 5557 ! check dimension of variable 5170 5558 IF(.NOT.ALL(il_start(:)+il_count(:)-1 <= td_var%t_dim(:)%i_len) )THEN 5171 CALL logger_error( & 5172 & " ADD VALUE: start + count exceed variable dimension. " ) 5173 5174 CALL logger_debug(" ADD VALUE: check dimension order !!") 5559 5560 CALL logger_debug(" VAR ADD VALUE: check dimension order !!") 5175 5561 DO ji = 1, ip_maxdim 5176 5562 CALL logger_debug( & 5177 & " ADD VALUE: start ("//TRIM(fct_str(il_start(ji)))//") "//&5563 & " VAR ADD VALUE: start ("//TRIM(fct_str(il_start(ji)))//") "//& 5178 5564 & "+ count ("//TRIM(fct_str(il_count(ji)))//") "//& 5179 5565 & "variable dimension "//TRIM(fct_str(td_var%t_dim(ji)%i_len))) 5180 5566 ENDDO 5181 5567 5568 CALL logger_error( & 5569 & " VAR ADD VALUE: start + count exceed variable dimension bound. " ) 5182 5570 ELSE 5183 5571 … … 5191 5579 5192 5580 CALL logger_warn( & 5193 & " ADD VALUE: value already in variable "//&5581 & "VAR ADD VALUE: value already in variable "//& 5194 5582 & TRIM(td_var%c_name)//& 5195 5583 & " (standard name "//TRIM(td_var%c_stdname)//")" ) … … 5206 5594 5207 5595 CALL logger_error( & 5208 & " ADD VALUE: not enough space to put variable "//&5596 & " VAR ADD VALUE: not enough space to put variable "//& 5209 5597 & TRIM(td_var%c_name)//& 5210 5598 & " in variable structure") … … 5212 5600 ENDIF 5213 5601 5214 ! initialise table5215 CALL logger_ info( &5216 & " ADD VALUE: value in variable "//TRIM(td_var%c_name)//&5602 ! initialise array 5603 CALL logger_trace( & 5604 & " VAR ADD VALUE: value in variable "//TRIM(td_var%c_name)//& 5217 5605 & ", initialise to FillValue "//TRIM(fct_str(td_var%d_fill)) ) 5218 5606 td_var%d_value(:,:,:,:)=td_var%d_fill … … 5220 5608 ENDIF 5221 5609 5222 CALL logger_ info( &5223 & " ADD VALUE: put value in variable "//TRIM(td_var%c_name)//&5610 CALL logger_debug( & 5611 & " VAR ADD VALUE: put value in variable "//TRIM(td_var%c_name)//& 5224 5612 & " (standard name "//TRIM(td_var%c_stdname)//")" ) 5225 5613 … … 5234 5622 5235 5623 END SUBROUTINE var__add_value 5236 !> @endcode 5237 !------------------------------------------------------------------- 5238 !> @brief This subroutine add a 4D table of real(8) value in a variable 5239 !> structure. Dimension of the table must be ordered as ('x','y','z','t') 5240 ! 5624 !------------------------------------------------------------------- 5625 !> @brief This subroutine add a 4D array of real(8) value in a variable 5626 !> structure. Dimension of the array must be ordered as ('x','y','z','t') 5627 !> 5241 5628 !> @details 5242 !> indices of the variable where value will be written could be specify 5243 !> with start and count table. 5244 !> 5245 !> @note variable type is forced to DOUBLE 5246 ! 5629 !> Optionally, you could specify the type of the variable to be used (default real(8)), 5630 !> and indices of the variable where value will be written with start and count array. 5631 !> 5247 5632 !> @author J.Paul 5248 !> - Nov, 2013- Initial Version 5249 ! 5250 !> @param[inout] td_var : variable structure 5251 !> @param[in] dd_value : table of variable value 5252 !> @param[in] id_start : start indices of the variable where data values 5633 !> - November, 2013- Initial Version 5634 !> 5635 !> @param[inout] td_var variable structure 5636 !> @param[in] dd_value array of variable value 5637 !> @param[in] id_type type of the variable to be used (default real(8)) 5638 !> @param[in] id_start start indices of the variable where data values 5253 5639 !> will be written 5254 !> @param[in] id_count : number of indices selected along each dimension 5255 ! 5256 !> @todo 5257 !------------------------------------------------------------------- 5258 !> @code 5259 SUBROUTINE var__add_value_dp(td_var, dd_value, id_start, id_count) 5640 !> @param[in] id_count number of indices selected along each dimension 5641 !------------------------------------------------------------------- 5642 SUBROUTINE var__add_value_dp(td_var, dd_value, id_type, id_start, id_count) 5260 5643 IMPLICIT NONE 5261 5644 ! Argument 5262 5645 TYPE(TVAR), INTENT(INOUT) :: td_var 5263 5646 REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value 5647 INTEGER(i4), INTENT(IN), OPTIONAL :: id_type 5264 5648 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start 5265 5649 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count … … 5269 5653 !---------------------------------------------------------------- 5270 5654 5271 IF( td_var%i_type == 0)THEN5272 td_var%i_type= NF90_DOUBLE5273 ELSE 5655 IF( PRESENT(id_type) )THEN 5656 td_var%i_type=id_type 5657 5274 5658 cl_type='' 5275 5659 SELECT CASE(td_var%i_type) … … 5285 5669 cl_type='BYTE' 5286 5670 END SELECT 5287 CALL logger_ info("VAR ADD VALUE: "//TRIM(td_var%c_name)//&5671 CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//& 5288 5672 & " value will be saved as "//TRIM(cl_type)) 5289 5673 ENDIF … … 5292 5676 5293 5677 END SUBROUTINE var__add_value_dp 5294 !> @endcode 5295 !------------------------------------------------------------------- 5296 !> @brief This subroutine add a 4D table of real value in a variable 5297 !> structure. Dimension of the table must be ordered as ('x','y','z','t') 5678 !------------------------------------------------------------------- 5679 !> @brief This subroutine add a 4D array of real(4) value in a variable 5680 !> structure. Dimension of the array must be ordered as ('x','y','z','t') 5298 5681 ! 5299 5682 !> @details 5300 !> indices of the variable where value will be written could be specify 5301 !> wiht start and count table. 5302 !> 5303 !> @note variable type is forced to FLOAT 5304 ! 5683 !> Optionally, you could specify the type of the variable to be used (default real(4)), 5684 !> and indices of the variable where value will be written with start and count array. 5685 !> 5305 5686 !> @author J.Paul 5306 !> - Nov, 2013- Initial Version 5307 ! 5308 !> @param[inout] td_var : variable structure 5309 !> @param[in] rd_value : table of variable value 5310 !> @param[in] id_start : start indices of the variable where data values 5687 !> - November, 2013- Initial Version 5688 ! 5689 !> @param[inout] td_var variable structure 5690 !> @param[in] rd_value array of variable value 5691 !> @param[in] id_type type of the variable to be used (default real(4)) 5692 !> @param[in] id_start start indices of the variable where data values 5311 5693 !> will be written 5312 !> @param[in] id_count : number of indices selected along each dimension 5313 ! 5314 !> @todo 5315 !------------------------------------------------------------------- 5316 !> @code 5317 SUBROUTINE var__add_value_rp(td_var, rd_value, id_start, id_count) 5694 !> @param[in] id_count number of indices selected along each dimension 5695 !------------------------------------------------------------------- 5696 SUBROUTINE var__add_value_rp(td_var, rd_value, id_type, id_start, id_count) 5318 5697 IMPLICIT NONE 5319 5698 ! Argument 5320 5699 TYPE(TVAR), INTENT(INOUT) :: td_var 5321 5700 REAL(sp), DIMENSION(:,:,:,:), INTENT(IN) :: rd_value 5701 INTEGER(i4), INTENT(IN), OPTIONAL :: id_type 5322 5702 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start 5323 5703 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count … … 5332 5712 !---------------------------------------------------------------- 5333 5713 5334 IF( td_var%i_type == 0)THEN5335 td_var%i_type= NF90_FLOAT5336 ELSE 5714 IF( PRESENT(id_type) )THEN 5715 td_var%i_type=id_type 5716 5337 5717 cl_type='' 5338 5718 SELECT CASE(td_var%i_type) … … 5348 5728 cl_type='BYTE' 5349 5729 END SELECT 5350 CALL logger_ info("VAR ADD VALUE: "//TRIM(td_var%c_name)//&5730 CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//& 5351 5731 & " value will be saved as "//TRIM(cl_type)) 5352 5732 ENDIF … … 5358 5738 5359 5739 CALL logger_error( & 5360 & " ADD VALUE: not enough space to put variable "//&5740 & " VAR ADD VALUE: not enough space to put variable "//& 5361 5741 & TRIM(td_var%c_name)//& 5362 5742 & " in variable structure") … … 5370 5750 5371 5751 END SUBROUTINE var__add_value_rp 5372 !> @endcode 5373 !------------------------------------------------------------------- 5374 !> @brief This subroutine add a 4D table of integer(1) value in a variable 5375 !> structure. Dimension of the table must be ordered as ('x','y','z','t') 5752 !------------------------------------------------------------------- 5753 !> @brief This subroutine add a 4D array of integer(1) value in a variable 5754 !> structure. Dimension of the array must be ordered as ('x','y','z','t') 5376 5755 ! 5377 5756 !> @details 5378 !> indices in the variable where value will be written could be specify if5379 !> start and count table are given.5757 !> Optionally, you could specify the type of the variable to be used (default integer(1)), 5758 !> and indices of the variable where value will be written with start and count array. 5380 5759 !> 5381 5760 !> @note variable type is forced to BYTE 5382 5761 ! 5383 5762 !> @author J.Paul 5384 !> - Nov, 2013- Initial Version 5385 ! 5386 !> @param[inout] td_var : variabele structure 5387 !> @param[in] bd_value : table of variable value 5388 !> @param[in] id_start : start indices of the variable where data values 5763 !> - November, 2013- Initial Version 5764 ! 5765 !> @param[inout] td_var variabele structure 5766 !> @param[in] bd_value array of variable value 5767 !> @param[in] id_type type of the variable to be used (default integer(1)) 5768 !> @param[in] id_start start indices of the variable where data values 5389 5769 !> will be read 5390 !> @param[in] id_count : number of indices selected along each dimension 5391 ! 5392 !> @todo 5393 !------------------------------------------------------------------- 5394 !> @code 5395 SUBROUTINE var__add_value_i1(td_var, bd_value, id_start, id_count) 5770 !> @param[in] id_count number of indices selected along each dimension 5771 !------------------------------------------------------------------- 5772 SUBROUTINE var__add_value_i1(td_var, bd_value, id_type, id_start, id_count) 5396 5773 IMPLICIT NONE 5397 5774 ! Argument 5398 5775 TYPE(TVAR), INTENT(INOUT) :: td_var 5399 5776 INTEGER(i1), DIMENSION(:,:,:,:), INTENT(IN) :: bd_value 5777 INTEGER(i4), INTENT(IN), OPTIONAL :: id_type 5400 5778 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start 5401 5779 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count … … 5410 5788 !---------------------------------------------------------------- 5411 5789 5412 IF( td_var%i_type == 0)THEN5413 td_var%i_type= NF90_BYTE5414 ELSE 5790 IF( PRESENT(id_type) )THEN 5791 td_var%i_type=id_type 5792 5415 5793 cl_type='' 5416 5794 SELECT CASE(td_var%i_type) … … 5426 5804 cl_type='BYTE' 5427 5805 END SELECT 5428 CALL logger_ info("VAR ADD VALUE: "//TRIM(td_var%c_name)//&5806 CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//& 5429 5807 & " value will be saved as "//TRIM(cl_type)) 5430 5808 ENDIF … … 5436 5814 5437 5815 CALL logger_error( & 5438 & " ADD VALUE: not enough space to put variable "//&5816 & " VAR ADD VALUE: not enough space to put variable "//& 5439 5817 & TRIM(td_var%c_name)//& 5440 5818 & " in variable structure") … … 5448 5826 5449 5827 END SUBROUTINE var__add_value_i1 5450 !> @endcode 5451 !------------------------------------------------------------------- 5452 !> @brief This subroutine add a 4D table of integer(1) value in a variable 5453 !> structure. Dimension of the table must be ordered as ('x','y','z','t') 5828 !------------------------------------------------------------------- 5829 !> @brief This subroutine add a 4D array of integer(2) value in a variable 5830 !> structure. Dimension of the array must be ordered as ('x','y','z','t') 5454 5831 ! 5455 5832 !> @details 5456 !> indices in the variable where value will be written could be specify if5457 !> start and count table are given.5833 !> Optionally, you could specify the type of the variable to be used (default integer(2)), 5834 !> and indices of the variable where value will be written with start and count array. 5458 5835 !> 5459 5836 !> @note variable type is forced to SHORT 5460 5837 ! 5461 5838 !> @author J.Paul 5462 !> - Nov, 2013- Initial Version 5463 ! 5464 !> @param[inout] td_var : variabele structure 5465 !> @param[in] sd_value : table of variable value 5466 !> @param[in] id_start : start indices of the variable where data values 5839 !> - November, 2013- Initial Version 5840 ! 5841 !> @param[inout] td_var variabele structure 5842 !> @param[in] sd_value array of variable value 5843 !> @param[in] id_type type of the variable to be used (default integer(2)) 5844 !> @param[in] id_start start indices of the variable where data values 5467 5845 !> will be read 5468 !> @param[in] id_count : number of indices selected along each dimension 5469 ! 5470 !> @todo 5471 !------------------------------------------------------------------- 5472 !> @code 5473 SUBROUTINE var__add_value_i2(td_var, sd_value, id_start, id_count) 5846 !> @param[in] id_count number of indices selected along each dimension 5847 !------------------------------------------------------------------- 5848 SUBROUTINE var__add_value_i2(td_var, sd_value, id_type, id_start, id_count) 5474 5849 IMPLICIT NONE 5475 5850 ! Argument 5476 5851 TYPE(TVAR), INTENT(INOUT) :: td_var 5477 5852 INTEGER(i2), DIMENSION(:,:,:,:), INTENT(IN) :: sd_value 5853 INTEGER(i4), INTENT(IN), OPTIONAL :: id_type 5478 5854 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start 5479 5855 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count … … 5488 5864 !---------------------------------------------------------------- 5489 5865 5490 IF( td_var%i_type == 0)THEN5491 td_var%i_type= NF90_SHORT5492 ELSE 5866 IF( PRESENT(id_type) )THEN 5867 td_var%i_type=id_type 5868 5493 5869 cl_type='' 5494 5870 SELECT CASE(td_var%i_type) … … 5504 5880 cl_type='BYTE' 5505 5881 END SELECT 5506 CALL logger_ info("VAR ADD VALUE: "//TRIM(td_var%c_name)//&5882 CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//& 5507 5883 & " value will be saved as "//TRIM(cl_type)) 5508 5884 ENDIF … … 5514 5890 5515 5891 CALL logger_error( & 5516 & " ADD VALUE: not enough space to put variable "//&5892 & " VAR ADD VALUE: not enough space to put variable "//& 5517 5893 & TRIM(td_var%c_name)//& 5518 5894 & " in variable structure") … … 5526 5902 5527 5903 END SUBROUTINE var__add_value_i2 5528 !> @endcode 5529 !------------------------------------------------------------------- 5530 !> @brief This subroutine add a 4D table of integer(4) value in a variable 5531 !> structure. Dimension of the table must be ordered as ('x','y','z','t') 5904 !------------------------------------------------------------------- 5905 !> @brief This subroutine add a 4D array of integer(4) value in a variable 5906 !> structure. Dimension of the array must be ordered as ('x','y','z','t') 5532 5907 ! 5533 5908 !> @details 5534 !> indices in the variable where value will be written could be specify if5535 !> start and count table are given.5909 !> Optionally, you could specify the type of the variable to be used (default integer(4)), 5910 !> and indices of the variable where value will be written with start and count array. 5536 5911 !> 5537 5912 !> @note variable type is forced to INT 5538 5913 ! 5539 5914 !> @author J.Paul 5540 !> - Nov, 2013- Initial Version 5541 ! 5542 !> @param[inout] td_var : variabele structure 5543 !> @param[in] id_value : table of variable value 5544 !> @param[in] id_start : start indices of the variable where data values 5915 !> - November, 2013- Initial Version 5916 ! 5917 !> @param[inout] td_var variabele structure 5918 !> @param[in] id_value array of variable value 5919 !> @param[in] id_type type of the variable to be used (default integer(4)) 5920 !> @param[in] id_start start indices of the variable where data values 5545 5921 !> will be read 5546 !> @param[in] id_count : number of indices selected along each dimension 5547 ! 5548 !> @todo 5549 !------------------------------------------------------------------- 5550 !> @code 5551 SUBROUTINE var__add_value_i4(td_var, id_value, id_start, id_count) 5922 !> @param[in] id_count number of indices selected along each dimension 5923 !------------------------------------------------------------------- 5924 SUBROUTINE var__add_value_i4(td_var, id_value, id_type, id_start, id_count) 5552 5925 IMPLICIT NONE 5553 5926 ! Argument 5554 5927 TYPE(TVAR), INTENT(INOUT) :: td_var 5555 5928 INTEGER(i4), DIMENSION(:,:,:,:), INTENT(IN) :: id_value 5929 INTEGER(i4), INTENT(IN), OPTIONAL :: id_type 5556 5930 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start 5557 5931 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count … … 5566 5940 !---------------------------------------------------------------- 5567 5941 5568 IF( td_var%i_type == 0)THEN5569 td_var%i_type= NF90_INT5570 ELSE 5942 IF( PRESENT(id_type) )THEN 5943 td_var%i_type=id_type 5944 5571 5945 cl_type='' 5572 5946 SELECT CASE(td_var%i_type) … … 5582 5956 cl_type='BYTE' 5583 5957 END SELECT 5584 CALL logger_ info("VAR ADD VALUE: "//TRIM(td_var%c_name)//&5958 CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//& 5585 5959 & " value will be saved as "//TRIM(cl_type)) 5586 5960 ENDIF … … 5592 5966 5593 5967 CALL logger_error( & 5594 & " ADD VALUE: not enough space to put variable "//&5968 & " VAR ADD VALUE: not enough space to put variable "//& 5595 5969 & TRIM(td_var%c_name)//& 5596 5970 & " in variable structure") … … 5604 5978 5605 5979 END SUBROUTINE var__add_value_i4 5606 !> @endcode 5607 !------------------------------------------------------------------- 5608 !> @brief This subroutine add a 4D table of integer(4) value in a variable 5609 !> structure. Dimension of the table must be ordered as ('x','y','z','t') 5980 !------------------------------------------------------------------- 5981 !> @brief This subroutine add a 4D array of integer(8) value in a variable 5982 !> structure. Dimension of the array must be ordered as ('x','y','z','t') 5610 5983 ! 5611 5984 !> @details 5612 !> indices in the variable where value will be written could be specify if 5613 !> start and count table are given. 5614 !> 5615 !> @note variable type is forced to INT 5616 ! 5985 !> Optionally, you could specify the type of the variable to be used (default integer(4)), 5986 !> and indices of the variable where value will be written with start and count array. 5987 !> 5617 5988 !> @author J.Paul 5618 !> - Nov, 2013- Initial Version 5619 ! 5620 !> @param[inout] td_var : variable structure 5621 !> @param[in] kd_value : table of variable value 5622 !> @param[in] id_start : start indices of the variable where data values 5989 !> - November, 2013- Initial Version 5990 ! 5991 !> @param[inout] td_var variable structure 5992 !> @param[in] kd_value array of variable value 5993 !> @param[in] id_type type of the variable to be used (default integer(8)) 5994 !> @param[in] id_start start indices of the variable where data values 5623 5995 !> will be read 5624 !> @param[in] id_count : number of indices selected along each dimension 5625 ! 5626 !> @todo 5627 !------------------------------------------------------------------- 5628 !> @code 5629 SUBROUTINE var__add_value_i8(td_var, kd_value, id_start, id_count) 5996 !> @param[in] id_count number of indices selected along each dimension 5997 !------------------------------------------------------------------- 5998 SUBROUTINE var__add_value_i8(td_var, kd_value, id_type, id_start, id_count) 5630 5999 IMPLICIT NONE 5631 6000 ! Argument 5632 6001 TYPE(TVAR), INTENT(INOUT) :: td_var 5633 6002 INTEGER(i8), DIMENSION(:,:,:,:), INTENT(IN) :: kd_value 6003 INTEGER(i4), INTENT(IN), OPTIONAL :: id_type 5634 6004 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start 5635 6005 INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count … … 5644 6014 !---------------------------------------------------------------- 5645 6015 5646 IF( td_var%i_type == 0)THEN5647 td_var%i_type= NF90_INT5648 ELSE 6016 IF( PRESENT(id_type) )THEN 6017 td_var%i_type=id_type 6018 5649 6019 cl_type='' 5650 6020 SELECT CASE(td_var%i_type) … … 5660 6030 cl_type='BYTE' 5661 6031 END SELECT 5662 CALL logger_ info("VAR ADD VALUE: "//TRIM(td_var%c_name)//&6032 CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//& 5663 6033 & " value will be saved as "//TRIM(cl_type)) 5664 6034 ENDIF … … 5670 6040 5671 6041 CALL logger_error( & 5672 & " ADD VALUE: not enough space to put variable "//&6042 & " VAR ADD VALUE: not enough space to put variable "//& 5673 6043 & TRIM(td_var%c_name)//& 5674 6044 & " in variable structure") … … 5682 6052 5683 6053 END SUBROUTINE var__add_value_i8 5684 !> @endcode5685 6054 !------------------------------------------------------------------- 5686 6055 !> @brief This subroutine remove variable value in a variable 5687 6056 !> structure. 5688 ! 6057 !> 5689 6058 !> @author J.Paul 5690 !> - Nov, 2013- Initial Version 5691 ! 5692 !> @param[inout] td_var : variable structure 5693 ! 5694 !------------------------------------------------------------------- 5695 !> @code 6059 !> - November, 2013- Initial Version 6060 !> 6061 !> @param[inout] td_var variable structure 6062 !------------------------------------------------------------------- 5696 6063 SUBROUTINE var_del_value(td_var) 5697 6064 IMPLICIT NONE … … 5700 6067 5701 6068 !---------------------------------------------------------------- 5702 CALL logger_ warn( &5703 & " DEL VALUE: value in variable "//TRIM(td_var%c_name)//&6069 CALL logger_debug( & 6070 & " VAR DEL VALUE: value in variable "//TRIM(td_var%c_name)//& 5704 6071 & ", standard name "//TRIM(td_var%c_stdname)//& 5705 6072 & " will be remove ") … … 5708 6075 5709 6076 END SUBROUTINE var_del_value 5710 !> @endcode 5711 !------------------------------------------------------------------- 5712 !> @brief This function return the variable id, in a table of variable 5713 !> structure, given variable name or standard name 5714 ! 6077 !------------------------------------------------------------------- 6078 !> @brief This function return the variable index, in a array of variable 6079 !> structure, given variable name or standard name. 6080 !> 5715 6081 !> @author J.Paul 5716 !> - Nov, 2013- Initial Version 5717 ! 5718 !> @param[in] td_var : table of variable structure 5719 !> @param[in] cd_name : variable name 5720 !> @param[in] cd_stdname : variable standard name 5721 !> @return variable id in table of variable structure (0 if not found) 5722 !------------------------------------------------------------------- 5723 !> @code 6082 !> - September, 2014- Initial Version 6083 !> 6084 !> @param[in] td_var array of variable structure 6085 !> @param[in] cd_name variable name 6086 !> @param[in] cd_stdname variable standard name 6087 !> @return variable index in array of variable structure (0 if not found) 6088 !------------------------------------------------------------------- 6089 INTEGER(i4) FUNCTION var_get_index(td_var, cd_name, cd_stdname) 6090 IMPLICIT NONE 6091 ! Argument 6092 TYPE(TVAR) , DIMENSION(:), INTENT(IN) :: td_var 6093 CHARACTER(LEN=*), INTENT(IN) :: cd_name 6094 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname 6095 6096 ! local variable 6097 INTEGER(i4) :: il_size 6098 6099 ! loop indices 6100 INTEGER(i4) :: ji 6101 !---------------------------------------------------------------- 6102 var_get_index=0 6103 il_size=SIZE(td_var(:)) 6104 6105 ! check if variable is in array of variable structure 6106 DO ji=1,il_size 6107 ! look for variable name 6108 IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN 6109 6110 var_get_index=ji 6111 EXIT 6112 6113 ! look for variable standard name 6114 ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 6115 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 6116 6117 var_get_index=ji 6118 EXIT 6119 6120 ELSE IF( PRESENT(cd_stdname) )THEN 6121 IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 6122 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 6123 6124 var_get_index=ji 6125 EXIT 6126 ENDIF 6127 6128 ! look for variable longname 6129 ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6130 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6131 6132 var_get_index=ji 6133 EXIT 6134 6135 ENDIF 6136 6137 ENDDO 6138 6139 END FUNCTION var_get_index 6140 !------------------------------------------------------------------- 6141 !> @brief This function return the variable id, 6142 !> given variable name or standard name. 6143 !> 6144 !> @warning only variable read from file, have an id. 6145 !> 6146 !> @author J.Paul 6147 !> - November, 2013- Initial Version 6148 ! 6149 !> @param[in] td_var array of variable structure 6150 !> @param[in] cd_name variable name 6151 !> @param[in] cd_stdname variable standard name 6152 !> @return variable id in array of variable structure (0 if not found) 6153 !------------------------------------------------------------------- 5724 6154 INTEGER(i4) FUNCTION var_get_id(td_var, cd_name, cd_stdname) 5725 6155 IMPLICIT NONE … … 5738 6168 il_size=SIZE(td_var(:)) 5739 6169 5740 ! check if variable is in tableof variable structure6170 ! check if variable is in array of variable structure 5741 6171 DO ji=1,il_size 5742 6172 ! look for variable name 5743 6173 IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN 5744 6174 5745 var_get_id= ji6175 var_get_id=td_var(ji)%i_id 5746 6176 EXIT 5747 6177 … … 5749 6179 ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 5750 6180 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 5751 !& TRIM(ADJUSTL(cd_stdname)) /= 'unknown' )THEN5752 6181 5753 var_get_id= ji6182 var_get_id=td_var(ji)%i_id 5754 6183 EXIT 5755 6184 … … 5757 6186 IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 5758 6187 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 5759 !& TRIM(ADJUSTL(cd_stdname)) /= 'unknown' )THEN5760 6188 5761 var_get_id= ji6189 var_get_id=td_var(ji)%i_id 5762 6190 EXIT 5763 6191 ENDIF … … 5767 6195 5768 6196 END FUNCTION var_get_id 5769 !> @endcode5770 6197 !------------------------------------------------------------------- 5771 6198 !> @brief 5772 !> This function return the mask of variable, given variable structure 5773 !> @detail 5774 !> 5775 ! 6199 !> This function return the mask 3D of variable, given variable structure. 6200 !> 5776 6201 !> @author J.Paul 5777 !> - Nov, 2013- Initial Version 5778 ! 5779 !> @param[in] td_var : table of variable structure 5780 !> @return variable id in table of variable structure 5781 !------------------------------------------------------------------- 5782 !> @code 6202 !> - November, 2013- Initial Version 6203 ! 6204 !> @param[in] td_var array of variable structure 6205 !> @return variable mask(3D) 6206 !------------------------------------------------------------------- 5783 6207 FUNCTION var_get_mask(td_var) 5784 6208 IMPLICIT NONE … … 5787 6211 5788 6212 ! function 5789 !INTEGER(i4), DIMENSION(:,:), POINTER :: var_get_mask5790 6213 INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, & 5791 & td_var%t_dim(2)%i_len) :: var_get_mask 6214 & td_var%t_dim(2)%i_len, & 6215 & td_var%t_dim(3)%i_len ) :: var_get_mask 5792 6216 5793 6217 ! local variable … … 5795 6219 IF( ASSOCIATED(td_var%d_value) )THEN 5796 6220 5797 CALL logger_trace( " GET MASK: create mask from variable "//&6221 CALL logger_trace( "VAR GET MASK: create mask from variable "//& 5798 6222 & TRIM(td_var%c_name) ) 5799 var_get_mask(:,: )=15800 WHERE( td_var%d_value(:,:, 1,1) == td_var%d_fill )5801 var_get_mask(:,: )=06223 var_get_mask(:,:,:)=1 6224 WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill ) 6225 var_get_mask(:,:,:)=0 5802 6226 ENDWHERE 5803 6227 5804 6228 ELSE 5805 CALL logger_error(" GET MASK: variable value not define.")6229 CALL logger_error("VAR GET MASK: variable value not define.") 5806 6230 ENDIF 5807 6231 END FUNCTION var_get_mask 5808 !> @endcode5809 6232 !------------------------------------------------------------------- 5810 6233 !> @brief 5811 !> This subroutine change Fill Value of the variable to 5812 !> standard NETCDF Fill Value 5813 !> @detail 6234 !> This subroutine change FillValue of the variable to 6235 !> standard NETCDF FillValue. 6236 !> 6237 !> @details 6238 !> optionally, you could specify a dummy _FillValue to be used 5814 6239 !> 5815 !5816 6240 !> @author J.Paul 5817 !> - Nov , 2013- Initial Version5818 ! 5819 !> @param[inout] td_var : tableof variable structure5820 ! -------------------------------------------------------------------5821 ! > @code5822 SUBROUTINE var_chg_FillValue(td_var )6241 !> - November, 2013- Initial Version 6242 ! 6243 !> @param[inout] td_var array of variable structure 6244 !> @param[in] dd_fill _FillValue to be used 6245 !------------------------------------------------------------------- 6246 SUBROUTINE var_chg_FillValue(td_var, dd_fill) 5823 6247 IMPLICIT NONE 5824 6248 ! Argument 5825 6249 TYPE(TVAR), INTENT(INOUT) :: td_var 6250 REAL(dp) , INTENT(IN) , OPTIONAL :: dd_fill 5826 6251 5827 6252 ! local variable 5828 6253 TYPE(TATT) :: tl_att 6254 6255 INTEGER(i1) :: bl_fill 6256 INTEGER(i2) :: sl_fill 6257 INTEGER(i4) :: il_fill 6258 REAL(sp) :: rl_fill 5829 6259 !---------------------------------------------------------------- 5830 6260 5831 CALL logger_ debug( "CHG FILL VALUE: change _FillValue in variable "//&6261 CALL logger_trace( "VAR CHG FILL VALUE: change _FillValue in variable "//& 5832 6262 & TRIM(td_var%c_name) ) 5833 6263 … … 5836 6266 5837 6267 CASE(NF90_BYTE) 5838 tl_att=att_init('_FillValue',NF90_FILL_BYTE) 6268 IF( PRESENT(dd_fill) )THEN 6269 bl_fill=INT(dd_fill,i1) 6270 tl_att=att_init('_FillValue',bl_fill) 6271 ELSE 6272 tl_att=att_init('_FillValue',NF90_FILL_BYTE) 6273 ENDIF 5839 6274 CASE(NF90_SHORT) 5840 tl_att=att_init('_FillValue',NF90_FILL_SHORT) 6275 IF( PRESENT(dd_fill) )THEN 6276 sl_fill=INT(dd_fill,i2) 6277 tl_att=att_init('_FillValue',sl_fill) 6278 ELSE 6279 tl_att=att_init('_FillValue',NF90_FILL_SHORT) 6280 ENDIF 5841 6281 CASE(NF90_INT) 5842 tl_att=att_init('_FillValue',NF90_FILL_INT) 6282 IF( PRESENT(dd_fill) )THEN 6283 il_fill=INT(dd_fill,i4) 6284 tl_att=att_init('_FillValue',il_fill) 6285 ELSE 6286 tl_att=att_init('_FillValue',NF90_FILL_INT) 6287 ENDIF 5843 6288 CASE(NF90_FLOAT) 5844 tl_att=att_init('_FillValue',NF90_FILL_FLOAT) 5845 CASE(NF90_DOUBLE) 5846 tl_att=att_init('_FillValue',NF90_FILL_DOUBLE) 5847 CASE DEFAULT 5848 tl_att=att_init('_FillValue',NF90_FILL_DOUBLE) 6289 IF( PRESENT(dd_fill) )THEN 6290 rl_fill=REAL(dd_fill,sp) 6291 tl_att=att_init('_FillValue',rl_fill) 6292 ELSE 6293 tl_att=att_init('_FillValue',NF90_FILL_FLOAT) 6294 ENDIF 6295 CASE DEFAULT ! NF90_DOUBLE 6296 IF( PRESENT(dd_fill) )THEN 6297 tl_att=att_init('_FillValue',dd_fill) 6298 ELSE 6299 tl_att=att_init('_FillValue',NF90_FILL_DOUBLE) 6300 ENDIF 5849 6301 5850 6302 END SELECT … … 5860 6312 CALL var_move_att(td_var, tl_att) 5861 6313 6314 ! clean 6315 CALL att_clean(tl_att) 6316 5862 6317 END SUBROUTINE var_chg_FillValue 5863 !> @endcode5864 6318 !------------------------------------------------------------------- 5865 6319 !> @brief 5866 !> This subroutine read variable configuration file , fill and save5867 !> a global table of variable structure with extra information :tg_varextra.6320 !> This subroutine read variable configuration file. And save 6321 !> global array of variable structure with extra information: tg_varextra. 5868 6322 !> 5869 !> @details5870 !>5871 6323 !> @author J.Paul 5872 !> - Nov, 2013- Initial Version 5873 ! 5874 !> @param[in] cd_file : configuration file of variable 5875 !------------------------------------------------------------------- 5876 !> @code 6324 !> - November, 2013- Initial Version 6325 ! 6326 !> @param[in] cd_file configuration file of variable 6327 !------------------------------------------------------------------- 5877 6328 SUBROUTINE var_def_extra( cd_file ) 5878 6329 IMPLICIT NONE … … 5894 6345 !---------------------------------------------------------------- 5895 6346 5896 IF( ALLOCATED(tg_varextra) ) DEALLOCATE(tg_varextra) 6347 IF( ALLOCATED(tg_varextra) )THEN 6348 CALL var_clean(tg_varextra(:)) 6349 DEALLOCATE(tg_varextra) 6350 ENDIF 5897 6351 5898 6352 ! read config variable file … … 5901 6355 5902 6356 ! get number of variable to be read 6357 5903 6358 il_fileid=fct_getunit() 5904 5905 CALL logger_debug("VAR DEF EXTRA: open "//TRIM(cd_file)) 6359 CALL logger_trace("VAR DEF EXTRA: open "//TRIM(cd_file)) 5906 6360 OPEN( il_fileid, FILE=TRIM(cd_file), & 5907 6361 & FORM='FORMATTED', & … … 5922 6376 5923 6377 ! search line do not beginning with comment character 5924 IF( SCAN( TRIM(fct_concat(c g_com(:))) ,cl_line(1:1)) == 0 )THEN6378 IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 5925 6379 il_nvar=il_nvar+1 5926 6380 ENDIF … … 5941 6395 ELSE 5942 6396 CALL logger_info("VAR DEF EXTRA: "//TRIM(fct_str(il_nvar))//& 5943 & " variable to be read on varaible config file") 5944 5945 CALL logger_debug("VAR DEF EXTRA: rewind "//TRIM(cd_file)) 6397 & " variable to be read on varaible config file"//& 6398 & TRIM(cd_file)) 6399 6400 CALL logger_trace("VAR DEF EXTRA: rewind "//TRIM(cd_file)) 5946 6401 REWIND( il_fileid, IOSTAT=il_status) 5947 6402 CALL fct_err(il_status) … … 5958 6413 DO WHILE( il_status == 0 ) 5959 6414 5960 IF( SCAN( TRIM(fct_concat(c g_com(:))) ,cl_line(1:1)) == 0 )THEN6415 IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN 5961 6416 tg_varextra(ji)%i_id = ji 5962 6417 tg_varextra(ji)%c_name =TRIM(fct_split(cl_line,1)) … … 5996 6451 5997 6452 END SUBROUTINE var_def_extra 5998 !> @endcode5999 6453 !------------------------------------------------------------------- 6000 6454 !> @brief 6001 6455 !> This subroutine add variable information get from namelist in 6002 !> global table of variable structure with extra information :tg_varextra.6456 !> global array of variable structure with extra information: tg_varextra. 6003 6457 !> 6004 6458 !> @details 6005 !> string character format must be : "varname:interp|filter|extrap" 6459 !> string character format must be : <br/> 6460 !> "varname:interp; filter; extrap; > min; < max"<br/> 6006 6461 !> you could specify only interpolation, filter or extrapolation method, 6007 !> or two whatever the order. you could find more 6008 !> information about available method in interpolation, filter, and 6009 !> extrapolation module. Here you cuold find some exemples: 6010 !> cn_varinfo='Bathymetry:2*hamming(2,3)' 6011 !> cn_varinfo='votemper:cubic|dist_weight' 6012 !> 6013 !> @note If you do not specify one method which is required, default one is 6462 !> whatever the order. you could find more 6463 !> information about available method in \ref interp, \ref filter, and 6464 !> \ref extrap module.<br/> 6465 !> Examples: 6466 !> cn_varinfo='Bathymetry:2*hamming(2,3); > 10.' 6467 !> cn_varinfo='votemper:cubic; dist_weight; <40.' 6468 !> 6469 !> @note If you do not specify a method which is required, default one is 6014 6470 !> apply. 6015 6471 !> 6016 6472 !> @author J.Paul 6017 !> - Nov, 2013- Initial Version 6018 ! 6019 !> @param[in] cd_varinfo : variable information from namelist 6020 !------------------------------------------------------------------- 6021 !> @code 6473 !> - November, 2013- Initial Version 6474 ! 6475 !> @param[in] cd_varinfo variable information from namelist 6476 !------------------------------------------------------------------- 6022 6477 SUBROUTINE var_chg_extra( cd_varinfo ) 6023 6478 IMPLICIT NONE … … 6032 6487 CHARACTER(LEN=lc), DIMENSION(5) :: cl_filter 6033 6488 6034 INTEGER(i4) :: il_ varid6489 INTEGER(i4) :: il_ind 6035 6490 INTEGER(i4) :: il_nvar 6036 6491 … … 6044 6499 !---------------------------------------------------------------- 6045 6500 6046 ji=1 6047 DO WHILE( TRIM(cd_varinfo(ji)) /= '' ) 6048 6049 cl_name =fct_lower(fct_split(cd_varinfo(ji),1,':')) 6050 cl_method=fct_split(cd_varinfo(ji),2,':') 6051 6052 dl_min=var__get_min(cl_name, cl_method) 6053 dl_max=var__get_max(cl_name, cl_method) 6054 cl_interp(:)=var__get_interp(cl_name, cl_method) 6055 cl_extrap(:)=var__get_extrap(cl_name, cl_method) 6056 cl_filter(:)=var__get_filter(cl_name, cl_method) 6057 6058 il_varid=var_get_id(tg_varextra(:), TRIM(cl_name)) 6059 IF( il_varid /= 0 )THEN 6060 IF( dl_min /= dg_fill ) tg_varextra(il_varid)%d_min=dl_min 6061 IF( dl_max /= dg_fill ) tg_varextra(il_varid)%d_max=dl_max 6062 IF(cl_interp(1)/='') tg_varextra(il_varid)%c_interp(:)=cl_interp(:) 6063 IF(cl_extrap(1)/='') tg_varextra(il_varid)%c_extrap(:)=cl_extrap(:) 6064 IF(cl_filter(1)/='') tg_varextra(il_varid)%c_filter(:)=cl_filter(:) 6065 ELSE 6066 6067 IF( ALLOCATED(tg_varextra) )THEN 6068 il_nvar=SIZE(tg_varextra(:)) 6069 ! save older variable 6070 ALLOCATE( tl_varextra(il_nvar) ) 6071 tl_varextra(:)=tg_varextra(:) 6072 6073 DEALLOCATE(tg_varextra) 6074 ALLOCATE( tg_varextra(il_nvar+1) ) 6075 6076 tg_varextra(1:il_nvar)=tl_varextra(:) 6077 DEALLOCATE(tl_varextra) 6078 6501 IF( ALLOCATED(tg_varextra) )THEN 6502 ji=1 6503 DO WHILE( TRIM(cd_varinfo(ji)) /= '' ) 6504 6505 cl_name =fct_lower(fct_split(cd_varinfo(ji),1,':')) 6506 cl_method=fct_split(cd_varinfo(ji),2,':') 6507 6508 dl_min=var__get_min(cl_name, cl_method) 6509 dl_max=var__get_max(cl_name, cl_method) 6510 cl_interp(:)=var__get_interp(cl_name, cl_method) 6511 cl_extrap(:)=var__get_extrap(cl_name, cl_method) 6512 cl_filter(:)=var__get_filter(cl_name, cl_method) 6513 6514 il_ind=var_get_index(tg_varextra(:), TRIM(cl_name)) 6515 IF( il_ind /= 0 )THEN 6516 IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min 6517 IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max 6518 IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:) 6519 IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:) 6520 IF(cl_filter(1)/='') tg_varextra(il_ind)%c_filter(:)=cl_filter(:) 6079 6521 ELSE 6080 6522 6081 il_varid=0 6082 ALLOCATE( tg_varextra(1) ) 6523 IF( ALLOCATED(tg_varextra) )THEN 6524 il_nvar=SIZE(tg_varextra(:)) 6525 ! save older variable 6526 ALLOCATE( tl_varextra(il_nvar) ) 6527 tl_varextra(:)=var_copy(tg_varextra(:)) 6528 6529 CALL var_clean(tg_varextra(:)) 6530 DEALLOCATE(tg_varextra) 6531 ALLOCATE( tg_varextra(il_nvar+1) ) 6532 6533 tg_varextra(1:il_nvar)=var_copy(tl_varextra(:)) 6534 6535 ! clean 6536 CALL var_clean(tl_varextra(:)) 6537 DEALLOCATE(tl_varextra) 6538 6539 ELSE 6540 6541 il_nvar=0 6542 ALLOCATE( tg_varextra(1) ) 6543 6544 ENDIF 6545 6546 ! add new variable 6547 il_ind=il_nvar+1 6548 tg_varextra(il_ind)=var_init( TRIM(cl_name), & 6549 & cd_interp=cl_interp(:), & 6550 & cd_extrap=cl_extrap(:), & 6551 & cd_filter=cl_filter(:), & 6552 & dd_min = dl_min, & 6553 & dd_max = dl_max ) 6083 6554 6084 6555 ENDIF 6085 6556 6086 ! add new variable 6087 il_varid=il_nvar+1 6088 tg_varextra(il_varid)=var_init( TRIM(cl_name), & 6089 & cd_interp=cl_interp(:), & 6090 & cd_extrap=cl_extrap(:), & 6091 & cd_filter=cl_filter(:), & 6092 & dd_min = dl_min, & 6093 & dd_max = dl_max ) 6094 6095 ENDIF 6096 6097 ji=ji+1 6098 CALL logger_trace( "VAR CHG EXTRA: name "//& 6099 & TRIM(tg_varextra(il_varid)%c_name) ) 6100 CALL logger_trace( "VAR CHG EXTRA: interp "//& 6101 & TRIM(tg_varextra(il_varid)%c_interp(1)) ) 6102 CALL logger_trace( "VAR CHG EXTRA: filter "//& 6103 & TRIM(tg_varextra(il_varid)%c_filter(1)) ) 6104 CALL logger_trace( "VAR CHG EXTRA: extrap "//& 6105 & TRIM(tg_varextra(il_varid)%c_extrap(1)) ) 6106 IF( tg_varextra(il_varid)%d_min /= dg_fill )THEN 6107 CALL logger_trace( "VAR CHG EXTRA: min value "//& 6108 & TRIM(fct_str(tg_varextra(il_varid)%d_min)) ) 6109 ENDIF 6110 IF( tg_varextra(il_varid)%d_max /= dg_fill )THEN 6111 CALL logger_trace( "VAR CHG EXTRA: max value "//& 6112 & TRIM(fct_str(tg_varextra(il_varid)%d_max)) ) 6113 ENDIF 6114 ENDDO 6557 ji=ji+1 6558 CALL logger_trace( "VAR CHG EXTRA: name "//& 6559 & TRIM(tg_varextra(il_ind)%c_name) ) 6560 CALL logger_trace( "VAR CHG EXTRA: interp "//& 6561 & TRIM(tg_varextra(il_ind)%c_interp(1)) ) 6562 CALL logger_trace( "VAR CHG EXTRA: filter "//& 6563 & TRIM(tg_varextra(il_ind)%c_filter(1)) ) 6564 CALL logger_trace( "VAR CHG EXTRA: extrap "//& 6565 & TRIM(tg_varextra(il_ind)%c_extrap(1)) ) 6566 IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN 6567 CALL logger_trace( "VAR CHG EXTRA: min value "//& 6568 & TRIM(fct_str(tg_varextra(il_ind)%d_min)) ) 6569 ENDIF 6570 IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN 6571 CALL logger_trace( "VAR CHG EXTRA: max value "//& 6572 & TRIM(fct_str(tg_varextra(il_ind)%d_max)) ) 6573 ENDIF 6574 ENDDO 6575 ENDIF 6115 6576 6116 6577 END SUBROUTINE var_chg_extra 6117 !> @endcode6118 6578 !------------------------------------------------------------------- 6119 6579 !> @brief 6120 !> This subroutine read matrix value from character string 6580 !> This subroutine read matrix value from character string in namelist 6121 6581 !> and fill variable strucutre value. 6122 6123 !> @detail 6124 !> 6125 ! 6582 !> 6583 !> @details 6584 !> to split matrix, separator use are:<br/> 6585 !> - ',' for line 6586 !> - '/' for row 6587 !> - '\' for level<br/> 6588 !> Example:<br/> 6589 !> 3,2,3/1,4,5 => 6590 !> @f$ \left( \begin{array}{ccc} 6591 !> 3 & 2 & 3 \\ 6592 !> 1 & 4 & 5 \end{array} \right) @f$ 6593 !> 6126 6594 !> @author J.Paul 6127 !> - Nov, 2013- Initial Version 6128 ! 6129 !> @param[inout] td_var : variable structure 6130 !> @param[in] cd_matrix : matrix value 6131 !------------------------------------------------------------------- 6132 !> @code 6595 !> - November, 2013- Initial Version 6596 ! 6597 !> @param[inout] td_var variable structure 6598 !> @param[in] cd_matrix matrix value 6599 !------------------------------------------------------------------- 6133 6600 SUBROUTINE var_read_matrix(td_var, cd_matrix) 6134 6601 IMPLICIT NONE … … 6138 6605 6139 6606 ! local variable 6140 CHARACTER(LEN=lc) :: cl_ table6607 CHARACTER(LEN=lc) :: cl_array 6141 6608 CHARACTER(LEN=lc) :: cl_line 6142 6609 CHARACTER(LEN=lc) :: cl_elt … … 6158 6625 6159 6626 !1- read matrix 6160 ALLOCATE( dl_matrix(i g_maxmtx, ig_maxmtx, ig_maxmtx) )6627 ALLOCATE( dl_matrix(ip_maxmtx, ip_maxmtx, ip_maxmtx) ) 6161 6628 dl_matrix(:,:,:)=td_var%d_fill 6162 6629 6163 6630 jk=1 6164 cl_ table=fct_split(TRIM(cd_matrix),jk,'\ ')6165 CALL logger_debug("VAR MATRIX table "//TRIM(cl_table) )6166 DO WHILE( TRIM(cl_ table) /= '' )6631 cl_array=fct_split(TRIM(cd_matrix),jk,'\ ') 6632 CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) ) 6633 DO WHILE( TRIM(cl_array) /= '' ) 6167 6634 jj=1 6168 cl_line=fct_split(TRIM(cl_ table),jj,'/')6635 cl_line=fct_split(TRIM(cl_array),jj,'/') 6169 6636 CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) ) 6170 6637 DO WHILE( TRIM(cl_line) /= '' ) … … 6179 6646 ENDDO 6180 6647 jj=jj+1 6181 cl_line=fct_split(TRIM(cl_ table),jj,'/')6648 cl_line=fct_split(TRIM(cl_array),jj,'/') 6182 6649 CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) ) 6183 6650 ENDDO 6184 6651 jk=jk+1 6185 cl_ table=fct_split(TRIM(cd_matrix),jk,'\ ')6186 CALL logger_debug("VAR MATRIX table "//TRIM(cl_table) )6652 cl_array=fct_split(TRIM(cd_matrix),jk,'\ ') 6653 CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) ) 6187 6654 ENDDO 6188 6655 … … 6200 6667 6201 6668 CALL var_add_dim(td_var, tl_dim(:)) 6669 ! clean 6202 6670 CALL dim_clean(tl_dim) 6203 6671 DEALLOCATE( tl_dim ) 6204 6672 6205 6673 IF( ASSOCIATED(td_var%d_value) ) DEALLOCATE(td_var%d_value) 6206 CALL var_add_value(td_var, dl_value(:,:,:,:) )6674 CALL var_add_value(td_var, dl_value(:,:,:,:), id_type=NF90_FLOAT) 6207 6675 6208 6676 DEALLOCATE( dl_value ) … … 6210 6678 6211 6679 END SUBROUTINE var_read_matrix 6212 !> @endcode6213 6680 !------------------------------------------------------------------- 6214 6681 !> @brief 6215 !> This subroutine add extra information in variable structure 6682 !> This subroutine add extra information in variable structure. 6216 6683 !> 6217 6684 !> @details 6218 !> 6685 !> if variable name is informed in global array of variable structure (tg_varextra). 6686 !> fill empty parameter on variable structure. 6687 !> 6219 6688 !> @author J.Paul 6220 !> - Nov, 2013- Initial Version 6221 ! 6222 !> @param[inout] td_var : variable structure 6223 !------------------------------------------------------------------- 6224 !> @code 6689 !> - November, 2013- Initial Version 6690 !> 6691 !> @param[inout] td_var variable structure 6692 !------------------------------------------------------------------- 6225 6693 SUBROUTINE var__get_extra( td_var ) 6226 6694 IMPLICIT NONE … … 6229 6697 6230 6698 ! local variable 6231 INTEGER(i4) :: il_ varid6699 INTEGER(i4) :: il_ind 6232 6700 TYPE(TATT) :: tl_att 6233 6701 … … 6237 6705 IF( ALLOCATED(tg_varextra) )THEN 6238 6706 6239 il_ varid=var_get_id( tg_varextra(:), TRIM(td_var%c_name), &6240 TRIM(td_var%c_stdname))6241 IF( il_ varid /= 0 )THEN6707 il_ind=var_get_index( tg_varextra(:), TRIM(td_var%c_name), & 6708 TRIM(td_var%c_stdname)) 6709 IF( il_ind /= 0 )THEN 6242 6710 6243 6711 ! name 6244 6712 IF( TRIM(td_var%c_name) == '' .AND. & 6245 & TRIM(tg_varextra(il_ varid)%c_name) /= '' )THEN6246 td_var%c_name=TRIM(tg_varextra(il_ varid)%c_name)6713 & TRIM(tg_varextra(il_ind)%c_name) /= '' )THEN 6714 td_var%c_name=TRIM(tg_varextra(il_ind)%c_name) 6247 6715 ENDIF 6248 6716 6249 6717 ! standard name 6250 IF( TRIM(td_var%c_stdname) == '' .AND. & 6251 & TRIM(tg_varextra(il_varid)%c_stdname) /= '' )THEN 6252 td_var%c_stdname=TRIM(tg_varextra(il_varid)%c_stdname) 6718 IF( TRIM(tg_varextra(il_ind)%c_stdname) /= '' .AND. & 6719 & ( TRIM(td_var%c_stdname) == '' .OR. & 6720 & TRIM(tg_varextra(il_ind)%c_stdname) /= & 6721 & TRIM(td_var%c_stdname) ) )THEN 6722 td_var%c_stdname=TRIM(tg_varextra(il_ind)%c_stdname) 6253 6723 ! create attibute 6254 6724 tl_att=att_init('standard_name',TRIM(td_var%c_stdname)) … … 6257 6727 6258 6728 ! long_name 6259 IF( TRIM(td_var%c_longname) == '' .AND. & 6260 & TRIM(tg_varextra(il_varid)%c_longname) /= '' )THEN 6261 td_var%c_longname=TRIM(tg_varextra(il_varid)%c_longname) 6729 IF( TRIM(tg_varextra(il_ind)%c_longname) /= '' .AND. & 6730 & ( TRIM(td_var%c_longname) == '' .OR. & 6731 & TRIM(tg_varextra(il_ind)%c_longname) /= & 6732 & TRIM(td_var%c_longname) ) )THEN 6733 td_var%c_longname=TRIM(tg_varextra(il_ind)%c_longname) 6262 6734 ! create attibute 6263 tl_att=att_init('long_name',TRIM(td_var%c_ stdname))6735 tl_att=att_init('long_name',TRIM(td_var%c_longname)) 6264 6736 CALL var_move_att(td_var, tl_att) 6265 6737 ENDIF … … 6267 6739 ! units 6268 6740 IF( TRIM(td_var%c_units) == '' .AND. & 6269 & TRIM(tg_varextra(il_ varid)%c_units) /= '' )THEN6270 td_var%c_units=TRIM(tg_varextra(il_ varid)%c_units)6741 & TRIM(tg_varextra(il_ind)%c_units) /= '' )THEN 6742 td_var%c_units=TRIM(tg_varextra(il_ind)%c_units) 6271 6743 ! create attibute 6272 6744 tl_att=att_init('units',TRIM(td_var%c_units)) … … 6275 6747 6276 6748 ! axis 6277 IF( TRIM(td_var%c_axis) == '' .AND. & 6278 & TRIM(tg_varextra(il_varid)%c_axis) /= '' )THEN 6279 td_var%c_axis=TRIM(tg_varextra(il_varid)%c_axis) 6749 IF( TRIM(tg_varextra(il_ind)%c_axis) /= '' .AND. & 6750 & ( TRIM(td_var%c_axis) == '' .OR. & 6751 & TRIM(tg_varextra(il_ind)%c_axis) /= & 6752 & TRIM(td_var%c_axis) ) )THEN 6753 td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis) 6280 6754 ! create attibute 6281 6755 tl_att=att_init('axis',TRIM(td_var%c_axis)) … … 6284 6758 6285 6759 ! grid point 6286 IF( TRIM(td_var%c_point) == '' .AND. & 6287 & TRIM(tg_varextra(il_varid)%c_point) /= '' )THEN 6288 td_var%c_point=TRIM(tg_varextra(il_varid)%c_point) 6760 IF( TRIM(tg_varextra(il_ind)%c_point) /= '' .AND. & 6761 & ( TRIM(td_var%c_point) == '' .OR. & 6762 & TRIM(tg_varextra(il_ind)%c_point) /= & 6763 & TRIM(td_var%c_point) ) )THEN 6764 td_var%c_point=TRIM(tg_varextra(il_ind)%c_point) 6289 6765 ELSE 6290 CALL logger_warn("VAR GET EXTRA: unknown grid point "//& 6291 & "for variable "//TRIM(td_var%c_name)//& 6292 & ". assume it is a T-point.") 6293 td_var%c_point='T' 6766 IF( TRIM(td_var%c_point) == '' )THEN 6767 CALL logger_warn("VAR GET EXTRA: unknown grid point "//& 6768 & "for variable "//TRIM(td_var%c_name)//& 6769 & ". assume it is a T-point.") 6770 td_var%c_point='T' 6771 ENDIF 6294 6772 ENDIF 6295 6773 ! create attibute … … 6297 6775 CALL var_move_att(td_var, tl_att) 6298 6776 6777 ! clean 6778 CALL att_clean(tl_att) 6779 6299 6780 ! interp 6300 6781 IF( TRIM(td_var%c_interp(1)) == '' .AND. & 6301 & TRIM(tg_varextra(il_ varid)%c_interp(1)) /= '' )THEN6302 td_var%c_interp(:)=tg_varextra(il_ varid)%c_interp(:)6782 & TRIM(tg_varextra(il_ind)%c_interp(1)) /= '' )THEN 6783 td_var%c_interp(:)=tg_varextra(il_ind)%c_interp(:) 6303 6784 ENDIF 6304 6785 6305 6786 ! extrap 6306 6787 IF( TRIM(td_var%c_extrap(1)) == '' .AND. & 6307 & TRIM(tg_varextra(il_ varid)%c_extrap(1)) /= '' )THEN6308 td_var%c_extrap(:)=tg_varextra(il_ varid)%c_extrap(:)6788 & TRIM(tg_varextra(il_ind)%c_extrap(1)) /= '' )THEN 6789 td_var%c_extrap(:)=tg_varextra(il_ind)%c_extrap(:) 6309 6790 ENDIF 6310 6791 6311 6792 ! filter 6312 6793 IF( TRIM(td_var%c_filter(1)) == '' .AND. & 6313 & TRIM(tg_varextra(il_ varid)%c_filter(1)) /= '' )THEN6314 td_var%c_filter(:)=tg_varextra(il_ varid)%c_filter(:)6794 & TRIM(tg_varextra(il_ind)%c_filter(1)) /= '' )THEN 6795 td_var%c_filter(:)=tg_varextra(il_ind)%c_filter(:) 6315 6796 ENDIF 6316 6797 6317 6798 ! min value 6318 IF( td_var%d_min == d g_fill .AND. &6319 & tg_varextra(il_ varid)%d_min /= dg_fill )THEN6320 td_var%d_min=tg_varextra(il_ varid)%d_min6799 IF( td_var%d_min == dp_fill .AND. & 6800 & tg_varextra(il_ind)%d_min /= dp_fill )THEN 6801 td_var%d_min=tg_varextra(il_ind)%d_min 6321 6802 ENDIF 6322 6803 6323 6804 ! max value 6324 IF( td_var%d_max == d g_fill .AND. &6325 & tg_varextra(il_ varid)%d_max /= dg_fill )THEN6326 td_var%d_max=tg_varextra(il_ varid)%d_max6805 IF( td_var%d_max == dp_fill .AND. & 6806 & tg_varextra(il_ind)%d_max /= dp_fill )THEN 6807 td_var%d_max=tg_varextra(il_ind)%d_max 6327 6808 ENDIF 6328 6809 … … 6346 6827 6347 6828 END SUBROUTINE var__get_extra 6348 !> @endcode6349 6829 !------------------------------------------------------------------- 6350 6830 !> @brief 6351 6831 !> This function check if variable information read in namelist contains 6352 !> minimum value and return it if true 6832 !> minimum value and return it if true. 6353 6833 !> 6354 6834 !> @details … … 6356 6836 !> 6357 6837 !> @author J.Paul 6358 !> - Nov, 2013- Initial Version 6359 ! 6360 !> @param[in] cd_varinfo : variable information read in namelist 6361 !------------------------------------------------------------------- 6362 !> @code 6838 !> - November, 2013- Initial Version 6839 ! 6840 !> @param[in] cd_name variable name 6841 !> @param[in] cd_varinfo variable information read in namelist 6842 !> @return minimum value to be used (FillValue if none) 6843 !------------------------------------------------------------------- 6363 6844 FUNCTION var__get_min( cd_name, cd_varinfo ) 6364 6845 IMPLICIT NONE … … 6381 6862 ! init 6382 6863 cl_min='' 6383 var__get_min=d g_fill6864 var__get_min=dp_fill 6384 6865 6385 6866 ji=1 … … 6398 6879 IF( fct_is_num(cl_min) )THEN 6399 6880 READ(cl_min,*) var__get_min 6400 CALL logger_ info("VAR GET MIN: will use minimum value of "//&6881 CALL logger_debug("VAR GET MIN: will use minimum value of "//& 6401 6882 & TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) ) 6402 6883 ELSE … … 6407 6888 6408 6889 END FUNCTION var__get_min 6409 !> @endcode6410 6890 !------------------------------------------------------------------- 6411 6891 !> @brief 6412 6892 !> This function check if variable information read in namelist contains 6413 !> maximum value and return it if true 6893 !> maximum value and return it if true. 6414 6894 !> 6415 6895 !> @details … … 6417 6897 !> 6418 6898 !> @author J.Paul 6419 !> - Nov, 2013- Initial Version 6420 ! 6421 !> @param[in] cd_varinfo : variable information read in namelist 6422 !------------------------------------------------------------------- 6423 !> @code 6899 !> - November, 2013- Initial Version 6900 ! 6901 !> @param[in] cd_name variable name 6902 !> @param[in] cd_varinfo variable information read in namelist 6903 !> @return maximum value to be used (FillValue if none) 6904 !------------------------------------------------------------------- 6424 6905 FUNCTION var__get_max( cd_name, cd_varinfo ) 6425 6906 IMPLICIT NONE … … 6442 6923 ! init 6443 6924 cl_max='' 6444 var__get_max=d g_fill6925 var__get_max=dp_fill 6445 6926 6446 6927 ji=1 … … 6459 6940 IF( fct_is_num(cl_max) )THEN 6460 6941 READ(cl_max,*) var__get_max 6461 CALL logger_ info("VAR GET MAX: will use maximum value of "//&6942 CALL logger_debug("VAR GET MAX: will use maximum value of "//& 6462 6943 & TRIM(fct_str(var__get_max))//" for variable "//TRIM(cd_name) ) 6463 6944 ELSE … … 6468 6949 6469 6950 END FUNCTION var__get_max 6470 !> @endcode6471 6951 !------------------------------------------------------------------- 6472 6952 !> @brief 6473 6953 !> This function check if variable information read in namelist contains 6474 !> interpolation method and return it if true 6954 !> interpolation method and return it if true. 6475 6955 !> 6476 6956 !> @details 6957 !> split namelist information, using ';' as separator. 6958 !> compare method name with the list of interpolation method available (see 6959 !> module global). 6960 !> check if factor (*rhoi, /rhoj..) are present.<br/> 6961 !> Example:<br/> 6962 !> - cubic/rhoi ; dist_weight 6963 !> - bilin 6964 !> see @ref interp module for more information. 6477 6965 !> 6478 6966 !> @author J.Paul 6479 !> - Nov, 2013- Initial Version 6480 ! 6481 !> @param[in] cd_varinfo : variable information read in namelist 6482 !------------------------------------------------------------------- 6483 !> @code 6967 !> - November, 2013- Initial Version 6968 ! 6969 !> @param[in] cd_name variable name 6970 !> @param[in] cd_varinfo variable information read in namelist 6971 !> @return array of character information about interpolation 6972 !------------------------------------------------------------------- 6484 6973 FUNCTION var__get_interp( cd_name, cd_varinfo ) 6485 6974 IMPLICIT NONE … … 6511 7000 cl_tmp=fct_split(cd_varinfo,ji,';') 6512 7001 DO WHILE( TRIM(cl_tmp) /= '' ) 6513 DO jj=1,i g_ninterp6514 il_ind= INDEX(fct_lower(cl_tmp),TRIM(c g_interp_list(jj)))7002 DO jj=1,ip_ninterp 7003 il_ind= INDEX(fct_lower(cl_tmp),TRIM(cp_interp_list(jj))) 6515 7004 IF( il_ind /= 0 )THEN 6516 7005 6517 var__get_interp(1)=TRIM(c g_interp_list(jj))6518 il_len=LEN(TRIM(c g_interp_list(jj)))7006 var__get_interp(1)=TRIM(cp_interp_list(jj)) 7007 il_len=LEN(TRIM(cp_interp_list(jj))) 6519 7008 6520 7009 ! look for factor … … 6563 7052 ENDIF 6564 7053 ENDDO 6565 IF( jj /= i g_ninterp + 1 ) EXIT7054 IF( jj /= ip_ninterp + 1 ) EXIT 6566 7055 ji=ji+1 6567 7056 cl_tmp=fct_split(cd_varinfo,ji,';') … … 6569 7058 6570 7059 END FUNCTION var__get_interp 6571 !> @endcode6572 7060 !------------------------------------------------------------------- 6573 7061 !> @brief 6574 7062 !> This function check if variable information read in namelist contains 6575 !> extrapolation method and return it if true 7063 !> extrapolation method and return it if true. 6576 7064 !> 6577 7065 !> @details 7066 !> split namelist information, using ';' as separator. 7067 !> compare method name with the list of extrapolation method available (see 7068 !> module global).<br/> 7069 !> Example:<br/> 7070 !> - cubic ; dist_weight 7071 !> - min_error 7072 !> see @ref extrap module for more information. 6578 7073 !> 6579 7074 !> @author J.Paul 6580 !> - Nov, 2013- Initial Version 6581 ! 6582 !> @param[in] cd_varinfo : variable information read in namelist 6583 !------------------------------------------------------------------- 6584 !> @code 7075 !> - November, 2013- Initial Version 7076 ! 7077 !> @param[in] cd_name variable name 7078 !> @param[in] cd_varinfo variable information read in namelist 7079 !> @return array of character information about extrapolation 7080 !------------------------------------------------------------------- 6585 7081 FUNCTION var__get_extrap( cd_name, cd_varinfo ) 6586 7082 IMPLICIT NONE … … 6605 7101 cl_tmp=fct_split(cd_varinfo,ji,';') 6606 7102 DO WHILE( TRIM(cl_tmp) /= '' ) 6607 DO jj=1,i g_nextrap6608 IF( TRIM(fct_lower(cl_tmp)) == TRIM(c g_extrap_list(jj)) )THEN6609 var__get_extrap(1)=TRIM(c g_extrap_list(jj))6610 6611 CALL logger_ info("VAR GET EXTRAP: variable "//TRIM(cd_name)//&7103 DO jj=1,ip_nextrap 7104 IF( TRIM(fct_lower(cl_tmp)) == TRIM(cp_extrap_list(jj)) )THEN 7105 var__get_extrap(1)=TRIM(cp_extrap_list(jj)) 7106 7107 CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//& 6612 7108 & " will use extrapolation method "//TRIM(var__get_extrap(1)) ) 6613 7109 … … 6615 7111 ENDIF 6616 7112 ENDDO 6617 IF( jj /= i g_nextrap + 1 ) EXIT7113 IF( jj /= ip_nextrap + 1 ) EXIT 6618 7114 ji=ji+1 6619 7115 cl_tmp=fct_split(cd_varinfo,ji,';') … … 6622 7118 6623 7119 END FUNCTION var__get_extrap 6624 !> @endcode6625 7120 !------------------------------------------------------------------- 6626 7121 !> @brief … … 6629 7124 !> 6630 7125 !> @details 7126 !> split namelist information, using ';' as separator. 7127 !> compare method name with the list of filter method available (see 7128 !> module global). 7129 !> look for the number of turn, using '*' separator, and method parameters inside 7130 !> bracket.<br/> 7131 !> Example:<br/> 7132 !> - cubic ; 2*hamming(2,3) 7133 !> - hann 7134 !> see @ref filter module for more information. 6631 7135 !> 6632 7136 !> @author J.Paul 6633 !> - Nov , 2013- Initial Version6634 ! 6635 !> @param[in] cd_ varinfo : variable information read in namelist6636 ! -------------------------------------------------------------------6637 ! > @code7137 !> - November, 2013- Initial Version 7138 ! 7139 !> @param[in] cd_name variable name 7140 !> @param[in] cd_varinfo variable information read in namelist 7141 !------------------------------------------------------------------- 6638 7142 FUNCTION var__get_filter( cd_name, cd_varinfo ) 6639 7143 IMPLICIT NONE … … 6659 7163 cl_tmp=fct_split(cd_varinfo,ji,';') 6660 7164 DO WHILE( TRIM(cl_tmp) /= '' ) 6661 DO jj=1,i g_nfilter6662 il_ind=INDEX(fct_lower(cl_tmp),TRIM(c g_filter_list(jj)))7165 DO jj=1,ip_nfilter 7166 il_ind=INDEX(fct_lower(cl_tmp),TRIM(cp_filter_list(jj))) 6663 7167 IF( il_ind /= 0 )THEN 6664 var__get_filter(1)=TRIM(c g_filter_list(jj))7168 var__get_filter(1)=TRIM(cp_filter_list(jj)) 6665 7169 6666 7170 ! look for number of turn … … 6711 7215 ENDIF 6712 7216 ENDDO 6713 IF( jj /= i g_nfilter + 1 ) EXIT7217 IF( jj /= ip_nfilter + 1 ) EXIT 6714 7218 ji=ji+1 6715 7219 cl_tmp=fct_split(cd_varinfo,ji,';') … … 6717 7221 6718 7222 END FUNCTION var__get_filter 6719 !> @endcode6720 7223 !------------------------------------------------------------------- 6721 7224 !> @brief 6722 7225 !> This function search and save the biggest dimensions use 6723 !> in those variables. 6724 !> 6725 ! 7226 !> in an array of variable structure. 7227 !> 6726 7228 !> @author J.Paul 6727 !> - Nov, 2013- Initial Version 6728 ! 6729 !> @param[in] td_var : table of variable structure 6730 !> @return table of dimension 6731 !------------------------------------------------------------------- 6732 !> @code 7229 !> - November, 2013- Initial Version 7230 ! 7231 !> @param[in] td_var array of variable structure 7232 !> @return array of dimension 7233 !------------------------------------------------------------------- 6733 7234 FUNCTION var_max_dim(td_var) 6734 7235 IMPLICIT NONE … … 6749 7250 il_nvar=SIZE(td_var(:)) 6750 7251 6751 var_max_dim(:)=td_var(1)%t_dim(:) 6752 6753 DO ji=2,il_nvar 6754 6755 IF( td_var(ji)%t_dim(1)%l_use .AND. & 6756 & td_var(ji)%t_dim(1)%i_len >= var_max_dim(1)%i_len )THEN 6757 var_max_dim(1)=td_var(ji)%t_dim(1) 6758 ENDIF 6759 6760 IF( td_var(ji)%t_dim(2)%l_use .AND. & 6761 & td_var(ji)%t_dim(2)%i_len >= var_max_dim(2)%i_len )THEN 6762 var_max_dim(2)=td_var(ji)%t_dim(2) 6763 ENDIF 6764 6765 IF( td_var(ji)%t_dim(3)%l_use .AND. & 6766 & td_var(ji)%t_dim(3)%i_len >= var_max_dim(3)%i_len )THEN 6767 var_max_dim(3)=td_var(ji)%t_dim(3) 6768 ENDIF 6769 6770 IF( td_var(ji)%t_dim(4)%l_use .AND. & 6771 & td_var(ji)%t_dim(4)%i_len >= var_max_dim(4)%i_len )THEN 6772 var_max_dim(4)=td_var(ji)%t_dim(4) 6773 ENDIF 6774 6775 ENDDO 7252 var_max_dim(:)=dim_copy(td_var(1)%t_dim(:)) 7253 7254 IF( il_nvar > 1 )THEN 7255 DO ji=2,il_nvar 7256 7257 IF( td_var(ji)%t_dim(1)%l_use .AND. & 7258 & td_var(ji)%t_dim(1)%i_len >= var_max_dim(1)%i_len )THEN 7259 var_max_dim(1)=dim_copy(td_var(ji)%t_dim(1)) 7260 ENDIF 7261 7262 IF( td_var(ji)%t_dim(2)%l_use .AND. & 7263 & td_var(ji)%t_dim(2)%i_len >= var_max_dim(2)%i_len )THEN 7264 var_max_dim(2)=dim_copy(td_var(ji)%t_dim(2)) 7265 ENDIF 7266 7267 IF( td_var(ji)%t_dim(3)%l_use .AND. & 7268 & td_var(ji)%t_dim(3)%i_len >= var_max_dim(3)%i_len )THEN 7269 var_max_dim(3)=dim_copy(td_var(ji)%t_dim(3)) 7270 ENDIF 7271 7272 IF( td_var(ji)%t_dim(4)%l_use .AND. & 7273 & td_var(ji)%t_dim(4)%i_len >= var_max_dim(4)%i_len )THEN 7274 var_max_dim(4)=dim_copy(td_var(ji)%t_dim(4)) 7275 ENDIF 7276 7277 ENDDO 7278 ENDIF 6776 7279 6777 7280 END FUNCTION var_max_dim 6778 !> @endcode6779 7281 !------------------------------------------------------------------- 6780 7282 !> @brief 6781 !> This subroutine forced minimum and maximum value of variable. 7283 !> This subroutine forced minimum and maximum value of variable, 7284 !> with value of variable structure attribute d_min and d_max. 6782 7285 !> 6783 !> @details6784 !>6785 7286 !> @author J.Paul 6786 !> - Nov, 2013- Initial Version 6787 ! 6788 !> @param[inout] td_var : variable structure 6789 !------------------------------------------------------------------- 6790 !> @code 7287 !> - November, 2013- Initial Version 7288 ! 7289 !> @param[inout] td_var variable structure 7290 !------------------------------------------------------------------- 6791 7291 SUBROUTINE var_limit_value( td_var ) 6792 7292 IMPLICIT NONE … … 6801 7301 IF( ASSOCIATED(td_var%d_value) )THEN 6802 7302 !1- forced minimum value 6803 IF( td_var%d_min /= d g_fill )THEN7303 IF( td_var%d_min /= dp_fill )THEN 6804 7304 WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. & 6805 7305 & td_var%d_value(:,:,:,:) < td_var%d_min ) … … 6809 7309 6810 7310 !2- forced maximum value 6811 IF( td_var%d_max /= d g_fill )THEN7311 IF( td_var%d_max /= dp_fill )THEN 6812 7312 WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. & 6813 7313 & td_var%d_value(:,:,:,:) > td_var%d_max ) … … 6819 7319 6820 7320 END SUBROUTINE var_limit_value 6821 !> @endcode6822 7321 !------------------------------------------------------------------- 6823 7322 !> @brief 6824 !> This subroutine forced minimum and maximum value of variable. 7323 !> This subroutine check variable dimension expected, as defined in 7324 !> file 'variable.cfg'. 6825 7325 !> 6826 7326 !> @details 7327 !> compare dimension used in variable structure with string character 7328 !> axis from configuration file. 6827 7329 !> 6828 7330 !> @author J.Paul 6829 !> - Nov, 2013- Initial Version 6830 ! 6831 !> @param[inout] td_var : variable structure 6832 !------------------------------------------------------------------- 6833 !> @code 7331 !> - November, 2013- Initial Version 7332 ! 7333 !> @param[inout] td_var variable structure 7334 !------------------------------------------------------------------- 6834 7335 SUBROUTINE var_check_dim( td_var ) 6835 7336 IMPLICIT NONE … … 6879 7380 CALL logger_warn("VAR CHECK DIM: too much dimension for "//& 6880 7381 & "variable "//TRIM(td_var%c_name)//".") 7382 cl_dim=TRIM(fct_upper(cp_dimorder)) 7383 il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) ) 6881 7384 DO ji=1,il_ndim 6882 7385 IF( INDEX(TRIM(td_var%c_axis),cl_dim(ji:ji)) == 0 )THEN 6883 IF( td_var%t_dim(ji)%i_len == 1 )THEN 6884 ! remove unuseful dimension 6885 CALL var_del_dim(td_var,td_var%t_dim(ji)) 6886 ELSE 6887 CALL logger_warn("VAR CHECK DIM: variable "//& 6888 & TRIM(td_var%c_name)//" should not use"//& 6889 & " dimension "//TRIM(td_var%t_dim(ji)%c_name)) 7386 IF( td_var%t_dim(ji)%l_use )THEN 7387 IF( td_var%t_dim(ji)%i_len == 1 )THEN 7388 ! remove unuseful dimension 7389 CALL var_del_dim(td_var,td_var%t_dim(ji)) 7390 ELSE 7391 CALL logger_warn("VAR CHECK DIM: variable "//& 7392 & TRIM(td_var%c_name)//" should not use"//& 7393 & " dimension "//TRIM(td_var%t_dim(ji)%c_name)) 7394 ENDIF 6890 7395 ENDIF 6891 7396 ENDIF … … 6898 7403 6899 7404 END SUBROUTINE var_check_dim 6900 !> @endcode 7405 !------------------------------------------------------------------- 7406 !> @brief 7407 !> This subroutine reshape variable value and dimension 7408 !> in variable structure. 7409 !> @details 7410 !> output dimension will be ordered as defined in 7411 !> input array of dimension 7412 !> Optionaly you could specify output dimension order with 7413 !> string character of dimension 7414 !> 7415 !> @author J.Paul 7416 !> - August, 2014- Initial Version 7417 ! 7418 !> @param[inout] td_var variable structure 7419 !> @param[in] cd_dimorder string character of dimension order to be used 7420 !------------------------------------------------------------------- 7421 SUBROUTINE var_reorder( td_var, cd_dimorder ) 7422 IMPLICIT NONE 7423 ! Argument 7424 TYPE(TVAR) , INTENT(INOUT) :: td_var 7425 CHARACTER(LEN=ip_maxdim), INTENT(IN ), OPTIONAL :: cd_dimorder 7426 7427 ! local variable 7428 CHARACTER(LEN=lc) :: cl_dimorder 7429 7430 REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value 7431 7432 TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim 7433 7434 ! loop indices 7435 !---------------------------------------------------------------- 7436 7437 cl_dimorder=TRIM(cp_dimorder) 7438 IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 7439 7440 tl_dim(:)=dim_copy(td_var%t_dim(:)) 7441 7442 CALL dim_unorder(tl_dim(:)) 7443 CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder)) 7444 7445 ALLOCATE(dl_value(tl_dim(1)%i_len, & 7446 & tl_dim(2)%i_len, & 7447 & tl_dim(3)%i_len, & 7448 & tl_dim(4)%i_len )) 7449 7450 dl_value(:,:,:,:)=dim_reshape_2xyzt(tl_dim, & 7451 & td_var%d_value(:,:,:,:)) 7452 7453 ! change dimension 7454 td_var%t_dim(:)=dim_copy(tl_dim(:)) 7455 ! change value 7456 DEALLOCATE( td_var%d_value ) 7457 CALL var_add_value(td_var, dl_value(:,:,:,:)) 7458 7459 ! clean 7460 DEALLOCATE(dl_value) 7461 CALL dim_clean(tl_dim(:)) 7462 7463 END SUBROUTINE var_reorder 7464 !------------------------------------------------------------------- 7465 !> @brief 7466 !> This function get the next unused unit in array of variable structure. 7467 !> 7468 !> @author J.Paul 7469 !> - September, 2014- Initial Version 7470 ! 7471 !> @param[in] td_var array of variable structure 7472 !> @return free variable id 7473 !------------------------------------------------------------------- 7474 FUNCTION var_get_unit(td_var) 7475 IMPLICIT NONE 7476 ! Argument 7477 TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var 7478 7479 ! function 7480 INTEGER(i4) :: var_get_unit 7481 7482 ! local variable 7483 ! loop indices 7484 !---------------------------------------------------------------- 7485 7486 var_get_unit=MAXVAL(td_var(:)%i_id)+1 7487 7488 END FUNCTION var_get_unit 7489 !------------------------------------------------------------------- 7490 !> @brief 7491 !> This function convert a time variable structure in date structure. 7492 !> 7493 !> @author J.Paul 7494 !> - November, 2014- Initial Version 7495 ! 7496 !> @param[in] td_var time variable structure 7497 !> @return date structure 7498 !------------------------------------------------------------------- 7499 FUNCTION var_to_date(td_var) 7500 IMPLICIT NONE 7501 ! Argument 7502 TYPE(TVAR), INTENT(IN) :: td_var 7503 7504 ! function 7505 TYPE(TDATE) :: var_to_date 7506 7507 ! local variable 7508 CHARACTER(LEN=lc) :: cl_step 7509 CHARACTER(LEN=lc) :: cl_date 7510 7511 INTEGER(i4) :: il_attid 7512 7513 INTEGER(i8) :: kl_nsec 7514 7515 TYPE(TDATE) :: tl_dateo 7516 ! loop indices 7517 !---------------------------------------------------------------- 7518 7519 IF( INDEX(TRIM(td_var%c_name),'time') /= 0 )THEN 7520 IF( ASSOCIATED(td_var%d_value) )THEN 7521 7522 il_attid=att_get_index(td_var%t_att(:),'units') 7523 IF( il_attid /=0 )THEN 7524 cl_step=fct_split(td_var%t_att(il_attid)%c_value,1,'since') 7525 cl_date=fct_split(td_var%t_att(il_attid)%c_value,2,'since') 7526 7527 SELECT CASE(TRIM(cl_step)) 7528 CASE('seconds') 7529 kl_nsec=INT(td_var%d_value(1,1,1,1),i8) 7530 CASE('days') 7531 kl_nsec=INT(td_var%d_value(1,1,1,1)*86400,i8) 7532 CASE DEFAULT 7533 CALL logger_error("VAR TO DATE: unknown units format "//& 7534 & "in variable "//TRIM(td_var%c_name)) 7535 END SELECT 7536 7537 tl_dateo=date_init(cl_date) 7538 7539 var_to_date=date_init(kl_nsec,tl_dateo) 7540 7541 ELSE 7542 CALL logger_error("VAR TO DATE: no attribute units in "//& 7543 & "variable "//TRIM(td_var%c_name)) 7544 ENDIF 7545 ELSE 7546 CALL logger_error("VAR TO DATE: no value associated to "//& 7547 & "variable "//TRIM(td_var%c_name)) 7548 ENDIF 7549 ELSE 7550 CALL logger_error("VAR TO DATE: variable "//TRIM(td_var%c_name)//& 7551 & "can not be convert in date.") 7552 ENDIF 7553 7554 END FUNCTION var_to_date 6901 7555 END MODULE var 6902 7556
Note: See TracChangeset
for help on using the changeset viewer.