Changeset 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
r4213 r6225 10 10 !> 11 11 !> @details 12 !>13 12 !> to open dimg file (create file structure):<br/> 13 !> @code 14 14 !> CALL iom_rstdimg_open(td_file) 15 !> @endcode 15 16 !> - td_file is file structure (see file.f90) 16 17 !> 17 18 !> to write in dimg file:<br/> 19 !> @code 18 20 !> CALL iom_rstdimg_write_file(td_file) 21 !> @endcode 19 22 !> 20 23 !> to close dimg file:<br/> 24 !> @code 21 25 !> CALL iom_rstdimg_close(tl_file) 26 !> @endcode 22 27 !> 23 28 !> to read one dimension in dimg file:<br/> 24 !> tl_dim = iom_rstdimg_read_dim(tl_file, id_dimid)<br/> 25 !> or<br/> 29 !> @code 30 !> tl_dim = iom_rstdimg_read_dim(tl_file, id_dimid) 31 !> @endcode 32 !> or 33 !> @code 26 34 !> tl_dim = iom_rstdimg_read_dim(tl_file, cd_name) 35 !> @endcode 27 36 !> - id_dimid is dimension id<br/> 28 37 !> - cd_name is dimension name 29 38 !> 30 !> to read one global attribute in dimg file:<br/>31 !> tl_att = iom_rstdimg_read_att(tl_file, id_varid, id_attid)<br/>32 !> or<br/>33 !> tl_att = iom_rstdimg_read_att(tl_file, id_varid, cd_name)34 !> - id_varid is variable id35 !> - id_attid is attribute id<br/>36 !> - cd_name is attribute name37 !>38 39 !> to read one variable in dimg file:<br/> 39 !> tl_var = iom_rstdimg_read_var(td_file, id_varid, [id_start, id_count])<br/> 40 !> or<br/> 41 !> tl_var = iom_rstdimg_read_var(td_file, cd_name, [id_start, [id_count,]] [cd_stdname]) 40 !> @code 41 !> tl_var = iom_rstdimg_read_var(td_file, id_varid, [id_start, id_count]) 42 !> @endcode 43 !> or 44 !> @code 45 !> tl_var = iom_rstdimg_read_var(td_file, cd_name, [id_start, [id_count]]) 46 !> @endcode 42 47 !> - id_varid is variabale id 43 !> - cd_name is variabale name 44 !> - id_start is a integer(4) 1D table of index from which the data 45 !> values will be read (optional) 46 !> - id_count is a integer(4) 1D table of the number of indices selected 47 !> along each dimension (optional) 48 !> - cd_stdname is variable standard name (optional) 48 !> - cd_name is variabale name or standard name 49 !> - id_start is a integer(4) 1D array of index from which the data 50 !> values will be read [optional] 51 !> - id_count is a integer(4) 1D array of the number of indices selected 52 !> along each dimension [optional] 53 !> 54 !> to get sub domain decomppistion in a dimg file:<br/> 55 !> @code 56 !> CALL iom_rstdimg_get_mpp(td_file) 57 !> @endcode 49 58 !> 50 59 !> @author 51 60 !> J.Paul 52 61 ! REVISION HISTORY: 53 !> @date Nov, 2013 - Initial Version 54 ! 55 !> @param MyModule_type : brief_description 62 !> @date November, 2013 - Initial Version 56 63 ! 57 64 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 !59 !> @todo60 65 !---------------------------------------------------------------------- 61 66 MODULE iom_rstdimg 62 67 USE netcdf ! nf90 library 68 USE global ! global parameter 63 69 USE kind ! F90 kind parameter 64 70 USE fct ! basic useful function 65 USE logger 71 USE logger ! log file manager 66 72 USE att ! attribute manager 67 73 USE dim ! dimension manager 68 74 USE var ! variable manager 69 75 USE file ! file manager 70 USE dom ! domain manager71 76 IMPLICIT NONE 72 PRIVATE73 77 ! NOTE_avoid_public_variables_if_possible 78 79 ! type and variable 80 PRIVATE :: im_vnl !< variable name length 74 81 75 82 ! function and subroutine … … 78 85 PUBLIC :: iom_rstdimg_read_dim !< read one dimension in an opened dimg file, return variable structure 79 86 PUBLIC :: iom_rstdimg_read_var !< read one variable in an opened dimg file, return dimension structure 80 PUBLIC :: iom_rstdimg_fill_var !< fill variable value in an opened dimg file81 87 PUBLIC :: iom_rstdimg_write_file !< write file structure contents in an opened dimg file 82 88 PUBLIC :: iom_rstdimg_get_mpp !< get sub domain decomppistion in a dimg file 83 89 84 PRIVATE :: iom_rstdimg__get_info !< get global information in an opened dimg file 85 PRIVATE :: iom_rstdimg__get_file_var !< read information about variable on an opened dimg file. 86 PRIVATE :: iom_rstdimg__get_file_var_0d !< put information about scalar variable in file structure 87 PRIVATE :: iom_rstdimg__get_file_var_1d !< put information about variable 1D in file structure 88 PRIVATE :: iom_rstdimg__get_file_var_2d !< put information about variable 2D in file structure 89 PRIVATE :: iom_rstdimg__get_file_var_3d !< put information about variable 3D in file structure 90 PRIVATE :: iom_rstdimg__read_dim_id !< read dimension structure in an opened dimg file, given variable id. 91 PRIVATE :: iom_rstdimg__read_dim_name !< read dimension structure in an opened dimg file, given variable name or standard name. 92 PRIVATE :: iom_rstdimg__read_var_id !< read variable value in an opened dimg file, given variable id. 93 PRIVATE :: iom_rstdimg__read_var_name !< read variable value in an opened dimg file, given variable name or standard name. 94 PRIVATE :: iom_rstdimg__read_var_value !< read variable value in an opened dimg file, for variable 1,2,3d 95 PRIVATE :: iom_rstdimg__write_header !< write header in an opened dimg file 96 PRIVATE :: iom_rstdimg__write_var !< write variables in an opened dimg file 97 PRIVATE :: iom_rstdimg__fill_var_id !< fill variable value in an opened dimg file, given variable id 98 PRIVATE :: iom_rstdimg__fill_var_name !< fill variable value in an opened dimg file, given variable name 99 PRIVATE :: iom_rstdimg__fill_var_all !< fill all variable value in an opened dimg file 90 PRIVATE :: iom_rstdimg__get_info ! get global information in an opened dimg file 91 PRIVATE :: iom_rstdimg__get_file_var ! read information about variable on an opened dimg file. 92 PRIVATE :: iom_rstdimg__get_file_var_0d ! put information about scalar variable in file structure 93 PRIVATE :: iom_rstdimg__get_file_var_1d ! put information about variable 1D in file structure 94 PRIVATE :: iom_rstdimg__get_file_var_2d ! put information about variable 2D in file structure 95 PRIVATE :: iom_rstdimg__get_file_var_3d ! put information about variable 3D in file structure 96 PRIVATE :: iom_rstdimg__read_dim_id ! read dimension structure in an opened dimg file, given variable id. 97 PRIVATE :: iom_rstdimg__read_dim_name ! read dimension structure in an opened dimg file, given variable name or standard name. 98 PRIVATE :: iom_rstdimg__read_var_id ! read variable value in an opened dimg file, given variable id. 99 PRIVATE :: iom_rstdimg__read_var_name ! read variable value in an opened dimg file, given variable name or standard name. 100 PRIVATE :: iom_rstdimg__read_var_value ! read variable value in an opened dimg file, for variable 1,2,3d 101 PRIVATE :: iom_rstdimg__get_rec ! compute record number before writing file 102 PRIVATE :: iom_rstdimg__write_header ! write header in an opened dimg file 103 PRIVATE :: iom_rstdimg__write_var ! write variables in an opened dimg file 100 104 101 105 ! module variable 102 INTEGER(i4), PARAMETER :: i p_vnl = 32 ! variable name length106 INTEGER(i4), PARAMETER :: im_vnl = 32 ! variable name length 103 107 104 108 INTERFACE iom_rstdimg_read_dim … … 112 116 END INTERFACE iom_rstdimg_read_var 113 117 114 INTERFACE iom_rstdimg_fill_var115 MODULE PROCEDURE iom_rstdimg__fill_var_id116 MODULE PROCEDURE iom_rstdimg__fill_var_name117 MODULE PROCEDURE iom_rstdimg__fill_var_all118 END INTERFACE iom_rstdimg_fill_var119 120 118 CONTAINS 121 119 !------------------------------------------------------------------- 122 !> @brief This subroutine open a dimg file in read or write mode<br/> 120 !> @brief This subroutine open a dimg file in read or write mode. 121 !> @details 123 122 !> if try to open a file in write mode that did not exist, create it.<br/> 124 123 !> if file already exist, get information about: … … 128 127 !> - the ID of the unlimited dimension 129 128 !> - the file format 130 !> and finally read dimensions. 129 !> Finally it read dimensions, and 'longitude' variable to compute East-West 130 !> overlap. 131 131 !> 132 132 !> @author J.Paul 133 !> - Nov, 2013- Initial Version 134 ! 135 !> @param[inout] td_file : file structure 136 !------------------------------------------------------------------- 137 !> @code 133 !> @date November, 2013 - Initial Version 134 ! 135 !> @param[inout] td_file file structure 136 !------------------------------------------------------------------- 138 137 SUBROUTINE iom_rstdimg_open(td_file) 139 138 IMPLICIT NONE … … 146 145 147 146 INTEGER(i4) :: il_status 148 149 TYPE(TVAR) :: tl_lon150 147 !---------------------------------------------------------------- 151 148 … … 180 177 ENDIF 181 178 182 183 179 ENDIF 184 180 … … 224 220 ENDIF 225 221 226 227 222 IF( .NOT. td_file%l_wrt )THEN 228 223 … … 240 235 CALL fct_err(il_status) 241 236 IF( il_status /= 0 )THEN 242 CALL logger_error("OPEN: file "//TRIM(td_file%c_name)& 237 CALL logger_debug("IOM RSTDIMG OPEN: open staus "//& 238 & TRIM(fct_str(il_status))) 239 CALL logger_fatal("IOM RSTDIMG OPEN: file "//& 240 & TRIM(td_file%c_name)& 243 241 & //" with record length "//TRIM(fct_str(td_file%i_recl))) 244 242 ENDIF … … 260 258 CALL fct_err(il_status) 261 259 IF( il_status /= 0 )THEN 262 CALL logger_error("OPEN: file "//TRIM(td_file%c_name)) 260 CALL logger_debug("IOM RSTDIMG OPEN: open staus "//& 261 & TRIM(fct_str(il_status))) 262 CALL logger_error("IOM RSTDIMG OPEN: file "//& 263 & TRIM(td_file%c_name)) 263 264 ENDIF 264 265 … … 274 275 CALL iom_rstdimg__get_file_var(td_file) 275 276 276 ! get ew overlap277 tl_lon=iom_rstdimg_read_var(td_file,'longitude')278 td_file%i_ew=dom_get_ew_overlap(tl_lon)279 WHERE( td_file%t_var(:)%t_dim(1)%l_use )280 td_file%t_var(:)%i_ew=td_file%i_ew281 ENDWHERE282 CALL var_clean(tl_lon)283 284 277 ENDIF 285 278 … … 287 280 288 281 END SUBROUTINE iom_rstdimg_open 289 !> @endcode 290 !------------------------------------------------------------------- 291 !> @brief This subroutine close dimg file 282 !------------------------------------------------------------------- 283 !> @brief This subroutine close dimg file. 292 284 !> 293 285 !> @author J.Paul 294 !> - Nov, 2013- Initial Version 295 ! 296 !> @param[in] td_file : file structure 297 !------------------------------------------------------------------- 298 !> @code 286 !> @date November, 2013 - Initial Version 287 ! 288 !> @param[inout] td_file file structure 289 !------------------------------------------------------------------- 299 290 SUBROUTINE iom_rstdimg_close(td_file) 300 291 IMPLICIT NONE … … 327 318 328 319 END SUBROUTINE iom_rstdimg_close 329 !> @endcode330 320 !------------------------------------------------------------------- 331 321 !> @brief This subroutine get global information in an opened dimg 332 !> file. <br/>322 !> file. 333 323 !> @details 334 324 !> It gets the number of variables, the domain decompistion, 335 !> the record of the header infos.<br/>325 !> the record of the header.<br/> 336 326 !> It read dimensions, and add it to dimension structure inside 337 327 !> file structure. 338 328 !> 339 329 !> @author J.Paul 340 !> - Nov, 2013- Initial Version 341 ! 342 !> @param[inout] td_file : file structure 343 !> @return file structure completed 344 !------------------------------------------------------------------- 345 !> @code 330 !> @date November, 2013 - Initial Version 331 ! 332 !> @param[inout] td_file file structure 333 !------------------------------------------------------------------- 346 334 SUBROUTINE iom_rstdimg__get_info(td_file) 347 335 IMPLICIT NONE … … 360 348 361 349 CALL logger_debug( & 362 & " GET INFO: about dimg file "//TRIM(td_file%c_name))350 & " IOM RSTDIMG GET INFO: about dimg file "//TRIM(td_file%c_name)) 363 351 364 352 ! read first record … … 370 358 CALL fct_err(il_status) 371 359 IF( il_status /= 0 )THEN 372 CALL logger_error("GET INFO: read first line of "//TRIM(td_file%c_name)) 373 ENDIF 374 375 CALL logger_trace( & 376 & " GET INFO: about dimg file "//TRIM(td_file%c_name)) 360 CALL logger_debug(" READ status: "//TRIM(fct_str(il_status))) 361 CALL logger_fatal("IOM RSTDIMG GET INFO: read first line of "//& 362 & TRIM(td_file%c_name)) 363 ENDIF 377 364 378 365 td_file%c_type='dimg' … … 380 367 ! add dimension to file structure 381 368 tl_dim=dim_init('X', il_nx) 382 CALL file_ add_dim(td_file, tl_dim)369 CALL file_move_dim(td_file, tl_dim) 383 370 tl_dim=dim_init('Y', il_ny) 384 CALL file_ add_dim(td_file, tl_dim)371 CALL file_move_dim(td_file, tl_dim) 385 372 tl_dim=dim_init('Z', il_nz) 386 CALL file_ add_dim(td_file, tl_dim)373 CALL file_move_dim(td_file, tl_dim) 387 374 388 375 ! reorder dimension to ('x','y','z','t') … … 401 388 402 389 END SUBROUTINE iom_rstdimg__get_info 403 !> @endcode 404 !------------------------------------------------------------------- 405 !> @brief This subroutine get sub domain decomposition in a dimg file.<br/> 390 !------------------------------------------------------------------- 391 !> @brief This subroutine get sub domain decomposition in a dimg file. 406 392 !> @details 407 393 !> domain decomposition informations are saved in attributes. 408 394 !> 409 395 !> @author J.Paul 410 !> - Nov, 2013- Initial Version 411 ! 412 !> @param[inout] td_file : file structure 413 !> @return mpp structure 414 !------------------------------------------------------------------- 415 !> @code 396 !> @date November, 2013 - Initial Version 397 ! 398 !> @param[inout] td_file file structure 399 !------------------------------------------------------------------- 416 400 SUBROUTINE iom_rstdimg_get_mpp(td_file) 417 401 IMPLICIT NONE … … 440 424 !---------------------------------------------------------------- 441 425 442 CALL logger_trace( " GET MPP: dimg file "//TRIM(td_file%c_name)) 426 CALL logger_debug( " IOM RSTDIMG GET MPP: dimg file "//& 427 & TRIM(td_file%c_name)) 443 428 444 429 ! read first record … … 453 438 CALL fct_err(il_status) 454 439 IF( il_status /= 0 )THEN 455 CALL logger_error("GET MPP: read first line of "//TRIM(td_file%c_name)) 440 CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//& 441 & TRIM(fct_str(il_status))) 442 CALL logger_error(" IOM RSTDIMG GET MPP: read first line of "//& 443 & TRIM(td_file%c_name)) 456 444 ENDIF 457 445 458 446 ! create attributes to save mpp value 459 447 tl_att=att_init( "DOMAIN_number_total", il_nproc) 460 CALL file_ add_att(td_file, tl_att)448 CALL file_move_att(td_file, tl_att) 461 449 462 450 tl_att=att_init( "DOMAIN_I_number_total", il_niproc) 463 CALL file_ add_att(td_file, tl_att)451 CALL file_move_att(td_file, tl_att) 464 452 465 453 tl_att=att_init( "DOMAIN_J_number_total", il_njproc) 466 CALL file_ add_att(td_file, tl_att)454 CALL file_move_att(td_file, tl_att) 467 455 468 456 tl_att=att_init( "DOMAIN_number", il_area) 469 CALL file_ add_att(td_file, tl_att)457 CALL file_move_att(td_file, tl_att) 470 458 471 459 tl_att=att_init( "DOMAIN_size_global", (/il_iglo, il_jglo/)) 472 CALL file_ add_att(td_file, tl_att)460 CALL file_move_att(td_file, tl_att) 473 461 474 462 ! allocate local variable … … 480 468 IF(il_status /= 0 )THEN 481 469 482 CALL logger_error( " GET MPP: not enough space to put domain&483 & decomposition in file "//TRIM(td_file%c_name) )470 CALL logger_error( " IOM RSTDIMG GET MPP: not enough space to put "//& 471 & "domain decomposition in file "//TRIM(td_file%c_name) ) 484 472 485 473 ENDIF … … 500 488 CALL fct_err(il_status) 501 489 IF( il_status /= 0 )THEN 502 CALL logger_error("GET INFO: read domain decomposition on first & 503 & line of "//TRIM(td_file%c_name)) 490 CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//& 491 & TRIM(fct_str(il_status))) 492 CALL logger_fatal("IOM RSTDIMG GET MPP: read domain decomposition "//& 493 & "on first line of "//TRIM(td_file%c_name)) 504 494 ENDIF 505 495 506 496 tl_att=att_init( "DOMAIN_position_first", (/il_impp(il_area), il_jmpp(il_area)/)) 507 CALL file_ add_att(td_file, tl_att)497 CALL file_move_att(td_file, tl_att) 508 498 509 499 tl_att=att_init( "DOMAIN_position_last", (/il_lci(il_area), il_lcj(il_area)/)) 510 CALL file_ add_att(td_file, tl_att)500 CALL file_move_att(td_file, tl_att) 511 501 512 502 tl_att=att_init( "DOMAIN_halo_size_start", (/il_ldi(il_area), il_ldj(il_area)/)) 513 CALL file_ add_att(td_file, tl_att)503 CALL file_move_att(td_file, tl_att) 514 504 515 505 tl_att=att_init( "DOMAIN_halo_size_end", (/il_lei(il_area), il_lej(il_area)/)) 516 CALL file_ add_att(td_file, tl_att)506 CALL file_move_att(td_file, tl_att) 517 507 518 508 tl_att=att_init( "DOMAIN_I_position_first", il_impp(:) ) 519 CALL file_ add_att(td_file, tl_att)509 CALL file_move_att(td_file, tl_att) 520 510 tl_att=att_init( "DOMAIN_J_position_first", il_jmpp(:) ) 521 CALL file_ add_att(td_file, tl_att)511 CALL file_move_att(td_file, tl_att) 522 512 523 513 tl_att=att_init( "DOMAIN_I_position_last", il_lci(:) ) 524 CALL file_ add_att(td_file, tl_att)514 CALL file_move_att(td_file, tl_att) 525 515 tl_att=att_init( "DOMAIN_J_position_last", il_lcj(:) ) 526 CALL file_ add_att(td_file, tl_att)516 CALL file_move_att(td_file, tl_att) 527 517 528 518 tl_att=att_init( "DOMAIN_I_halo_size_start", il_ldi(:) ) 529 CALL file_ add_att(td_file, tl_att)519 CALL file_move_att(td_file, tl_att) 530 520 tl_att=att_init( "DOMAIN_J_halo_size_start", il_ldj(:) ) 531 CALL file_ add_att(td_file, tl_att)521 CALL file_move_att(td_file, tl_att) 532 522 533 523 tl_att=att_init( "DOMAIN_I_halo_size_end", il_lei(:) ) 534 CALL file_ add_att(td_file, tl_att)524 CALL file_move_att(td_file, tl_att) 535 525 tl_att=att_init( "DOMAIN_J_halo_size_end", il_lej(:) ) 536 CALL file_add_att(td_file, tl_att) 526 CALL file_move_att(td_file, tl_att) 527 528 ! clean 529 CALL att_clean(tl_att) 537 530 538 531 DEALLOCATE( il_impp, il_jmpp,& … … 542 535 543 536 END SUBROUTINE iom_rstdimg_get_mpp 544 !> @endcode545 537 !------------------------------------------------------------------- 546 538 !> @brief This subroutine read information about variable on an 547 !> opened dimg file.<br/> 548 !> The variable structure inside file structure is then completed. 539 !> opened dimg file. 540 !> @details 541 !> The variables structures inside file structure are then completed. 542 !> Variables no0d, no1d, no2d, no3d are deleted from file strucutre. 549 543 !> @note variable value are read only for scalar variable (0d). 550 544 ! 551 545 !> @author J.Paul 552 !> - Nov, 2013- Initial Version 553 ! 554 !> @param[inout] td_file : file structure 555 !> @return file structure completed 556 !------------------------------------------------------------------- 557 !> @code 546 !> @date November, 2013 - Initial Version 547 ! 548 !> @param[inout] td_file file structure 549 !------------------------------------------------------------------- 558 550 SUBROUTINE iom_rstdimg__get_file_var(td_file) 559 551 IMPLICIT NONE … … 562 554 563 555 ! local variable 564 CHARACTER(LEN=i p_vnl), DIMENSION(:), ALLOCATABLE :: cl_name556 CHARACTER(LEN=im_vnl), DIMENSION(:), ALLOCATABLE :: cl_name 565 557 566 558 REAL(dp) , DIMENSION(:), ALLOCATABLE :: dl_value … … 605 597 606 598 IF(ASSOCIATED(td_file%t_var))THEN 599 CALL var_clean(td_file%t_var(:)) 607 600 DEALLOCATE(td_file%t_var) 608 601 ENDIF … … 638 631 639 632 END SUBROUTINE iom_rstdimg__get_file_var 640 !> @endcode 641 !------------------------------------------------------------------- 642 !> @brief This subroutine put information about scalar variable 633 !------------------------------------------------------------------- 634 !> @brief This subroutine put informations about scalar variable 643 635 !> inside file structure. 644 636 ! 645 637 !> @author J.Paul 646 !> - Nov, 2013- Initial Version 647 ! 648 !> @param[inout] td_file : file structure 649 !> @param[in] cd_name : table of variable name 650 !> @param[in] dd_value : table of variable value 651 !> @return file structure completed 652 !------------------------------------------------------------------- 653 !> @code 638 !> @date November, 2013 - Initial Version 639 ! 640 !> @param[inout] td_file file structure 641 !> @param[in] cd_name array of variable name 642 !> @param[in] dd_value array of variable value 643 !------------------------------------------------------------------- 654 644 SUBROUTINE iom_rstdimg__get_file_var_0d(td_file, cd_name, dd_value) 655 645 IMPLICIT NONE 656 646 ! Argument 657 647 TYPE(TFILE), INTENT(INOUT) :: td_file 658 CHARACTER(LEN=i p_vnl), DIMENSION(:), INTENT(IN) :: cd_name648 CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN) :: cd_name 659 649 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value 660 650 … … 667 657 668 658 ! define same dimension as in file 669 tl_dim(:)= td_file%t_dim(:)659 tl_dim(:)=dim_copy(td_file%t_dim(:)) 670 660 ! do not use any dimension 671 661 tl_dim(:)%l_use=.FALSE. … … 676 666 677 667 td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, & 678 & tl_dim(:), id_id=ji, id_rec=1 ) 668 & tl_dim(:), dd_fill=0._dp, & 669 & id_id=ji, id_rec=1 ) 679 670 680 671 ! get value of scalar … … 688 679 ENDDO 689 680 681 ! clean 682 CALL dim_clean(tl_dim(:)) 683 690 684 END SUBROUTINE iom_rstdimg__get_file_var_0d 691 !> @endcode 692 !------------------------------------------------------------------- 693 !> @brief This subroutine put information about variable 1D 685 !------------------------------------------------------------------- 686 !> @brief This subroutine put informations about variable 1D 694 687 !> inside file structure. 695 688 ! 696 689 !> @author J.Paul 697 !> - Nov, 2013- Initial Version 698 ! 699 !> @param[inout] td_file : file structure 700 !> @param[in] cd_name : table of variable name 701 !> @param[in] dd_value : table of variable record 702 !> @return file structure completed 703 !------------------------------------------------------------------- 704 !> @code 690 !> @date November, 2013 - Initial Version 691 ! 692 !> @param[inout] td_file file structure 693 !> @param[in] cd_name array of variable name 694 !> @param[in] dd_value array of variable record 695 !------------------------------------------------------------------- 705 696 SUBROUTINE iom_rstdimg__get_file_var_1d(td_file, cd_name, dd_value) 706 697 IMPLICIT NONE 707 698 ! Argument 708 699 TYPE(TFILE), INTENT(INOUT) :: td_file 709 CHARACTER(LEN=i p_vnl), DIMENSION(:), INTENT(IN) :: cd_name700 CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN) :: cd_name 710 701 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value 711 702 … … 722 713 723 714 ! define same dimension as in file 724 tl_dim(:)= td_file%t_dim(:)715 tl_dim(:)=dim_copy(td_file%t_dim(:)) 725 716 ! do not use X and Y dimension 726 717 td_file%t_var(ji)%t_dim(1:2)%l_use=.FALSE. … … 728 719 729 720 td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, & 730 & tl_dim(:), id_id=ji, & 731 & id_rec=INT(dd_value(ji),i4) ) 721 & tl_dim(:), dd_fill=0._dp, & 722 & id_id=ji, id_rec=INT(dd_value(ji),i4) ) 723 724 ! clean 725 CALL dim_clean(tl_dim(:)) 732 726 733 727 ENDDO 734 728 735 729 END SUBROUTINE iom_rstdimg__get_file_var_1d 736 !> @endcode 737 !------------------------------------------------------------------- 738 !> @brief This subroutine put information about variable 2D 730 !------------------------------------------------------------------- 731 !> @brief This subroutine put informations about variable 2D 739 732 !> inside file structure. 740 733 ! 741 734 !> @author J.Paul 742 !> - Nov, 2013- Initial Version 743 ! 744 !> @param[inout] td_file : file structure 745 !> @param[in] cd_name : table of variable name 746 !> @param[in] dd_value : table of variable record 747 !> @return file structure completed 748 !------------------------------------------------------------------- 749 !> @code 735 !> @date November, 2013 - Initial Version 736 ! 737 !> @param[inout] td_file file structure 738 !> @param[in] cd_name array of variable name 739 !> @param[in] dd_value array of variable record 740 !------------------------------------------------------------------- 750 741 SUBROUTINE iom_rstdimg__get_file_var_2d(td_file, cd_name, dd_value) 751 742 IMPLICIT NONE 752 743 ! Argument 753 744 TYPE(TFILE), INTENT(INOUT) :: td_file 754 CHARACTER(LEN=i p_vnl), DIMENSION(:), INTENT(IN) :: cd_name745 CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN) :: cd_name 755 746 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value 756 747 … … 767 758 768 759 ! define same dimension as in file 769 tl_dim(:)= td_file%t_dim(:)760 tl_dim(:)=dim_copy(td_file%t_dim(:)) 770 761 ! do not use Z dimension 771 762 tl_dim(3)%l_use=.FALSE. … … 773 764 774 765 td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, & 775 & tl_dim(:), id_id=ji, & 776 & id_rec=INT(dd_value(ji),i4) ) 766 & tl_dim(:), dd_fill=0._dp, & 767 & id_id=ji, id_rec=INT(dd_value(ji),i4) ) 768 769 ! clean 770 CALL dim_clean(tl_dim(:)) 777 771 778 772 ENDDO 779 773 780 774 END SUBROUTINE iom_rstdimg__get_file_var_2d 781 !> @endcode 782 !------------------------------------------------------------------- 783 !> @brief This subroutine put information about variable 3D 775 !------------------------------------------------------------------- 776 !> @brief This subroutine put informations about variable 3D 784 777 !> inside file structure. 785 778 ! 786 779 !> @author J.Paul 787 !> - Nov, 2013- Initial Version 788 ! 789 !> @param[inout] td_file : file structure 790 !> @param[in] cd_name : table of variable name 791 !> @param[in] dd_value : table of variable record 792 !> @return file structure completed 793 !------------------------------------------------------------------- 794 !> @code 780 !> @date November, 2013 - Initial Version 781 ! 782 !> @param[inout] td_file file structure 783 !> @param[in] cd_name array of variable name 784 !> @param[in] dd_value array of variable record 785 !------------------------------------------------------------------- 795 786 SUBROUTINE iom_rstdimg__get_file_var_3d(td_file, cd_name, dd_value) 796 787 IMPLICIT NONE 797 788 ! Argument 798 789 TYPE(TFILE), INTENT(INOUT) :: td_file 799 CHARACTER(LEN=i p_vnl), DIMENSION(:), INTENT(IN) :: cd_name790 CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN) :: cd_name 800 791 REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value 801 792 … … 812 803 813 804 ! define same dimension as in file 814 tl_dim(:)= td_file%t_dim(:)805 tl_dim(:)=dim_copy(td_file%t_dim(:)) 815 806 816 807 td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, & 817 & tl_dim(:), id_id=ji, & 818 & id_rec=INT(dd_value(ji),i4) ) 808 & tl_dim(:), dd_fill=0._dp, & 809 & id_id=ji, id_rec=INT(dd_value(ji),i4) ) 810 811 ! clean 812 CALL dim_clean(tl_dim(:)) 819 813 820 814 ENDDO 821 815 822 816 END SUBROUTINE iom_rstdimg__get_file_var_3d 823 !> @endcode824 817 !------------------------------------------------------------------- 825 818 !> @brief This function read one dimension in an opened netcdf file, … … 827 820 ! 828 821 !> @author J.Paul 829 !> - Nov, 2013- Initial Version830 ! 831 !> @param[in] td_file :file structure832 !> @param[in] id_dimid :dimension id822 !> @date November, 2013 - Initial Version 823 ! 824 !> @param[in] td_file file structure 825 !> @param[in] id_dimid dimension id 833 826 !> @return dimension structure 834 827 !------------------------------------------------------------------- 835 !> @code836 828 TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_id(td_file, id_dimid) 837 829 IMPLICIT NONE … … 866 858 867 859 END FUNCTION iom_rstdimg__read_dim_id 868 !> @endcode869 860 !------------------------------------------------------------------- 870 861 !> @brief This function read one dimension in an opened netcdf file, … … 872 863 ! 873 864 !> @author J.Paul 874 !> - Nov, 2013- Initial Version875 ! 876 !> @param[in] td_file :file structure877 !> @param[in] cd_name :dimension name865 !> @date November, 2013 - Initial Version 866 ! 867 !> @param[in] td_file file structure 868 !> @param[in] cd_name dimension name 878 869 !> @return dimension structure 879 870 !------------------------------------------------------------------- 880 !> @code881 871 TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_name(td_file, cd_name) 882 872 IMPLICIT NONE … … 909 899 910 900 END FUNCTION iom_rstdimg__read_dim_name 911 !> @endcode912 901 !------------------------------------------------------------------- 913 902 !> @brief This function read variable value in an opened 914 !> dimg file, given variable id.</br/> 915 !> start indices and number of indices selected along each dimension 916 !> could be specify in a 4 dimension table (/'x','y','z','t'/) 903 !> dimg file, given variable id. 904 !> @details 905 !> Optionaly, start indices and number of indices selected along each dimension 906 !> could be specify in a 4 dimension array (/'x','y','z','t'/) 917 907 ! 918 908 !> @author J.Paul 919 !> - Nov, 2013- Initial Version920 ! 921 !> @param[in] td_file :file structure922 !> @param[in] id_varid :variable id923 !> @param[in] id_start :index in the variable from which the data values909 !> @date November, 2013 - Initial Version 910 ! 911 !> @param[in] td_file file structure 912 !> @param[in] id_varid variable id 913 !> @param[in] id_start index in the variable from which the data values 924 914 !> will be read 925 !> @param[in] id_count :number of indices selected along each dimension915 !> @param[in] id_count number of indices selected along each dimension 926 916 !> @return variable structure 927 917 !------------------------------------------------------------------- 928 !> @code929 918 TYPE(TVAR) FUNCTION iom_rstdimg__read_var_id(td_file, id_varid,& 930 919 & id_start, id_count) … … 935 924 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 936 925 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count 937 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start938 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count939 926 940 927 ! local variable 941 INTEGER(i4), DIMENSION(1) :: il_ ind928 INTEGER(i4), DIMENSION(1) :: il_varid 942 929 !---------------------------------------------------------------- 943 930 ! check if file opened … … 950 937 951 938 ! look for variable id 952 il_ ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))953 IF( il_ ind(1) /= 0 )THEN954 955 iom_rstdimg__read_var_id= td_file%t_var(il_ind(1))939 il_varid(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid)) 940 IF( il_varid(1) /= 0 )THEN 941 942 iom_rstdimg__read_var_id=var_copy(td_file%t_var(il_varid(1))) 956 943 957 944 IF( iom_rstdimg__read_var_id%i_ndim /= 0 )THEN … … 962 949 ELSE 963 950 CALL logger_debug( " READ VAR: variable 0d "//& 964 & TRIM(td_file%t_var(il_ ind(1))%c_name)//&951 & TRIM(td_file%t_var(il_varid(1))%c_name)//& 965 952 & " should be already read ") 966 953 ENDIF … … 974 961 ENDIF 975 962 END FUNCTION iom_rstdimg__read_var_id 976 !> @endcode977 963 !------------------------------------------------------------------- 978 964 !> @brief This function read variable value in an opened 979 !> dimg file, given variable name or standard name.</br/> 980 !> start indices and number of indices selected along each dimension 981 !> could be specify in a 4 dimension table (/'x','y','z','t'/) 982 ! 965 !> dimg file, given variable name or standard name. 983 966 !> @details 967 !> Optionaly, start indices and number of indices selected along each dimension 968 !> could be specify in a 4 dimension array (/'x','y','z','t'/) 969 ! 984 970 !> look first for variable name. If it doesn't 985 971 !> exist in file, look for variable standard name.<br/> 986 !> If variable name is not present, check variable standard name.<br/>987 972 ! 988 973 !> @author J.Paul 989 !> - Nov, 2013- Initial Version990 ! 991 !> @param[in] td_file :file structure992 !> @param[in] cd_name :variable name or standard name993 !> @param[in] id_start :index in the variable from which the data values974 !> @date November, 2013 - Initial Version 975 ! 976 !> @param[in] td_file file structure 977 !> @param[in] cd_name variable name or standard name 978 !> @param[in] id_start index in the variable from which the data values 994 979 !> will be read 995 !> @param[in] id_count :number of indices selected along each dimension980 !> @param[in] id_count number of indices selected along each dimension 996 981 !> @return variable structure 997 982 !------------------------------------------------------------------- 998 !> @code999 983 TYPE(TVAR) FUNCTION iom_rstdimg__read_var_name(td_file, cd_name, & 1000 984 & id_start, id_count ) … … 1005 989 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 1006 990 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count 1007 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start1008 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count1009 991 1010 992 ! local variable 1011 INTEGER(i4) :: il_ ind993 INTEGER(i4) :: il_varid 1012 994 !---------------------------------------------------------------- 1013 995 ! check if file opened … … 1019 1001 ELSE 1020 1002 1021 il_ ind=var_get_id(td_file%t_var(:), cd_name)1022 IF( il_ ind /= 0 )THEN1023 1024 iom_rstdimg__read_var_name= td_file%t_var(il_ind)1025 1026 IF( td_file%t_var(il_ ind)%i_ndim /= 0 )THEN1003 il_varid=var_get_index(td_file%t_var(:), cd_name) 1004 IF( il_varid /= 0 )THEN 1005 1006 iom_rstdimg__read_var_name=var_copy(td_file%t_var(il_varid)) 1007 1008 IF( td_file%t_var(il_varid)%i_ndim /= 0 )THEN 1027 1009 !!! read variable value 1028 1010 CALL iom_rstdimg__read_var_value( td_file, & … … 1031 1013 ELSE 1032 1014 CALL logger_debug( " READ VAR: variable 0d "//& 1033 & TRIM(td_file%t_var(il_ ind)%c_name)//&1015 & TRIM(td_file%t_var(il_varid)%c_name)//& 1034 1016 & " should have been already read ") 1035 1017 ENDIF … … 1047 1029 1048 1030 END FUNCTION iom_rstdimg__read_var_name 1049 !> @endcode1050 !-------------------------------------------------------------------1051 !> @brief This subroutine fill all variable value in an opened1052 !> dimg file.</br/>1053 !> start indices and number of indices selected along each dimension1054 !> could be specify in a 4 dimension table (/'x','y','z','t'/)1055 !1056 !> @author J.Paul1057 !> - Nov, 2013- Initial Version1058 !1059 !> @param[inout] td_file : file structure1060 !> @param[in] id_start : index in the variable from which the data values1061 !> will be read1062 !> @param[in] id_count : number of indices selected along each dimension1063 !-------------------------------------------------------------------1064 !> @code1065 SUBROUTINE iom_rstdimg__fill_var_all(td_file, id_start, id_count)1066 IMPLICIT NONE1067 ! Argument1068 TYPE(TFILE), INTENT(INOUT) :: td_file1069 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start1070 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count1071 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start1072 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count1073 1074 ! local variable1075 1076 ! loop indices1077 INTEGER(i4) :: ji1078 !----------------------------------------------------------------1079 ! check if file opened1080 IF( td_file%i_id == 0 )THEN1081 1082 CALL logger_error( &1083 & " FILL VAR: no id associated to file "//TRIM(td_file%c_name))1084 1085 ELSE1086 1087 DO ji=1,td_file%i_nvar1088 CALL iom_rstdimg_fill_var(td_file, ji, id_start, id_count)1089 ENDDO1090 1091 ENDIF1092 END SUBROUTINE iom_rstdimg__fill_var_all1093 !> @endcode1094 !-------------------------------------------------------------------1095 !> @brief This subroutine fill variable value in an opened1096 !> dimg file, given variable id.</br/>1097 !> start indices and number of indices selected along each dimension1098 !> could be specify in a 4 dimension table (/'x','y','z','t'/)1099 !1100 !> @author J.Paul1101 !> - Nov, 2013- Initial Version1102 !1103 !> @param[inout] td_file : file structure1104 !> @param[in] id_varid : variable id1105 !> @param[in] id_start : index in the variable from which the data values1106 !> will be read1107 !> @param[in] id_count : number of indices selected along each dimension1108 !-------------------------------------------------------------------1109 !> @code1110 SUBROUTINE iom_rstdimg__fill_var_id(td_file, id_varid, id_start, id_count)1111 IMPLICIT NONE1112 ! Argument1113 TYPE(TFILE), INTENT(INOUT) :: td_file1114 INTEGER(i4), INTENT(IN) :: id_varid1115 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start1116 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count1117 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start1118 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count1119 1120 ! local variable1121 INTEGER(i4), DIMENSION(1) :: il_ind1122 TYPE(TVAR) :: tl_var1123 !----------------------------------------------------------------1124 ! check if file opened1125 IF( td_file%i_id == 0 )THEN1126 1127 CALL logger_error( &1128 & " FILL VAR: no id associated to file "//TRIM(td_file%c_name))1129 1130 ELSE1131 1132 ! look for variable id1133 il_ind(:) = MINLOC( td_file%t_var(:)%i_id, &1134 & mask=(td_file%t_var(:)%i_id==id_varid))1135 IF( il_ind(1) /= 0 )THEN1136 1137 IF( tl_var%i_ndim /= 0 )THEN1138 !!! read variable value1139 CALL iom_rstdimg__read_var_value(td_file, td_file%t_var(il_ind(1)), &1140 & id_start, id_count)1141 1142 ELSE1143 CALL logger_debug( " FILL VAR: variable 0d "//&1144 & TRIM(td_file%t_var(il_ind(1))%c_name)//&1145 & " should be already read ")1146 ENDIF1147 1148 ELSE1149 CALL logger_error( &1150 & " FILL VAR: there is no variable with id "//&1151 & TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))1152 ENDIF1153 1154 ENDIF1155 END SUBROUTINE iom_rstdimg__fill_var_id1156 !> @endcode1157 !-------------------------------------------------------------------1158 !> @brief This subroutine fill variable value in an opened1159 !> dimg file, given variable name or standard name.</br/>1160 !> start indices and number of indices selected along each dimension1161 !> could be specify in a 4 dimension table (/'x','y','z','t'/)1162 !1163 !> @details1164 !> look first for variable name. If it doesn't1165 !> exist in file, look for variable standard name.<br/>1166 !> If variable name is not present, check variable standard name.<br/>1167 !1168 !> @author J.Paul1169 !> - Nov, 2013- Initial Version1170 !1171 !> @param[inout] td_file : file structure1172 !> @param[in] cd_name : variable name or standard name1173 !> @param[in] id_start : index in the variable from which the data values1174 !> will be read1175 !> @param[in] id_count : number of indices selected along each dimension1176 !> @return variable structure1177 !-------------------------------------------------------------------1178 !> @code1179 SUBROUTINE iom_rstdimg__fill_var_name(td_file, cd_name, id_start, id_count )1180 IMPLICIT NONE1181 ! Argument1182 TYPE(TFILE), INTENT(INOUT) :: td_file1183 CHARACTER(LEN=*), INTENT(IN) :: cd_name1184 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start1185 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count1186 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start1187 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count1188 !CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname1189 1190 ! local variable1191 INTEGER(i4) :: il_ind1192 !----------------------------------------------------------------1193 ! check if file opened1194 IF( td_file%i_id == 0 )THEN1195 1196 CALL logger_error( &1197 & " FILL VAR: no id associated to file "//TRIM(td_file%c_name))1198 1199 ELSE1200 1201 il_ind=var_get_id(td_file%t_var, cd_name)1202 IF( il_ind /= 0 )THEN1203 1204 IF( td_file%t_var(il_ind)%i_ndim /= 0 )THEN1205 !!! read variable value1206 CALL iom_rstdimg__read_var_value( td_file, td_file%t_var(il_ind), &1207 & id_start, id_count)1208 1209 ELSE1210 CALL logger_debug( " FILL VAR: variable 0d "//&1211 & TRIM(td_file%t_var(il_ind)%c_name)//&1212 & " should have been already read ")1213 ENDIF1214 1215 ELSE1216 1217 CALL logger_error( &1218 & " FILL VAR: there is no variable with "//&1219 & " name or standard name "//TRIM(cd_name)//&1220 & " in file "//TRIM(td_file%c_name))1221 1222 ENDIF1223 1224 ENDIF1225 1226 END SUBROUTINE iom_rstdimg__fill_var_name1227 !> @endcode1228 1031 !------------------------------------------------------------------- 1229 1032 !> @brief This subroutine read variable value in an opened dimg file, for 1230 1033 !> variable 1,2,3d. 1231 ! 1034 !> @details 1035 !> Optionaly,start indices and number of indices selected along each dimension 1036 !> could be specify in a 4 dimension array (/'x','y','z','t'/) 1037 !> 1232 1038 !> @author J.Paul 1233 !> - Nov, 2013- Initial Version 1234 ! 1235 !> @param[in] td_file : file structure 1236 !> @param[inout] td_var : variable structure 1237 !> @param[in] id_start : index in the variable from which the data values will be read 1238 !> @param[in] id_count : number of indices selected along each dimension 1239 !> @return variable structure completed 1240 !------------------------------------------------------------------- 1241 !> @code 1039 !> @date November, 2013 - Initial Version 1040 ! 1041 !> @param[in] td_file file structure 1042 !> @param[inout] td_var variable structure 1043 !> @param[in] id_start index in the variable from which the data values will be read 1044 !> @param[in] id_count number of indices selected along each dimension 1045 !------------------------------------------------------------------- 1242 1046 SUBROUTINE iom_rstdimg__read_var_value(td_file, td_var, & 1243 1047 & id_start, id_count ) … … 1248 1052 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start 1249 1053 INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count 1250 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start1251 !INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count1252 1054 1253 1055 ! local variable … … 1256 1058 INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 1257 1059 INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 1060 1258 1061 REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 1259 1062 … … 1273 1076 IF( SIZE(id_start(:)) /= ip_maxdim .OR. & 1274 1077 & SIZE(id_count(:)) /= ip_maxdim )THEN 1275 CALL logger_error("READ VAR: dimension of tablestart or count "//&1078 CALL logger_error("READ VAR: dimension of array start or count "//& 1276 1079 & " are invalid to read variable "//TRIM(td_var%c_name)//& 1277 1080 & " in file "//TRIM(td_file%c_name) ) … … 1328 1131 & " READ VAR VALUE: not enough space to put variable "//& 1329 1132 & TRIM(td_var%c_name)//& 1330 & " in temporary table")1133 & " in temporary array") 1331 1134 1332 1135 ENDIF … … 1358 1161 ENDIF 1359 1162 ELSEIF( td_var%t_dim(3)%l_use )THEN 1360 ! 1 dvariable (Z)1163 ! 1D variable (Z) 1361 1164 READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) & 1362 1165 & dl_value(:,:,:,:) … … 1402 1205 ENDIF 1403 1206 1207 ! force to change _FillValue to avoid mistake 1208 ! with dummy zero _FillValue 1209 IF( td_var%d_fill == 0._dp )THEN 1210 CALL var_chg_FillValue(td_var) 1211 ENDIF 1212 1213 ! use scale factor and offset 1214 WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 1215 td_var%d_value(:,:,:,:) = & 1216 & td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs 1217 END WHERE 1218 1404 1219 END SUBROUTINE iom_rstdimg__read_var_value 1405 !> @endcode 1406 !------------------------------------------------------------------- 1407 !> @brief This subroutine write file structure in an opened dimg file. 1220 !------------------------------------------------------------------- 1221 !> @brief This subroutine write dimg file from file structure. 1408 1222 ! 1409 1223 !> @details 1410 ! 1224 !> dimg file have to be already opened in write mode. 1225 !> 1411 1226 !> @author J.Paul 1412 !> - Nov, 2013- Initial Version 1413 ! 1414 !> @param[in] td_file : file structure 1415 !------------------------------------------------------------------- 1416 !> @code 1227 !> @date November, 2013 - Initial Version 1228 !> @date September, 2014 1229 !> - use iom_rstdimg__get_rec 1230 ! 1231 !> @param[inout] td_file file structure 1232 !------------------------------------------------------------------- 1417 1233 SUBROUTINE iom_rstdimg_write_file(td_file) 1418 1234 IMPLICIT NONE … … 1421 1237 1422 1238 ! local variable 1423 INTEGER(i4) :: il_status1424 INTEGER(i4) :: il_attid1239 INTEGER(i4) :: il_status 1240 INTEGER(i4) :: il_ind 1425 1241 !---------------------------------------------------------------- 1426 1242 ! check if file opened … … 1433 1249 IF( td_file%l_wrt )THEN 1434 1250 1251 ! check dimension 1252 IF( td_file%t_dim(jp_L)%l_use .AND. & 1253 & td_file%t_dim(jp_L)%i_len /= 1 )THEN 1254 CALL logger_fatal("WRITE FILE: can not write dimg file with "//& 1255 & " several time step.") 1256 ENDIF 1257 1435 1258 ! close and open file with right record length 1436 1259 CALL iom_rstdimg_close(td_file) 1437 1260 1261 ! compute record number to be used 1262 ! and add variable no0d, no1d,.. if need be 1263 CALL iom_rstdimg__get_rec(td_file) 1264 1438 1265 ! compute record length 1439 il_ attid=att_get_id(td_file%t_att(:),"DOMAIN_number_total")1440 IF( il_ attid /= 0 )THEN1266 il_ind=att_get_index(td_file%t_att(:),"DOMAIN_number_total") 1267 IF( il_ind /= 0 )THEN 1441 1268 td_file%i_recl = MAX( & 1442 1269 & td_file%t_dim(1)%i_len * td_file%t_dim(2)%i_len * 8, & 1443 & ( 8 * INT(td_file%t_att(il_ attid)%d_value(1)) + 15 ) * 4 )1270 & ( 8 * INT(td_file%t_att(il_ind)%d_value(1)) + 15 ) * 4 ) 1444 1271 ELSE 1445 1272 td_file%i_recl = td_file%t_dim(1)%i_len * & 1446 1273 & td_file%t_dim(2)%i_len * 8 1447 1274 ENDIF 1275 ! check record length 1276 IF( td_file%i_nvar*(im_vnl+dp) > td_file%i_recl )THEN 1277 CALL logger_fatal("WRITE FILE: record length is too small. "//& 1278 & " Try to reduce the output number of processor.") 1279 ENDIF 1280 1281 ! get free unit 1282 td_file%i_id=fct_getunit() 1448 1283 1449 1284 OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),& … … 1456 1291 CALL fct_err(il_status) 1457 1292 IF( il_status /= 0 )THEN 1458 CALL logger_error(" REPLACE:file "//TRIM(td_file%c_name)//&1293 CALL logger_error("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//& 1459 1294 & " with record length "//TRIM(fct_str(td_file%i_recl))) 1460 1295 ELSE 1461 CALL logger_debug(" REPLACE:file "//TRIM(td_file%c_name)//&1296 CALL logger_debug("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//& 1462 1297 & " with record length "//TRIM(fct_str(td_file%i_recl))) 1463 1298 ENDIF … … 1479 1314 1480 1315 END SUBROUTINE iom_rstdimg_write_file 1481 !> @endcode 1316 !------------------------------------------------------------------- 1317 !> @brief This subroutine compute record number to be used. 1318 !> 1319 !> @details 1320 !> Moreover it adds variable no0d, no1d, no2d and no3d if need be. 1321 !> 1322 !> @author J.Paul 1323 !> @date September, 2014 - Initial Version 1324 ! 1325 !> @param[inout] td_file file structure 1326 !------------------------------------------------------------------- 1327 SUBROUTINE iom_rstdimg__get_rec(td_file) 1328 IMPLICIT NONE 1329 ! Argument 1330 TYPE(TFILE), INTENT(INOUT) :: td_file 1331 1332 ! local variable 1333 INTEGER(i4) :: il_rec 1334 TYPE(TVAR) :: tl_var 1335 1336 INTEGER(i4), DIMENSION(:) , ALLOCATABLE :: il_tmp1d 1337 INTEGER(i4), DIMENSION(:,:) , ALLOCATABLE :: il_tmp2d 1338 INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_tmp3d 1339 1340 ! loop indices 1341 INTEGER(i4) :: ji 1342 !---------------------------------------------------------------- 1343 1344 ! add dummy variable if necessary 1345 IF( td_file%i_n0d == 0 )THEN 1346 ! create var 1347 tl_var=var_init('no0d') 1348 1349 CALL file_add_var( td_file, tl_var ) 1350 ENDIF 1351 1352 IF( td_file%i_n1d == 0 )THEN 1353 ! create var 1354 ALLOCATE( il_tmp1d( td_file%t_dim(3)%i_len ) ) 1355 il_tmp1d(:)=-1 1356 1357 tl_var=var_init( 'no1d', il_tmp1d(:)) 1358 1359 DEALLOCATE( il_tmp1d ) 1360 1361 CALL file_add_var( td_file, tl_var ) 1362 ENDIF 1363 1364 IF( td_file%i_n2d == 0 )THEN 1365 ! create var 1366 ALLOCATE( il_tmp2d( td_file%t_dim(1)%i_len, & 1367 & td_file%t_dim(2)%i_len ) ) 1368 il_tmp2d(:,:)=-1 1369 1370 tl_var=var_init('no2d', il_tmp2d(:,:) ) 1371 1372 DEALLOCATE( il_tmp2d ) 1373 1374 CALL file_add_var( td_file, tl_var ) 1375 1376 ENDIF 1377 1378 IF( td_file%i_n3d == 0 )THEN 1379 ! create var 1380 ALLOCATE( il_tmp3d( td_file%t_dim(1)%i_len, & 1381 & td_file%t_dim(2)%i_len, & 1382 & td_file%t_dim(3)%i_len ) ) 1383 il_tmp3d(:,:,:)=-1 1384 1385 tl_var=var_init('no3d', il_tmp3d(:,:,:) ) 1386 1387 DEALLOCATE( il_tmp3d ) 1388 1389 CALL file_add_var( td_file, tl_var ) 1390 ENDIF 1391 1392 ! clean 1393 CALL var_clean(tl_var) 1394 1395 il_rec=2 1396 DO ji=1,td_file%i_nvar 1397 SELECT CASE(td_file%t_var(ji)%i_ndim) 1398 CASE(0) 1399 IF( INDEX(td_file%t_var(ji)%c_name, 'no0d' ) == 0 )THEN 1400 td_file%t_var(ji)%i_rec=il_rec 1401 il_rec = il_rec + 0 1402 ENDIF 1403 CASE(1) 1404 IF( INDEX(td_file%t_var(ji)%c_name, 'no1d' ) == 0 )THEN 1405 td_file%t_var(ji)%i_rec=il_rec 1406 il_rec = il_rec + 1 1407 ENDIF 1408 CASE(2) 1409 IF( INDEX(td_file%t_var(ji)%c_name, 'no2d' ) == 0 )THEN 1410 td_file%t_var(ji)%i_rec=il_rec 1411 il_rec = il_rec + 1 1412 ENDIF 1413 CASE(3) 1414 IF( INDEX(td_file%t_var(ji)%c_name, 'no3d' ) == 0 )THEN 1415 td_file%t_var(ji)%i_rec=il_rec 1416 il_rec = il_rec + td_file%t_dim(3)%i_len 1417 ENDIF 1418 END SELECT 1419 ENDDO 1420 td_file%i_rhd = il_rec 1421 1422 END SUBROUTINE iom_rstdimg__get_rec 1482 1423 !------------------------------------------------------------------- 1483 1424 !> @brief This subroutine write header in an opened dimg … … 1485 1426 ! 1486 1427 !> @author J.Paul 1487 !> - Nov, 2013- Initial Version 1488 ! 1489 !> @param[in] td_file : file structure 1490 !> @param[in] td_dim : dimension structure 1491 !> @return dimension id 1492 !------------------------------------------------------------------- 1493 !> @code 1428 !> @date November, 2013 - Initial Version 1429 ! 1430 !> @param[inout] td_file file structure 1431 !------------------------------------------------------------------- 1494 1432 SUBROUTINE iom_rstdimg__write_header(td_file) 1495 1433 IMPLICIT NONE … … 1499 1437 ! local variable 1500 1438 INTEGER(i4) :: il_status 1501 INTEGER(i4) :: il_ attid1439 INTEGER(i4) :: il_ind 1502 1440 INTEGER(i4) :: il_nproc 1503 1441 INTEGER(i4) :: il_niproc … … 1537 1475 1538 1476 ! get domain decomposition 1539 il_ attid=att_get_id( td_file%t_att, "DOMAIN_number_total" )1477 il_ind=att_get_index( td_file%t_att, "DOMAIN_number_total" ) 1540 1478 il_nproc = 1 1541 IF( il_ attid /= 0 )THEN1542 il_nproc = INT(td_file%t_att(il_ attid)%d_value(1))1543 ENDIF 1544 1545 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_number_total" )1479 IF( il_ind /= 0 )THEN 1480 il_nproc = INT(td_file%t_att(il_ind)%d_value(1)) 1481 ENDIF 1482 1483 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_number_total" ) 1546 1484 il_niproc = 0 1547 IF( il_ attid /= 0 )THEN1548 il_niproc = INT(td_file%t_att(il_ attid)%d_value(1))1549 ENDIF 1550 1551 il_ attid=att_get_id( td_file%t_att, "DOMAIN_J_number_total" )1485 IF( il_ind /= 0 )THEN 1486 il_niproc = INT(td_file%t_att(il_ind)%d_value(1)) 1487 ENDIF 1488 1489 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_number_total" ) 1552 1490 il_njproc = 0 1553 IF( il_ attid /= 0 )THEN1554 il_njproc = INT(td_file%t_att(il_ attid)%d_value(1))1491 IF( il_ind /= 0 )THEN 1492 il_njproc = INT(td_file%t_att(il_ind)%d_value(1)) 1555 1493 ENDIF 1556 1494 … … 1570 1508 1571 1509 ! get domain number 1572 il_ attid=att_get_id( td_file%t_att, "DOMAIN_number" )1510 il_ind=att_get_index( td_file%t_att, "DOMAIN_number" ) 1573 1511 il_area = 0 1574 IF( il_ attid /= 0 )THEN1575 il_area = INT(td_file%t_att(il_ attid)%d_value(1))1512 IF( il_ind /= 0 )THEN 1513 il_area = INT(td_file%t_att(il_ind)%d_value(1)) 1576 1514 ENDIF 1577 1515 1578 1516 ! get domain global size 1579 il_ attid=att_get_id( td_file%t_att, "DOMAIN_size_global" )1517 il_ind=att_get_index( td_file%t_att, "DOMAIN_size_global" ) 1580 1518 il_iglo = 0 1581 1519 il_jglo = 0 1582 IF( il_ attid /= 0 )THEN1583 il_iglo = INT(td_file%t_att(il_ attid)%d_value(1))1584 il_jglo = INT(td_file%t_att(il_ attid)%d_value(2))1520 IF( il_ind /= 0 )THEN 1521 il_iglo = INT(td_file%t_att(il_ind)%d_value(1)) 1522 il_jglo = INT(td_file%t_att(il_ind)%d_value(2)) 1585 1523 ENDIF 1586 1524 … … 1600 1538 ! allocate local variable 1601 1539 ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),& 1602 & il_lci(il_n iproc), il_lcj(il_njproc), &1603 & il_ldi(il_n iproc), il_ldj(il_njproc), &1604 & il_lei(il_n iproc), il_lej(il_njproc) )1540 & il_lci(il_nproc), il_lcj(il_nproc), & 1541 & il_ldi(il_nproc), il_ldj(il_nproc), & 1542 & il_lei(il_nproc), il_lej(il_nproc) ) 1605 1543 1606 1544 ! get domain first poistion 1607 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_position_first" )1545 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_first" ) 1608 1546 il_impp(:) = 0 1609 IF( il_ attid /= 0 )THEN1610 il_impp(:) = INT(td_file%t_att(il_ attid)%d_value(:))1611 ENDIF 1612 1613 il_ attid=att_get_id( td_file%t_att, "DOMAIN_J_position_first" )1547 IF( il_ind /= 0 )THEN 1548 il_impp(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1549 ENDIF 1550 1551 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_first" ) 1614 1552 il_jmpp(:) = 0 1615 IF( il_ attid /= 0 )THEN1616 il_jmpp(:) = INT(td_file%t_att(il_ attid)%d_value(:))1553 IF( il_ind /= 0 )THEN 1554 il_jmpp(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1617 1555 ENDIF 1618 1556 … … 1623 1561 1624 1562 ! get domain last poistion 1625 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_position_last" )1563 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_last" ) 1626 1564 il_lci(:) = 0 1627 IF( il_ attid /= 0 )THEN1628 il_lci(:) = INT(td_file%t_att(il_ attid)%d_value(:))1629 ENDIF 1630 1631 il_ attid=att_get_id( td_file%t_att, "DOMAIN_J_position_last" )1565 IF( il_ind /= 0 )THEN 1566 il_lci(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1567 ENDIF 1568 1569 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_last" ) 1632 1570 il_lcj(:) = 0 1633 IF( il_ attid /= 0 )THEN1634 il_lcj(:) = INT(td_file%t_att(il_ attid)%d_value(:))1571 IF( il_ind /= 0 )THEN 1572 il_lcj(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1635 1573 ENDIF 1636 1574 … … 1641 1579 1642 1580 ! get halo size start 1643 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_halo_size_start" )1581 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_start" ) 1644 1582 il_ldi(:) = 0 1645 IF( il_ attid /= 0 )THEN1646 il_ldi(:) = INT(td_file%t_att(il_ attid)%d_value(:))1647 ENDIF 1648 1649 il_ attid=att_get_id( td_file%t_att, "DOMAIN_J_halo_size_start" )1583 IF( il_ind /= 0 )THEN 1584 il_ldi(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1585 ENDIF 1586 1587 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_start" ) 1650 1588 il_ldj(:) = 0 1651 IF( il_ attid /= 0 )THEN1652 il_ldj(:) = INT(td_file%t_att(il_ attid)%d_value(:))1589 IF( il_ind /= 0 )THEN 1590 il_ldj(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1653 1591 ENDIF 1654 1592 … … 1659 1597 1660 1598 ! get halo size end 1661 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_halo_size_end" )1599 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_end" ) 1662 1600 il_lei(:) = 0 1663 IF( il_ attid /= 0 )THEN1664 il_lei(:) = INT(td_file%t_att(il_ attid)%d_value(:))1665 ENDIF 1666 1667 il_ attid=att_get_id( td_file%t_att, "DOMAIN_J_halo_size_end" )1601 IF( il_ind /= 0 )THEN 1602 il_lei(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1603 ENDIF 1604 1605 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_end" ) 1668 1606 il_lej(:) = 0 1669 IF( il_ attid /= 0 )THEN1670 il_lej(:) = INT(td_file%t_att(il_ attid)%d_value(:))1607 IF( il_ind /= 0 )THEN 1608 il_lej(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1671 1609 ENDIF 1672 1610 … … 1690 1628 & il_area, & 1691 1629 & il_iglo, il_jglo, & 1692 & il_impp(:), il_jmpp(:), &1693 1630 & il_lci(:), il_lcj(:), & 1694 1631 & il_ldi(:), il_ldj(:), & 1695 & il_lei(:), il_lej(:) 1632 & il_lei(:), il_lej(:), & 1633 & il_impp(:), il_jmpp(:) 1696 1634 1697 1635 DEALLOCATE( il_impp, il_jmpp,& … … 1701 1639 1702 1640 END SUBROUTINE iom_rstdimg__write_header 1703 !> @endcode 1704 !------------------------------------------------------------------- 1705 !> @brief This subroutine write variables in an opened dimg file.</br/> 1706 ! 1641 !------------------------------------------------------------------- 1642 !> @brief This subroutine write variables in an opened dimg file. 1643 !> 1707 1644 !> @author J.Paul 1708 !> - Nov, 2013- Initial Version 1709 ! 1710 !> @param[in] id_fileid : file id 1711 !------------------------------------------------------------------- 1712 !> @code 1645 !> @date November, 2013 - Initial Version 1646 !> @date July, 2015 1647 !> - bug fix: do not use scale factor an offset for case no0d, no1d... 1648 !> 1649 !> @param[in] td_file file structure 1650 !------------------------------------------------------------------- 1713 1651 SUBROUTINE iom_rstdimg__write_var(td_file) 1714 1652 IMPLICIT NONE … … 1718 1656 ! local variable 1719 1657 INTEGER(i4) :: il_status 1720 TYPE(TVAR) :: tl_var1658 INTEGER(i4) :: il_rec 1721 1659 1722 1660 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_start 1723 1661 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_count 1724 CHARACTER(LEN=i p_vnl), DIMENSION(:), ALLOCATABLE :: cl_name1662 CHARACTER(LEN=im_vnl), DIMENSION(:), ALLOCATABLE :: cl_name 1725 1663 REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value 1726 1727 INTEGER(i4), DIMENSION(:,:,:,:), ALLOCATABLE :: il_tmp1728 1664 1729 1665 ! loop indices 1730 1666 INTEGER(i4) :: ji 1667 INTEGER(i4) :: jk 1731 1668 !---------------------------------------------------------------- 1732 1733 ! add dummy variable if necessary1734 IF( td_file%i_n0d == 0 )THEN1735 ! create var1736 tl_var=var_init('no0d')1737 ! add value1738 ALLOCATE( il_tmp(1,1,1,1) )1739 il_tmp(:,:,:,:)=-11740 CALL var_add_value(tl_var, il_tmp)1741 DEALLOCATE( il_tmp )1742 1743 CALL file_add_var( td_file, tl_var )1744 ENDIF1745 1746 IF( td_file%i_n1d == 0 )THEN1747 ! create var1748 tl_var=var_init('no1d')1749 ! add dimension1750 CALL var_add_dim(tl_var, td_file%t_dim(3))1751 ! add value1752 ALLOCATE( il_tmp(1,1,td_file%t_dim(3)%i_len, 1) )1753 il_tmp(:,:,:,:)=-11754 CALL var_add_value(tl_var, il_tmp)1755 DEALLOCATE( il_tmp )1756 1757 CALL file_add_var( td_file, tl_var )1758 ENDIF1759 1760 IF( td_file%i_n2d == 0 )THEN1761 ! create var1762 tl_var=var_init('no2d' )1763 ! add dimension1764 CALL var_add_dim(tl_var, td_file%t_dim(1))1765 CALL var_add_dim(tl_var, td_file%t_dim(2))1766 ! add value1767 ALLOCATE( il_tmp( td_file%t_dim(1)%i_len, &1768 & td_file%t_dim(2)%i_len, &1769 & 1, &1770 & 1 ) )1771 il_tmp(:,:,:,:)=-11772 CALL var_add_value(tl_var, il_tmp)1773 DEALLOCATE( il_tmp )1774 1775 CALL file_add_var( td_file, tl_var )1776 ENDIF1777 1778 IF( td_file%i_n3d == 0 )THEN1779 ! create var1780 tl_var=var_init('no3d' )1781 ! add dimension1782 CALL var_add_dim(tl_var, td_file%t_dim(1))1783 CALL var_add_dim(tl_var, td_file%t_dim(2))1784 CALL var_add_dim(tl_var, td_file%t_dim(3))1785 ! add value1786 ALLOCATE( il_tmp( td_file%t_dim(1)%i_len, &1787 & td_file%t_dim(2)%i_len, &1788 & td_file%t_dim(3)%i_len, &1789 & 1 ) )1790 il_tmp(:,:,:,:)=-11791 CALL var_add_value(tl_var, il_tmp)1792 DEALLOCATE( il_tmp )1793 1794 CALL file_add_var( td_file, tl_var )1795 ENDIF1796 1669 1797 1670 ! reform name and record 1798 1671 ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) ) 1672 1799 1673 DO ji=1,td_file%i_nvar 1674 1675 ! change FillValue to 0. 1676 CALL var_chg_FillValue(td_file%t_var(ji),0._dp) 1677 1800 1678 cl_name(ji) = TRIM(td_file%t_var(ji)%c_name) 1801 1679 dl_value(ji) = REAL(td_file%t_var(ji)%i_rec,dp) 1802 ENDDO 1803 1804 ! special case for 0d 1805 DO ji=1,td_file%i_n0d 1806 dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1) 1680 1681 SELECT CASE (TRIM(td_file%t_var(ji)%c_name)) 1682 CASE('no0d','no1d','no2d','no3d') 1683 CASE DEFAULT 1684 1685 ! use scale factor and offset 1686 WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= & 1687 & td_file%t_var(ji)%d_fill ) 1688 td_file%t_var(ji)%d_value(:,:,:,:) = & 1689 & ( td_file%t_var(ji)%d_value(:,:,:,:) - & 1690 & td_file%t_var(ji)%d_ofs ) / & 1691 & td_file%t_var(ji)%d_scf 1692 END WHERE 1693 1694 DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len 1695 SELECT CASE (td_file%t_var(ji)%i_ndim) 1696 CASE(0) 1697 ! special case for 0d, value save in rec 1698 dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1) 1699 il_rec = td_file%t_var(ji)%i_rec 1700 CASE(1,2) 1701 il_rec = td_file%t_var(ji)%i_rec 1702 CASE(3) 1703 il_rec = td_file%t_var(ji)%i_rec + jk -1 1704 END SELECT 1705 WRITE( td_file%i_id, IOSTAT=il_status, REC=il_rec ) & 1706 & td_file%t_var(ji)%d_value(:,:,jk,1) 1707 CALL fct_err(il_status) 1708 IF( il_status /= 0 )THEN 1709 CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//& 1710 & "write variable "//TRIM(td_file%t_var(ji)%c_name)//& 1711 & " in record "//TRIM(fct_str(il_rec))) 1712 ENDIF 1713 ENDDO 1714 END SELECT 1715 1807 1716 ENDDO 1808 1717 … … 1820 1729 il_start(4) = 1 + il_count(3) 1821 1730 il_count(4) = il_start(4) - 1 + td_file%i_n3d 1822 1823 1731 1824 1732 WRITE(td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )& … … 1827 1735 & cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),& 1828 1736 & cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4)) 1829 1737 CALL fct_err(il_status) 1738 IF( il_status /= 0 )THEN 1739 CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//& 1740 & "write restart header in record "//TRIM(fct_str(td_file%i_rhd))) 1741 ENDIF 1742 1743 ! clean 1744 DEALLOCATE( cl_name, dl_value ) 1830 1745 DEALLOCATE( il_start, il_count ) 1831 1746 1832 1747 END SUBROUTINE iom_rstdimg__write_var 1833 !> @endcode1834 1748 END MODULE iom_rstdimg
Note: See TracChangeset
for help on using the changeset viewer.