Changeset 5837 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/TOOLS/SIREN/src/attribute.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/attribute.f90
r4213 r5837 8 8 !> @brief 9 9 !> This module manage attribute of variable or file. 10 ! 10 !> 11 11 !> @details 12 12 !> define type TATT:<br/> 13 !> TYPE(TATT) :: tl_att<br/> 13 !> @code 14 !> TYPE(TATT) :: tl_att 15 !> @endcode 14 16 !> 15 17 !> the attribute value inside attribute structure will be 16 !> character or real(8) 1D table.<br/>17 !> However the attribute value could be initiali sed with:<br/>18 !> character or real(8) 1D array.<br/> 19 !> However the attribute value could be initialized with:<br/> 18 20 !> - character 19 21 !> - scalar (real(4), real(8), integer(4) or integer(8)) 20 !> - table1D (real(4), real(8), integer(4) or integer(8))22 !> - array 1D (real(4), real(8), integer(4) or integer(8)) 21 23 !> 22 !> to initialise an attribute structure :<br/> 23 !> tl_att=att_init('attname',value)<br/> 24 !> tl_att=att_init('attname',tab_value)<br/> 24 !> to initialize an attribute structure :<br/> 25 !> @code 26 !> tl_att=att_init('attname',value) 27 !> @endcode 28 !> - value is a character, scalar value or table of value 25 29 !> 26 !> to print attribute information of one attribute structure:<br/> 30 !> to print attribute information of one or array of attribute structure:<br/> 31 !> @code 27 32 !> CALL att_print(td_att) 33 !> @endcode 28 34 !> 35 !> to clean attribute structure:<br/> 36 !> @code 37 !> CALL att_clean(td_att) 38 !> @endcode 39 !> 40 !> to copy attribute structure in another one (using different memory cell):<br/> 41 !> @code 42 !> tl_att2=att_copy(tl_att1) 43 !> @endcode 44 !> @note as we use pointer for the value array of the attribute structure, 45 !> the use of the assignment operator (=) to copy attribute structure 46 !> create a pointer on the same array. 47 !> This is not the case with this copy function. 48 !> 49 !> to get attribute index, in an array of attribute structure:<br/> 50 !> @code 51 !> il_index=att_get_index( td_att, cd_name ) 52 !> @endcode 53 !> - td_att array of attribute structure 54 !> - cd_name attribute name 55 !> 56 !> to get attribute id, read from a file:<br/> 57 !>@code 58 !> il_id=att_get_id( td_att, cd_name ) 59 !>@endcode 60 !> - td_att array of attribute structure 61 !> - cd_name attribute name 62 !> 63 !> to get attribute name 64 !> - tl_att\%c_name 65 !> 29 66 !> to get character length or the number of value store in attribute 30 67 !> - tl_att\%i_len … … 38 75 !> - tl_att\%i_type 39 76 !> 40 !> to get attribute id (affected when attributes will be added to 41 !> variable or file):<br/> 77 !> to get attribute id (read from file):<br/> 42 78 !> - tl_att\%i_id 43 79 !> 44 !> @author 45 !> J.Paul 80 !> @author J.Paul 46 81 ! REVISION HISTORY: 47 !> @date Nov, 2013 - Initial Version 82 !> @date November, 2013 - Initial Version 83 !> @date November, 2014 - Fix memory leaks bug 48 84 ! 49 85 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !> @todo51 86 !---------------------------------------------------------------------- 52 87 MODULE att … … 54 89 USE global ! global variable 55 90 USE kind ! F90 kind parameter 56 USE logger 91 USE logger ! log file manager 57 92 USE fct ! basic useful function 58 93 IMPLICIT NONE 59 PRIVATE60 94 ! NOTE_avoid_public_variables_if_possible 61 95 62 96 ! type and variable 63 PUBLIC :: TATT ! attribute structure97 PUBLIC :: TATT !< attribute structure 64 98 65 99 ! function and subroutine 66 PUBLIC :: ASSIGNMENT(=) ! copy attribute structure 67 PUBLIC :: att_init ! initialize attribute structure 68 PUBLIC :: att_print ! print attribute structure 69 PUBLIC :: att_get_id ! get attribute id in table of attribute structure 70 PUBLIC :: att_clean ! clean attribute strcuture 71 72 PRIVATE :: att__init_c ! initialise an attribute structure with character value 73 PRIVATE :: att__init_dp ! initialise an attribute structure with table of real(8) value 74 PRIVATE :: att__init_dp_0d ! initialise an attribute structure with real(8) value 75 PRIVATE :: att__init_sp ! initialise an attribute structure with table of real(4) value 76 PRIVATE :: att__init_sp_0d ! initialise an attribute structure with real(4) value 77 PRIVATE :: att__init_i1 ! initialise an attribute structure with table of integer(1) value 78 PRIVATE :: att__init_i1_0d ! initialise an attribute structure with integer(1) value 79 PRIVATE :: att__init_i2 ! initialise an attribute structure with table of integer(2) value 80 PRIVATE :: att__init_i2_0d ! initialise an attribute structure with integer(2) value 81 PRIVATE :: att__init_i4 ! initialise an attribute structure with table of integer(4) value 82 PRIVATE :: att__init_i4_0d ! initialise an attribute structure with integer(4) value 83 PRIVATE :: att__init_i8 ! initialise an attribute structure with table of integer(8) value 84 PRIVATE :: att__init_i8_0d ! initialise an attribute structure with integer(8) value 85 PRIVATE :: att__copy_unit ! copy attribute structure 86 PRIVATE :: att__copy_tab ! copy attribute structure 87 88 !> @struct TATT 89 TYPE TATT 90 !CHARACTER(LEN=lc) :: c_name = 'unknown' !< attribute name 91 CHARACTER(LEN=lc) :: c_name = '' !< attribute name 92 INTEGER(i4) :: i_id = 0 !< attribute id 93 INTEGER(i4) :: i_type = 0 !< attribute type 100 PUBLIC :: att_init !< initialize attribute structure 101 PUBLIC :: att_print !< print attribute structure 102 PUBLIC :: att_clean !< clean attribute strcuture 103 PUBLIC :: att_copy !< copy attribute structure 104 PUBLIC :: att_get_index !< get attribute index, in an array of attribute structure 105 PUBLIC :: att_get_id !< get attribute id, read from file 106 107 PRIVATE :: att__clean_unit ! clean attribute strcuture 108 PRIVATE :: att__clean_arr ! clean array of attribute strcuture 109 PRIVATE :: att__print_unit ! print information on one attribute 110 PRIVATE :: att__print_arr ! print information on a array of attribute 111 PRIVATE :: att__init_c ! initialize an attribute structure with character value 112 PRIVATE :: att__init_dp ! initialize an attribute structure with array of real(8) value 113 PRIVATE :: att__init_dp_0d ! initialize an attribute structure with real(8) value 114 PRIVATE :: att__init_sp ! initialize an attribute structure with array of real(4) value 115 PRIVATE :: att__init_sp_0d ! initialize an attribute structure with real(4) value 116 PRIVATE :: att__init_i1 ! initialize an attribute structure with array of integer(1) value 117 PRIVATE :: att__init_i1_0d ! initialize an attribute structure with integer(1) value 118 PRIVATE :: att__init_i2 ! initialize an attribute structure with array of integer(2) value 119 PRIVATE :: att__init_i2_0d ! initialize an attribute structure with integer(2) value 120 PRIVATE :: att__init_i4 ! initialize an attribute structure with array of integer(4) value 121 PRIVATE :: att__init_i4_0d ! initialize an attribute structure with integer(4) value 122 PRIVATE :: att__init_i8 ! initialize an attribute structure with array of integer(8) value 123 PRIVATE :: att__init_i8_0d ! initialize an attribute structure with integer(8) value 124 PRIVATE :: att__copy_unit ! copy attribute structure 125 PRIVATE :: att__copy_arr ! copy array of attribute structure 126 127 TYPE TATT !< attribute structure 128 CHARACTER(LEN=lc) :: c_name = '' !< attribute name 129 INTEGER(i4) :: i_id = 0 !< attribute id 130 INTEGER(i4) :: i_type = 0 !< attribute type 94 131 INTEGER(i4) :: i_len = 0 !< number of value store in attribute 95 132 CHARACTER(LEN=lc) :: c_value = "none" !< attribute value if type CHAR … … 113 150 END INTERFACE att_init 114 151 115 INTERFACE ASSIGNMENT(=) 116 MODULE PROCEDURE att__copy_unit ! copy attribute structure 117 MODULE PROCEDURE att__copy_tab ! copy attribute structure 152 INTERFACE att_print 153 MODULE PROCEDURE att__print_unit ! print information on one attribute 154 MODULE PROCEDURE att__print_arr ! print information on a array of attribute 155 END INTERFACE att_print 156 157 INTERFACE att_clean 158 MODULE PROCEDURE att__clean_unit 159 MODULE PROCEDURE att__clean_arr 118 160 END INTERFACE 119 161 162 INTERFACE att_copy 163 MODULE PROCEDURE att__copy_unit ! copy attribute structure 164 MODULE PROCEDURE att__copy_arr ! copy array of attribute structure 165 END INTERFACE 166 120 167 CONTAINS 121 168 !------------------------------------------------------------------- 122 169 !> @brief 123 !> This function copy attribute structure in another attribute 124 !> structure 170 !> This subroutine copy a array of attribute structure in another one 125 171 !> @details 126 !> attribute value are copied in a temporary table, so input and output 127 !> attribute structure value do not point on the same "memory cell", and so 128 !> on are independant. 129 !> 172 !> see att__copy_unit 173 !> 174 !> @warning do not use on the output of a function who create or read an 175 !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 176 !> This will create memory leaks. 130 177 !> @warning to avoid infinite loop, do not use any function inside 131 178 !> this subroutine 132 179 !> 133 180 !> @author J.Paul 134 !> - Nov, 2013- Initial Version 135 ! 136 !> @param[out] td_att1 : attribute structure 137 !> @param[in] td_att2 : attribute structure 138 !------------------------------------------------------------------- 139 ! @code 140 SUBROUTINE att__copy_tab( td_att1, td_att2 ) 141 IMPLICIT NONE 142 ! Argument 143 TYPE(TATT), DIMENSION(:) , INTENT(IN) :: td_att2 144 TYPE(TATT), DIMENSION(SIZE(td_att2(:))),INTENT(OUT) :: td_att1 181 !> @date November, 2013 - Initial Version 182 !> @date November, 2014 183 !> - use function instead of overload assignment operator 184 !> (to avoid memory leak) 185 ! 186 !> @param[in] td_att array of attribute structure 187 !> @return copy of input array of attribute structure 188 !------------------------------------------------------------------- 189 FUNCTION att__copy_arr( td_att ) 190 IMPLICIT NONE 191 ! Argument 192 TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att 193 ! function 194 TYPE(TATT), DIMENSION(SIZE(td_att(:))) :: att__copy_arr 145 195 146 196 ! local variable … … 149 199 !---------------------------------------------------------------- 150 200 151 DO ji=1,SIZE(td_att 2(:))152 td_att1(ji)=td_att2(ji)201 DO ji=1,SIZE(td_att(:)) 202 att__copy_arr(ji)=att_copy(td_att(ji)) 153 203 ENDDO 154 204 155 END SUBROUTINE att__copy_tab 156 ! @endcode 205 END FUNCTION att__copy_arr 157 206 !------------------------------------------------------------------- 158 207 !> @brief 159 !> This function copy attribute structure in another attribute 160 !> structure 208 !> This subroutine copy an attribute structure in another one. 161 209 !> @details 162 !> attribute value are copied in a temporary table, so input and output210 !> attribute value are copied in a temporary array, so input and output 163 211 !> attribute structure value do not point on the same "memory cell", and so 164 212 !> on are independant. 165 213 !> 214 !> @warning do not use on the output of a function who create or read an 215 !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 216 !> This will create memory leaks. 166 217 !> @warning to avoid infinite loop, do not use any function inside 167 218 !> this subroutine 168 219 !> 169 220 !> @author J.Paul 170 !> - Nov, 2013- Initial Version 171 ! 172 !> @param[out] td_att1 : attribute structure 173 !> @param[in] td_att2 : attribute structure 174 !------------------------------------------------------------------- 175 ! @code 176 SUBROUTINE att__copy_unit( td_att1, td_att2 ) 177 IMPLICIT NONE 178 ! Argument 179 TYPE(TATT), INTENT(OUT) :: td_att1 180 TYPE(TATT), INTENT(IN) :: td_att2 221 !> @date November, 2013 - Initial Version 222 !> @date November, 2014 223 !> - use function instead of overload assignment operator (to avoid memory leak) 224 !> 225 !> @param[in] td_att attribute structure 226 !> @return copy of input attribute structure 227 !------------------------------------------------------------------- 228 FUNCTION att__copy_unit( td_att ) 229 IMPLICIT NONE 230 ! Argument 231 TYPE(TATT), INTENT(IN) :: td_att 232 ! function 233 TYPE(TATT) :: att__copy_unit 181 234 182 235 ! local variable … … 184 237 !---------------------------------------------------------------- 185 238 186 CALL logger_trace("COPY: attribute "//TRIM(td_att2%c_name) )187 188 239 ! copy attribute variable 189 td_att1%c_name = TRIM(td_att2%c_name)190 td_att1%i_id = td_att2%i_id191 td_att1%i_type = td_att2%i_type192 td_att1%i_len = td_att2%i_len193 td_att1%c_value = TRIM(td_att2%c_value)240 att__copy_unit%c_name = TRIM(td_att%c_name) 241 att__copy_unit%i_id = td_att%i_id 242 att__copy_unit%i_type = td_att%i_type 243 att__copy_unit%i_len = td_att%i_len 244 att__copy_unit%c_value = TRIM(td_att%c_value) 194 245 195 246 ! copy attribute pointer in an independant variable 196 IF( ASSOCIATED( td_att1%d_value) ) DEALLOCATE(td_att1%d_value)197 IF( ASSOCIATED(td_att 2%d_value) )THEN198 ALLOCATE( dl_value(td_att 2%i_len) )199 dl_value(:) = td_att 2%d_value(:)200 201 ALLOCATE( td_att1%d_value(td_att1%i_len) )202 td_att1%d_value(:) = dl_value(:)247 IF( ASSOCIATED(att__copy_unit%d_value) ) DEALLOCATE(att__copy_unit%d_value) 248 IF( ASSOCIATED(td_att%d_value) )THEN 249 ALLOCATE( dl_value(td_att%i_len) ) 250 dl_value(:) = td_att%d_value(:) 251 252 ALLOCATE( att__copy_unit%d_value(att__copy_unit%i_len) ) 253 att__copy_unit%d_value(:) = dl_value(:) 203 254 204 255 DEALLOCATE( dl_value ) 205 256 ENDIF 206 257 207 END SUBROUTINEatt__copy_unit208 ! @endcode209 ! -------------------------------------------------------------------210 !> @brief This function get attribute id, in a table of attribute structure,211 !> given attribute name212 !> 213 !> @author J.Paul214 !> - Nov, 2013- Initial Version215 ! 216 ! > @param[in] td_att : attribute structure217 !> @param[in] cd_name : attribute name218 !> @ return attribute id219 ! -------------------------------------------------------------------220 ! @code221 INTEGER(i4) FUNCTION att_get_i d( td_att, cd_name )258 END FUNCTION att__copy_unit 259 !------------------------------------------------------------------- 260 !> @brief This function return attribute index, in a array of attribute structure, 261 !> given attribute name.<br/> 262 !> @details 263 !> if attribute name do not exist, return 0. 264 !> 265 !> @author J.Paul 266 !> @date Septempber, 2014 - Initial Version 267 ! 268 !> @param[in] td_att array of attribute structure 269 !> @param[in] cd_name attribute name 270 !> @return attribute index 271 !------------------------------------------------------------------- 272 INTEGER(i4) FUNCTION att_get_index( td_att, cd_name ) 222 273 IMPLICIT NONE 223 274 ! Argument … … 231 282 INTEGER(i4) :: ji 232 283 !---------------------------------------------------------------- 233 att_get_i d=0284 att_get_index=0 234 285 235 286 il_size=SIZE(td_att(:)) 236 287 DO ji=1,il_size 237 288 IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN 238 att_get_i d=ji289 att_get_index=ji 239 290 EXIT 240 291 ENDIF 241 292 ENDDO 242 293 294 END FUNCTION att_get_index 295 !------------------------------------------------------------------- 296 !> @brief This function return attribute id, read from a file.<br/> 297 !> @details 298 !> if attribute name do not exist, return 0. 299 !> 300 !> @author J.Paul 301 !> @date November, 2013 - Initial Version 302 !> @date September, 2014 - bug fix with use of id read from attribute structure 303 ! 304 !> @param[in] td_att array of attribute structure 305 !> @param[in] cd_name attribute name 306 !> @return attribute id 307 !------------------------------------------------------------------- 308 INTEGER(i4) FUNCTION att_get_id( td_att, cd_name ) 309 IMPLICIT NONE 310 ! Argument 311 TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att 312 CHARACTER(LEN=*), INTENT(IN) :: cd_name 313 314 ! local variable 315 INTEGER(i4) :: il_size 316 317 ! loop indices 318 INTEGER(i4) :: ji 319 !---------------------------------------------------------------- 320 att_get_id=0 321 322 il_size=SIZE(td_att(:)) 323 DO ji=1,il_size 324 IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN 325 att_get_id=td_att(ji)%i_id 326 EXIT 327 ENDIF 328 ENDDO 329 243 330 END FUNCTION att_get_id 244 !> @endcode 245 !------------------------------------------------------------------- 246 !> @brief This function initialise an attribute structure with character 247 !> value 248 !> 249 !> @author J.Paul 250 !> - Nov, 2013- Initial Version 251 ! 252 !> @param[in] cd_name : attribute name 253 !> @param[in] cd_value: attribute value 331 !------------------------------------------------------------------- 332 !> @brief This function initialize an attribute structure with character 333 !> value. 334 !> 335 !> @author J.Paul 336 !> @date November, 2013 - Initial Version 337 ! 338 !> @param[in] cd_name attribute name 339 !> @param[in] cd_value attribute value 254 340 !> @return attribute structure 255 341 !------------------------------------------------------------------- 256 !> @code257 342 TYPE(TATT) FUNCTION att__init_c( cd_name, cd_value ) 258 343 IMPLICIT NONE … … 265 350 CALL att_clean(att__init_c) 266 351 267 CALL logger_ info( &352 CALL logger_trace( & 268 353 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 269 354 & " attribute value "//TRIM(ADJUSTL(cd_value)) ) … … 276 361 277 362 END FUNCTION att__init_c 278 !> @endcode 279 !------------------------------------------------------------------- 280 !> @brief This function initialise an attribute structure with table 281 !> of real(8) value 282 !> 283 !> @author J.Paul 284 !> - Nov, 2013- Initial Version 285 ! 286 !> @param[in] cd_name : attribute name 287 !> @param[in] dd_value: attribute value 363 !------------------------------------------------------------------- 364 !> @brief This function initialize an attribute structure with array 365 !> of real(8) value. 366 !> @details 367 !> Optionaly you could specify the type of the variable to be saved. 368 !> 369 !> @author J.Paul 370 !> @dtae November, 2013 - Initial Version 371 ! 372 !> @param[in] cd_name attribute name 373 !> @param[in] dd_value attribute value 374 !> @param[in] id_type type of the variable to be saved 288 375 !> @return attribute structure 289 376 !------------------------------------------------------------------- 290 !> @code 291 TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value ) 377 TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value, id_type ) 292 378 IMPLICIT NONE 293 379 … … 295 381 CHARACTER(LEN=*), INTENT(IN) :: cd_name 296 382 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value 383 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 297 384 298 385 ! local value … … 307 394 CALL att_clean(att__init_dp) 308 395 309 ! tablesize396 ! array size 310 397 il_len=size(dd_value(:)) 311 398 … … 316 403 cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(il_len)))//"/)" 317 404 318 CALL logger_ info( &405 CALL logger_trace( & 319 406 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 320 407 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 322 409 att__init_dp%c_name=TRIM(ADJUSTL(cd_name)) 323 410 324 att__init_dp%i_type=NF90_DOUBLE 411 IF( PRESENT(id_type) )THEN 412 att__init_dp%i_type=id_type 413 ELSE 414 att__init_dp%i_type=NF90_DOUBLE 415 ENDIF 325 416 326 417 IF( ASSOCIATED(att__init_dp%d_value) )THEN … … 333 424 334 425 END FUNCTION att__init_dp 335 !> @endcode 336 !------------------------------------------------------------------- 337 !> @brief This function initialise an attribute structure with 426 !------------------------------------------------------------------- 427 !> @brief This function initialize an attribute structure with 338 428 !> real(8) value 339 !> 340 !> @author J.Paul 341 !> - Nov, 2013- Initial Version 342 ! 343 !> @param[in] cd_name : attribute name 344 !> @param[in] dd_value: attribute value 429 !> @details 430 !> Optionaly you could specify the type of the variable to be saved. 431 !> 432 !> @author J.Paul 433 !> @date November, 2013 - Initial Version 434 ! 435 !> @param[in] cd_name attribute name 436 !> @param[in] dd_value attribute value 437 !> @param[in] id_type type of the variable to be saved 345 438 !> @return attribute structure 346 439 !------------------------------------------------------------------- 347 !> @code 348 TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value ) 440 TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value, id_type ) 349 441 IMPLICIT NONE 350 442 ! Argument 351 443 CHARACTER(LEN=*), INTENT(IN) :: cd_name 352 444 REAL(dp), INTENT(IN) :: dd_value 445 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 353 446 354 447 ! local value … … 361 454 cl_value="(/"//TRIM(fct_str(dd_value))//"/)" 362 455 363 CALL logger_ info( &456 CALL logger_trace( & 364 457 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 365 458 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 367 460 att__init_dp_0d%c_name=TRIM(ADJUSTL(cd_name)) 368 461 369 att__init_dp_0d%i_type=NF90_DOUBLE 462 IF( PRESENT(id_type) )THEN 463 att__init_dp_0d%i_type=id_type 464 ELSE 465 att__init_dp_0d%i_type=NF90_DOUBLE 466 ENDIF 370 467 371 468 IF( ASSOCIATED(att__init_dp_0d%d_value) )THEN … … 378 475 379 476 END FUNCTION att__init_dp_0d 380 !> @endcode 381 !------------------------------------------------------------------- 382 !> @brief This function initialise an attribute structure with table 383 !> of real(4) value 384 !> 385 !> @author J.Paul 386 !> - Nov, 2013- Initial Version 387 ! 388 !> @param[in] cd_name : attribute name 389 !> @param[in] rd_value: attribute value 477 !------------------------------------------------------------------- 478 !> @brief This function initialize an attribute structure with array 479 !> of real(4) value. 480 !> @details 481 !> Optionaly you could specify the type of the variable to be saved. 482 !> 483 !> @author J.Paul 484 !> @date November, 2013 - Initial Version 485 ! 486 !> @param[in] cd_name attribute name 487 !> @param[in] rd_value attribute value 488 !> @param[in] id_type type of the variable to be saved 390 489 !> @return attribute structure 391 490 !------------------------------------------------------------------- 392 !> @code 393 TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value ) 491 TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value, id_type ) 394 492 IMPLICIT NONE 395 493 ! Argument 396 494 CHARACTER(LEN=*), INTENT(IN) :: cd_name 397 495 REAL(sp), DIMENSION(:), INTENT(IN) :: rd_value 496 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 398 497 399 498 ! local value … … 408 507 CALL att_clean(att__init_sp) 409 508 410 ! tablesize509 ! array size 411 510 il_len=size(rd_value(:)) 412 511 … … 417 516 cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(il_len)))//"/)" 418 517 419 CALL logger_ info( &518 CALL logger_trace( & 420 519 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 421 520 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 423 522 att__init_sp%c_name=TRIM(ADJUSTL(cd_name)) 424 523 425 att__init_sp%i_type=NF90_FLOAT 524 IF( PRESENT(id_type) )THEN 525 att__init_sp%i_type=id_type 526 ELSE 527 att__init_sp%i_type=NF90_FLOAT 528 ENDIF 426 529 427 530 IF( ASSOCIATED(att__init_sp%d_value) )THEN … … 434 537 435 538 END FUNCTION att__init_sp 436 !> @endcode 437 !------------------------------------------------------------------- 438 !> @brief This function initialise an attribute structure with 439 !> real(4) value 440 !> 441 !> @author J.Paul 442 !> - Nov, 2013- Initial Version 443 ! 444 !> @param[in] cd_name : attribute name 445 !> @param[in] rd_value: attribute value 539 !------------------------------------------------------------------- 540 !> @brief This function initialize an attribute structure with 541 !> real(4) value. 542 !> @details 543 !> Optionaly you could specify the type of the variable to be saved. 544 !> 545 !> @author J.Paul 546 !> @date November, 2013 - Initial Version 547 ! 548 !> @param[in] cd_name attribute name 549 !> @param[in] rd_value attribute value 550 !> @param[in] id_type type of the variable to be saved 446 551 !> @return attribute structure 447 552 !------------------------------------------------------------------- 448 !> @code 449 TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value ) 553 TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value, id_type ) 450 554 IMPLICIT NONE 451 555 ! Argument 452 556 CHARACTER(LEN=*), INTENT(IN) :: cd_name 453 557 REAL(sp), INTENT(IN) :: rd_value 558 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 454 559 455 560 ! local value … … 462 567 cl_value="(/"//TRIM(fct_str(rd_value))//"/)" 463 568 464 CALL logger_ info( &569 CALL logger_trace( & 465 570 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 466 571 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 468 573 att__init_sp_0d%c_name=TRIM(ADJUSTL(cd_name)) 469 574 470 att__init_sp_0d%i_type=NF90_FLOAT 575 IF( PRESENT(id_type) )THEN 576 att__init_sp_0d%i_type=id_type 577 ELSE 578 att__init_sp_0d%i_type=NF90_FLOAT 579 ENDIF 471 580 472 581 IF( ASSOCIATED(att__init_sp_0d%d_value) )THEN … … 479 588 480 589 END FUNCTION att__init_sp_0d 481 !> @endcode 482 !------------------------------------------------------------------- 483 !> @brief This function initialise an attribute structure with table 484 !> of integer(1) value 485 !> 486 !> @author J.Paul 487 !> - Nov, 2013- Initial Version 488 ! 489 !> @param[in] cd_name : attribute name 490 !> @param[in] bd_value: attribute value 590 !------------------------------------------------------------------- 591 !> @brief This function initialize an attribute structure with array 592 !> of integer(1) value. 593 !> @details 594 !> Optionaly you could specify the type of the variable to be saved. 595 !> 596 !> @author J.Paul 597 !> @date November, 2013 - Initial Version 598 ! 599 !> @param[in] cd_name attribute name 600 !> @param[in] bd_value attribute value 601 !> @param[in] id_type type of the variable to be saved 491 602 !> @return attribute structure 492 603 !------------------------------------------------------------------- 493 !> @code 494 TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value ) 604 TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value, id_type ) 495 605 IMPLICIT NONE 496 606 ! Argument 497 607 CHARACTER(LEN=*), INTENT(IN) :: cd_name 498 608 INTEGER(i1), DIMENSION(:), INTENT(IN) :: bd_value 609 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 499 610 500 611 ! local value … … 509 620 CALL att_clean(att__init_i1) 510 621 511 ! tablesize622 ! array size 512 623 il_len=size(bd_value(:)) 513 624 … … 518 629 cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(il_len)))//"/)" 519 630 520 CALL logger_ info( &631 CALL logger_trace( & 521 632 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 522 633 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 524 635 att__init_i1%c_name=TRIM(ADJUSTL(cd_name)) 525 636 526 att__init_i1%i_type=NF90_BYTE 637 IF( PRESENT(id_type) )THEN 638 att__init_i1%i_type=id_type 639 ELSE 640 att__init_i1%i_type=NF90_BYTE 641 ENDIF 527 642 528 643 IF( ASSOCIATED(att__init_i1%d_value) )THEN … … 535 650 536 651 END FUNCTION att__init_i1 537 !> @endcode 538 !------------------------------------------------------------------- 539 !> @brief This function initialise an attribute structure with 540 !> integer(1) value 541 !> 542 !> @author J.Paul 543 !> - Nov, 2013- Initial Version 544 ! 545 !> @param[in] cd_name : attribute name 546 !> @param[in] bd_value: attribute value 652 !------------------------------------------------------------------- 653 !> @brief This function initialize an attribute structure with 654 !> integer(1) value. 655 !> @details 656 !> Optionaly you could specify the type of the variable to be saved. 657 !> 658 !> @author J.Paul 659 !> @date November, 2013 - Initial Version 660 ! 661 !> @param[in] cd_name attribute name 662 !> @param[in] bd_value attribute value 663 !> @param[in] id_type type of the variable to be saved 547 664 !> @return attribute structure 548 665 !------------------------------------------------------------------- 549 !> @code 550 TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value ) 666 TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value, id_type ) 551 667 IMPLICIT NONE 552 668 ! Argument 553 669 CHARACTER(LEN=*), INTENT(IN) :: cd_name 554 670 INTEGER(i1), INTENT(IN) :: bd_value 671 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 555 672 556 673 !local value … … 563 680 cl_value="(/"//TRIM(fct_str(bd_value))//"/)" 564 681 565 CALL logger_ info( &682 CALL logger_trace( & 566 683 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 567 684 & " attibute value "//TRIM(ADJUSTL(cl_value)) ) … … 569 686 att__init_i1_0d%c_name=TRIM(ADJUSTL(cd_name)) 570 687 571 att__init_i1_0d%i_type=NF90_BYTE 688 IF( PRESENT(id_type) )THEN 689 att__init_i1_0d%i_type=id_type 690 ELSE 691 att__init_i1_0d%i_type=NF90_BYTE 692 ENDIF 572 693 573 694 IF( ASSOCIATED(att__init_i1_0d%d_value) )THEN … … 580 701 581 702 END FUNCTION att__init_i1_0d 582 !> @endcode 583 !------------------------------------------------------------------- 584 !> @brief This function initialise an attribute structure with table 585 !> of integer(2) value 586 !> 587 !> @author J.Paul 588 !> - Nov, 2013- Initial Version 589 ! 590 !> @param[in] cd_name : attribute name 591 !> @param[in] sd_value: attribute value 703 !------------------------------------------------------------------- 704 !> @brief This function initialize an attribute structure with array 705 !> of integer(2) value. 706 !> @details 707 !> Optionaly you could specify the type of the variable to be saved. 708 !> 709 !> @author J.Paul 710 !> @date November, 2013 - Initial Version 711 ! 712 !> @param[in] cd_name attribute name 713 !> @param[in] sd_value attribute value 714 !> @param[in] id_type type of the variable to be saved 592 715 !> @return attribute structure 593 716 !------------------------------------------------------------------- 594 !> @code 595 TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value ) 717 TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value, id_type ) 596 718 IMPLICIT NONE 597 719 ! Argument 598 720 CHARACTER(LEN=*), INTENT(IN) :: cd_name 599 721 INTEGER(i2), DIMENSION(:), INTENT(IN) :: sd_value 722 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 600 723 601 724 ! local value … … 610 733 CALL att_clean(att__init_i2) 611 734 612 ! tablesize735 ! array size 613 736 il_len=size(sd_value(:)) 614 737 … … 619 742 cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(il_len)))//"/)" 620 743 621 CALL logger_ info( &744 CALL logger_trace( & 622 745 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 623 746 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 625 748 att__init_i2%c_name=TRIM(ADJUSTL(cd_name)) 626 749 627 att__init_i2%i_type=NF90_SHORT 750 IF( PRESENT(id_type) )THEN 751 att__init_i2%i_type=id_type 752 ELSE 753 att__init_i2%i_type=NF90_SHORT 754 ENDIF 628 755 629 756 IF( ASSOCIATED(att__init_i2%d_value) )THEN … … 636 763 637 764 END FUNCTION att__init_i2 638 !> @endcode 639 !------------------------------------------------------------------- 640 !> @brief This function initialise an attribute structure with 641 !> integer(2) value 642 !> 643 !> @author J.Paul 644 !> - Nov, 2013- Initial Version 645 ! 646 !> @param[in] cd_name : attribute name 647 !> @param[in] sd_value: attribute value 765 !------------------------------------------------------------------- 766 !> @brief This function initialize an attribute structure with 767 !> integer(2) value. 768 !> @details 769 !> Optionaly you could specify the type of the variable to be saved. 770 !> 771 !> @author J.Paul 772 !> @date November, 2013 - Initial Version 773 ! 774 !> @param[in] cd_name attribute name 775 !> @param[in] sd_value attribute value 776 !> @param[in] id_type type of the variable to be saved 648 777 !> @return attribute structure 649 778 !------------------------------------------------------------------- 650 !> @code 651 TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value ) 779 TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value, id_type ) 652 780 IMPLICIT NONE 653 781 ! Argument 654 782 CHARACTER(LEN=*), INTENT(IN) :: cd_name 655 783 INTEGER(i2), INTENT(IN) :: sd_value 784 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 656 785 657 786 !local value … … 664 793 cl_value="(/"//TRIM(fct_str(sd_value))//"/)" 665 794 666 CALL logger_ info( &795 CALL logger_trace( & 667 796 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 668 797 & " attibute value "//TRIM(ADJUSTL(cl_value)) ) … … 670 799 att__init_i2_0d%c_name=TRIM(ADJUSTL(cd_name)) 671 800 672 att__init_i2_0d%i_type=NF90_SHORT 801 IF( PRESENT(id_type) )THEN 802 att__init_i2_0d%i_type=id_type 803 ELSE 804 att__init_i2_0d%i_type=NF90_SHORT 805 ENDIF 673 806 674 807 IF( ASSOCIATED(att__init_i2_0d%d_value) )THEN … … 681 814 682 815 END FUNCTION att__init_i2_0d 683 !> @endcode 684 !------------------------------------------------------------------- 685 !> @brief This function initialise an attribute structure with table 686 !> of integer(4) value 687 !> 688 !> @author J.Paul 689 !> - Nov, 2013- Initial Version 690 ! 691 !> @param[in] cd_name : attribute name 692 !> @param[in] id_value: attribute value 816 !------------------------------------------------------------------- 817 !> @brief This function initialize an attribute structure with array 818 !> of integer(4) value. 819 !> @details 820 !> Optionaly you could specify the type of the variable to be saved. 821 !> 822 !> @author J.Paul 823 !> @date November, 2013 - Initial Version 824 ! 825 !> @param[in] cd_name attribute name 826 !> @param[in] id_value attribute value 827 !> @param[in] id_type type of the variable to be saved 693 828 !> @return attribute structure 694 829 !------------------------------------------------------------------- 695 !> @code 696 TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value ) 830 TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value, id_type ) 697 831 IMPLICIT NONE 698 832 ! Argument 699 833 CHARACTER(LEN=*), INTENT(IN) :: cd_name 700 834 INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_value 835 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 701 836 702 837 ! local value … … 711 846 CALL att_clean(att__init_i4) 712 847 713 ! tablesize848 ! array size 714 849 il_len=size(id_value(:)) 715 850 … … 720 855 cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(il_len)))//"/)" 721 856 722 CALL logger_ info( &857 CALL logger_trace( & 723 858 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 724 859 & " attribute value "//TRIM(ADJUSTL(cl_value)) ) … … 726 861 att__init_i4%c_name=TRIM(ADJUSTL(cd_name)) 727 862 728 att__init_i4%i_type=NF90_INT 863 IF( PRESENT(id_type) )THEN 864 att__init_i4%i_type=id_type 865 ELSE 866 att__init_i4%i_type=NF90_INT 867 ENDIF 729 868 730 869 IF( ASSOCIATED(att__init_i4%d_value) )THEN … … 737 876 738 877 END FUNCTION att__init_i4 739 !> @endcode 740 !------------------------------------------------------------------- 741 !> @brief This function initialise an attribute structure with 742 !> integer(4) value 743 !> 744 !> @author J.Paul 745 !> - Nov, 2013- Initial Version 746 ! 747 !> @param[in] cd_name : attribute name 748 !> @param[in] id_value: attribute value 878 !------------------------------------------------------------------- 879 !> @brief This function initialize an attribute structure with 880 !> integer(4) value. 881 !> @details 882 !> Optionaly you could specify the type of the variable to be saved. 883 !> 884 !> @author J.Paul 885 !> @date November, 2013 - Initial Version 886 !> 887 !> @param[in] cd_name attribute name 888 !> @param[in] id_value attribute value 889 !> @param[in] id_type type of the variable to be saved 749 890 !> @return attribute structure 750 891 !------------------------------------------------------------------- 751 !> @code 752 TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value ) 892 TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value, id_type ) 753 893 IMPLICIT NONE 754 894 ! Argument 755 895 CHARACTER(LEN=*), INTENT(IN) :: cd_name 756 896 INTEGER(i4), INTENT(IN) :: id_value 897 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 757 898 758 899 !local value … … 765 906 cl_value="(/"//TRIM(fct_str(id_value))//"/)" 766 907 767 CALL logger_ info( &908 CALL logger_trace( & 768 909 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 769 910 & " attibute value "//TRIM(ADJUSTL(cl_value)) ) … … 771 912 att__init_i4_0d%c_name=TRIM(ADJUSTL(cd_name)) 772 913 773 att__init_i4_0d%i_type=NF90_INT 914 IF( PRESENT(id_type) )THEN 915 att__init_i4_0d%i_type=id_type 916 ELSE 917 att__init_i4_0d%i_type=NF90_INT 918 ENDIF 774 919 775 920 IF( ASSOCIATED(att__init_i4_0d%d_value) )THEN … … 782 927 783 928 END FUNCTION att__init_i4_0d 784 !> @endcode 785 !------------------------------------------------------------------- 786 !> @brief This function initialise an attribute structure with table 787 !> of integer(8) value 788 !> 789 !> @author J.Paul 790 !> - Nov, 2013- Initial Version 791 ! 792 !> @param[in] cd_name : attribute name 793 !> @param[in] kd_value: attribute value 929 !------------------------------------------------------------------- 930 !> @brief This function initialize an attribute structure with array 931 !> of integer(8) value. 932 !> @details 933 !> Optionaly you could specify the type of the variable to be saved. 934 !> 935 !> @author J.Paul 936 !> @date November, 2013 - Initial Version 937 ! 938 !> @param[in] cd_name attribute name 939 !> @param[in] kd_value attribute value 940 !> @param[in] id_type type of the variable to be saved 794 941 !> @return attribute structure 795 942 !------------------------------------------------------------------- 796 !> @code 797 TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value ) 943 TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value, id_type ) 798 944 IMPLICIT NONE 799 945 ! Argument 800 946 CHARACTER(LEN=*), INTENT(IN) :: cd_name 801 947 INTEGER(i8), DIMENSION(:), INTENT(IN) :: kd_value 948 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 802 949 803 950 ! local value … … 812 959 CALL att_clean(att__init_i8) 813 960 814 ! tablesize961 ! array size 815 962 il_len=size(kd_value(:)) 816 963 … … 821 968 cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(il_len)))//"/)" 822 969 823 CALL logger_ info( &970 CALL logger_trace( & 824 971 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 825 972 & " attibute value "//TRIM(ADJUSTL(cl_value)) ) … … 827 974 att__init_i8%c_name=TRIM(ADJUSTL(cd_name)) 828 975 829 att__init_i8%i_type=NF90_INT 976 IF( PRESENT(id_type) )THEN 977 att__init_i8%i_type=id_type 978 ELSE 979 att__init_i8%i_type=NF90_INT 980 ENDIF 830 981 831 982 IF( ASSOCIATED(att__init_i8%d_value) )THEN … … 838 989 839 990 END FUNCTION att__init_i8 840 !> @endcode 841 !------------------------------------------------------------------- 842 !> @brief This function initialise an attribute structure with 843 !> integer(8) value 844 !> 845 !> @author J.Paul 846 !> - Nov, 2013- Initial Version 847 ! 848 !> @param[in] cd_name : attribute name 849 !> @param[in] kd_value: attribute value 991 !------------------------------------------------------------------- 992 !> @brief This function initialize an attribute structure with 993 !> integer(8) value. 994 !> @details 995 !> Optionaly you could specify the type of the variable to be saved. 996 !> 997 !> @author J.Paul 998 !> @date November, 2013 - Initial Version 999 ! 1000 !> @param[in] cd_name attribute name 1001 !> @param[in] kd_value attribute value 1002 !> @param[in] id_type type of the variable to be saved 850 1003 !> @return attribute structure 851 1004 !------------------------------------------------------------------- 852 !> @code 853 TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value ) 1005 TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value, id_type ) 854 1006 IMPLICIT NONE 855 1007 ! Argument 856 1008 CHARACTER(LEN=*), INTENT(IN) :: cd_name 857 1009 INTEGER(i8), INTENT(IN) :: kd_value 1010 INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type 858 1011 859 1012 ! local value … … 866 1019 cl_value="(/"//TRIM(fct_str(kd_value))//"/)" 867 1020 868 CALL logger_ info( &1021 CALL logger_trace( & 869 1022 & " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 870 1023 & " attibute value "//TRIM(ADJUSTL(cl_value)) ) … … 872 1025 att__init_i8_0d%c_name=TRIM(ADJUSTL(cd_name)) 873 1026 874 att__init_i8_0d%i_type=NF90_INT 1027 IF( PRESENT(id_type) )THEN 1028 att__init_i8_0d%i_type=id_type 1029 ELSE 1030 att__init_i8_0d%i_type=NF90_INT 1031 ENDIF 875 1032 876 1033 IF( ASSOCIATED(att__init_i8_0d%d_value) )THEN … … 883 1040 884 1041 END FUNCTION att__init_i8_0d 885 !> @endcode 886 !------------------------------------------------------------------- 887 !> @brief This subroutine print attribute information 888 !> 889 !> @author J.Paul 890 !> - Nov, 2013- Initial Version 891 ! 892 !> @param[in] td_att : attribute structure 893 !------------------------------------------------------------------- 894 !> @code 895 SUBROUTINE att_print(td_att) 1042 !------------------------------------------------------------------- 1043 !> @brief This subroutine print informations of an array of attribute. 1044 !> 1045 !> @author J.Paul 1046 !> @date June, 2014 - Initial Version 1047 !> 1048 !> @param[in] td_att array of attribute structure 1049 !------------------------------------------------------------------- 1050 SUBROUTINE att__print_arr(td_att) 1051 IMPLICIT NONE 1052 1053 ! Argument 1054 TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att 1055 1056 ! loop indices 1057 INTEGER(i4) :: ji 1058 !---------------------------------------------------------------- 1059 1060 DO ji=1,SIZE(td_att(:)) 1061 CALL att_print(td_att(ji)) 1062 ENDDO 1063 1064 END SUBROUTINE att__print_arr 1065 !------------------------------------------------------------------- 1066 !> @brief This subroutine print attribute information. 1067 !> 1068 !> @author J.Paul 1069 !> @date November, 2013 - Initial Version 1070 !> @date September, 2014 - take into account type of attribute. 1071 ! 1072 !> @param[in] td_att attribute structure 1073 !------------------------------------------------------------------- 1074 SUBROUTINE att__print_unit(td_att) 896 1075 IMPLICIT NONE 897 1076 … … 902 1081 CHARACTER(LEN=lc) :: cl_type 903 1082 CHARACTER(LEN=lc) :: cl_value 904 CHARACTER(LEN=lc) :: cl_tmp 1083 1084 INTEGER(i8) :: kl_tmp 1085 INTEGER(i2) :: sl_tmp 1086 INTEGER(i1) :: bl_tmp 1087 REAL(sp) :: rl_tmp 1088 REAL(dp) :: dl_tmp 905 1089 906 1090 ! loop indices … … 924 1108 CASE DEFAULT 925 1109 cl_type='' 926 !cl_type='unknown' 1110 927 1111 END SELECT 928 1112 … … 932 1116 cl_value=td_att%c_value 933 1117 934 CASE(NF90_BYTE , NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)1118 CASE(NF90_BYTE) 935 1119 IF( td_att%i_len > 1 )THEN 936 937 cl_tmp=','938 1120 cl_value='(/' 939 1121 DO ji=1,td_att%i_len-1 940 cl_value=TRIM(cl_value)//&941 & TRIM(fct_str(td_att%d_value(ji)))//TRIM(cl_tmp)1122 bl_tmp=INT(td_att%d_value(ji),i1) 1123 cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//',' 942 1124 ENDDO 943 cl_value=TRIM(cl_value)//& 944 & TRIM(fct_str(td_att%d_value(td_att%i_len)))//'/)' 945 1125 bl_tmp=INT(td_att%d_value(td_att%i_len),i1) 1126 cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//'/)' 946 1127 ELSE 947 948 1128 cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 949 950 1129 ENDIF 1130 1131 CASE(NF90_SHORT) 1132 IF( td_att%i_len > 1 )THEN 1133 cl_value='(/' 1134 DO ji=1,td_att%i_len-1 1135 sl_tmp=INT(td_att%d_value(ji),i2) 1136 cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//',' 1137 ENDDO 1138 sl_tmp=INT(td_att%d_value(td_att%i_len),i2) 1139 cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//'/)' 1140 ELSE 1141 cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 1142 ENDIF 1143 1144 CASE(NF90_INT) 1145 IF( td_att%i_len > 1 )THEN 1146 cl_value='(/' 1147 DO ji=1,td_att%i_len-1 1148 kl_tmp=INT(td_att%d_value(ji),i8) 1149 cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//',' 1150 ENDDO 1151 kl_tmp=INT(td_att%d_value(td_att%i_len),i8) 1152 cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//'/)' 1153 ELSE 1154 cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 1155 ENDIF 1156 1157 CASE(NF90_FLOAT) 1158 IF( td_att%i_len > 1 )THEN 1159 cl_value='(/' 1160 DO ji=1,td_att%i_len-1 1161 rl_tmp=REAL(td_att%d_value(ji),sp) 1162 cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//',' 1163 ENDDO 1164 rl_tmp=REAL(td_att%d_value(td_att%i_len),sp) 1165 cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//'/)' 1166 ELSE 1167 cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 1168 ENDIF 1169 1170 CASE(NF90_DOUBLE) 1171 IF( td_att%i_len > 1 )THEN 1172 cl_value='(/' 1173 DO ji=1,td_att%i_len-1 1174 dl_tmp=REAL(td_att%d_value(ji),dp) 1175 cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//',' 1176 ENDDO 1177 dl_tmp=REAL(td_att%d_value(td_att%i_len),dp) 1178 cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//'/)' 1179 ELSE 1180 cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 1181 ENDIF 1182 951 1183 CASE DEFAULT 952 1184 cl_value="none" … … 960 1192 & " value : ",TRIM(ADJUSTL(cl_value)) 961 1193 962 END SUBROUTINE att_print 963 !> @endcode 1194 END SUBROUTINE att__print_unit 964 1195 !------------------------------------------------------------------- 965 1196 !> @brief … … 967 1198 ! 968 1199 !> @author J.Paul 969 !> @date Nov, 2013 970 ! 971 !> @param[inout] td_att : attribute strcuture 972 !------------------------------------------------------------------- 973 !> @code 974 SUBROUTINE att_clean( td_att ) 1200 !> @date November, 2013 - Initial Version 1201 ! 1202 !> @param[inout] td_att attribute strcuture 1203 !------------------------------------------------------------------- 1204 SUBROUTINE att__clean_unit( td_att ) 975 1205 IMPLICIT NONE 976 1206 ! Argument … … 981 1211 !---------------------------------------------------------------- 982 1212 983 CALL logger_ info( &1213 CALL logger_trace( & 984 1214 & " CLEAN: reset attribute "//TRIM(td_att%c_name) ) 985 1215 … … 990 1220 991 1221 ! replace by empty structure 992 td_att=tl_att 993 994 END SUBROUTINE att_clean 995 !> @endcode 1222 td_att=att_copy(tl_att) 1223 1224 END SUBROUTINE att__clean_unit 1225 !------------------------------------------------------------------- 1226 !> @brief 1227 !> This subroutine clean array of attribute strcuture. 1228 ! 1229 !> @author J.Paul 1230 !> @date September, 2014 - Initial Version 1231 ! 1232 !> @param[inout] td_att attribute strcuture 1233 !------------------------------------------------------------------- 1234 SUBROUTINE att__clean_arr( td_att ) 1235 IMPLICIT NONE 1236 ! Argument 1237 TYPE(TATT), DIMENSION(:), INTENT(INOUT) :: td_att 1238 1239 ! local variable 1240 ! loop indices 1241 INTEGER(i4) :: ji 1242 !---------------------------------------------------------------- 1243 1244 DO ji=SIZE(td_att(:)),1,-1 1245 CALL att_clean(td_att(ji) ) 1246 ENDDO 1247 1248 END SUBROUTINE att__clean_arr 996 1249 END MODULE att 997 1250
Note: See TracChangeset
for help on using the changeset viewer.