Changeset 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
- Timestamp:
- 2015-07-15T17:46:12+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90
r4213 r5600 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 !> - 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 !> - 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 !> - 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 !> - 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 !> - 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 !> - 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 !> - 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 !> - 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 !> - 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, … … 829 822 !> - Nov, 2013- Initial Version 830 823 ! 831 !> @param[in] td_file :file structure832 !> @param[in] id_dimid :dimension id824 !> @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, … … 874 865 !> - Nov, 2013- Initial Version 875 866 ! 876 !> @param[in] td_file :file structure877 !> @param[in] cd_name :dimension name867 !> @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 !> - 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 !> - 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 !> - 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 … … 1273 1075 IF( SIZE(id_start(:)) /= ip_maxdim .OR. & 1274 1076 & SIZE(id_count(:)) /= ip_maxdim )THEN 1275 CALL logger_error("READ VAR: dimension of tablestart or count "//&1077 CALL logger_error("READ VAR: dimension of array start or count "//& 1276 1078 & " are invalid to read variable "//TRIM(td_var%c_name)//& 1277 1079 & " in file "//TRIM(td_file%c_name) ) … … 1328 1130 & " READ VAR VALUE: not enough space to put variable "//& 1329 1131 & TRIM(td_var%c_name)//& 1330 & " in temporary table")1132 & " in temporary array") 1331 1133 1332 1134 ENDIF … … 1358 1160 ENDIF 1359 1161 ELSEIF( td_var%t_dim(3)%l_use )THEN 1360 ! 1 dvariable (Z)1162 ! 1D variable (Z) 1361 1163 READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) & 1362 1164 & dl_value(:,:,:,:) … … 1403 1205 1404 1206 END SUBROUTINE iom_rstdimg__read_var_value 1405 !> @endcode 1406 !------------------------------------------------------------------- 1407 !> @brief This subroutine write file structure in an opened dimg file. 1207 !------------------------------------------------------------------- 1208 !> @brief This subroutine write dimg file from file structure. 1408 1209 ! 1409 1210 !> @details 1410 ! 1211 !> dimg file have to be already opened in write mode. 1212 !> 1411 1213 !> @author J.Paul 1412 !> - Nov, 2013- Initial Version 1413 ! 1414 !> @param[in] td_file : file structure 1415 !------------------------------------------------------------------- 1416 !> @code 1214 !> - November, 2013- Initial Version 1215 !> @date September, 2014 1216 !> - use iom_rstdimg__get_rec 1217 ! 1218 !> @param[inout] td_file file structure 1219 !------------------------------------------------------------------- 1417 1220 SUBROUTINE iom_rstdimg_write_file(td_file) 1418 1221 IMPLICIT NONE … … 1421 1224 1422 1225 ! local variable 1423 INTEGER(i4) :: il_status1424 INTEGER(i4) :: il_attid1226 INTEGER(i4) :: il_status 1227 INTEGER(i4) :: il_ind 1425 1228 !---------------------------------------------------------------- 1426 1229 ! check if file opened … … 1433 1236 IF( td_file%l_wrt )THEN 1434 1237 1238 ! check dimension 1239 IF( td_file%t_dim(jp_L)%l_use .AND. & 1240 & td_file%t_dim(jp_L)%i_len /= 1 )THEN 1241 CALL logger_fatal("WRITE FILE: can not write dimg file with "//& 1242 & " several time step.") 1243 ENDIF 1244 1435 1245 ! close and open file with right record length 1436 1246 CALL iom_rstdimg_close(td_file) 1437 1247 1248 ! compute record number to be used 1249 ! and add variable no0d, no1d,.. if need be 1250 CALL iom_rstdimg__get_rec(td_file) 1251 1438 1252 ! compute record length 1439 il_ attid=att_get_id(td_file%t_att(:),"DOMAIN_number_total")1440 IF( il_ attid /= 0 )THEN1253 il_ind=att_get_index(td_file%t_att(:),"DOMAIN_number_total") 1254 IF( il_ind /= 0 )THEN 1441 1255 td_file%i_recl = MAX( & 1442 1256 & 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 )1257 & ( 8 * INT(td_file%t_att(il_ind)%d_value(1)) + 15 ) * 4 ) 1444 1258 ELSE 1445 1259 td_file%i_recl = td_file%t_dim(1)%i_len * & 1446 1260 & td_file%t_dim(2)%i_len * 8 1447 1261 ENDIF 1262 ! check record length 1263 IF( td_file%i_nvar*(im_vnl+dp) > td_file%i_recl )THEN 1264 CALL logger_fatal("WRITE FILE: record length is too small. "//& 1265 & " Try to reduce the output number of processor.") 1266 ENDIF 1267 1268 ! get free unit 1269 td_file%i_id=fct_getunit() 1448 1270 1449 1271 OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),& … … 1456 1278 CALL fct_err(il_status) 1457 1279 IF( il_status /= 0 )THEN 1458 CALL logger_error(" REPLACE:file "//TRIM(td_file%c_name)//&1280 CALL logger_error("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//& 1459 1281 & " with record length "//TRIM(fct_str(td_file%i_recl))) 1460 1282 ELSE 1461 CALL logger_debug(" REPLACE:file "//TRIM(td_file%c_name)//&1283 CALL logger_debug("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//& 1462 1284 & " with record length "//TRIM(fct_str(td_file%i_recl))) 1463 1285 ENDIF … … 1479 1301 1480 1302 END SUBROUTINE iom_rstdimg_write_file 1481 !> @endcode 1303 !------------------------------------------------------------------- 1304 !> @brief This subroutine compute record number to be used. 1305 !> 1306 !> @details 1307 !> Moreover it adds variable no0d, no1d, no2d and no3d if need be. 1308 !> 1309 !> @author J.Paul 1310 !> - September, 2014- Initial Version 1311 ! 1312 !> @param[inout] td_file file structure 1313 !------------------------------------------------------------------- 1314 SUBROUTINE iom_rstdimg__get_rec(td_file) 1315 IMPLICIT NONE 1316 ! Argument 1317 TYPE(TFILE), INTENT(INOUT) :: td_file 1318 1319 ! local variable 1320 INTEGER(i4) :: il_rec 1321 TYPE(TVAR) :: tl_var 1322 1323 INTEGER(i4), DIMENSION(:) , ALLOCATABLE :: il_tmp1d 1324 INTEGER(i4), DIMENSION(:,:) , ALLOCATABLE :: il_tmp2d 1325 INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_tmp3d 1326 1327 ! loop indices 1328 INTEGER(i4) :: ji 1329 !---------------------------------------------------------------- 1330 1331 ! add dummy variable if necessary 1332 IF( td_file%i_n0d == 0 )THEN 1333 ! create var 1334 tl_var=var_init('no0d') 1335 1336 CALL file_add_var( td_file, tl_var ) 1337 ENDIF 1338 1339 IF( td_file%i_n1d == 0 )THEN 1340 ! create var 1341 ALLOCATE( il_tmp1d( td_file%t_dim(3)%i_len ) ) 1342 il_tmp1d(:)=-1 1343 1344 tl_var=var_init( 'no1d', il_tmp1d(:)) 1345 1346 DEALLOCATE( il_tmp1d ) 1347 1348 CALL file_add_var( td_file, tl_var ) 1349 ENDIF 1350 1351 IF( td_file%i_n2d == 0 )THEN 1352 ! create var 1353 ALLOCATE( il_tmp2d( td_file%t_dim(1)%i_len, & 1354 & td_file%t_dim(2)%i_len ) ) 1355 il_tmp2d(:,:)=-1 1356 1357 tl_var=var_init('no2d', il_tmp2d(:,:) ) 1358 1359 DEALLOCATE( il_tmp2d ) 1360 1361 CALL file_add_var( td_file, tl_var ) 1362 1363 ENDIF 1364 1365 IF( td_file%i_n3d == 0 )THEN 1366 ! create var 1367 ALLOCATE( il_tmp3d( td_file%t_dim(1)%i_len, & 1368 & td_file%t_dim(2)%i_len, & 1369 & td_file%t_dim(3)%i_len ) ) 1370 il_tmp3d(:,:,:)=-1 1371 1372 tl_var=var_init('no3d', il_tmp3d(:,:,:) ) 1373 1374 DEALLOCATE( il_tmp3d ) 1375 1376 CALL file_add_var( td_file, tl_var ) 1377 ENDIF 1378 1379 ! clean 1380 CALL var_clean(tl_var) 1381 1382 il_rec=2 1383 DO ji=1,td_file%i_nvar 1384 SELECT CASE(td_file%t_var(ji)%i_ndim) 1385 CASE(0) 1386 IF( INDEX(td_file%t_var(ji)%c_name, 'no0d' ) == 0 )THEN 1387 td_file%t_var(ji)%i_rec=il_rec 1388 il_rec = il_rec + 0 1389 ENDIF 1390 CASE(1) 1391 IF( INDEX(td_file%t_var(ji)%c_name, 'no1d' ) == 0 )THEN 1392 td_file%t_var(ji)%i_rec=il_rec 1393 il_rec = il_rec + 1 1394 ENDIF 1395 CASE(2) 1396 IF( INDEX(td_file%t_var(ji)%c_name, 'no2d' ) == 0 )THEN 1397 td_file%t_var(ji)%i_rec=il_rec 1398 il_rec = il_rec + 1 1399 ENDIF 1400 CASE(3) 1401 IF( INDEX(td_file%t_var(ji)%c_name, 'no3d' ) == 0 )THEN 1402 td_file%t_var(ji)%i_rec=il_rec 1403 il_rec = il_rec + td_file%t_dim(3)%i_len 1404 ENDIF 1405 END SELECT 1406 ENDDO 1407 td_file%i_rhd = il_rec 1408 1409 END SUBROUTINE iom_rstdimg__get_rec 1482 1410 !------------------------------------------------------------------- 1483 1411 !> @brief This subroutine write header in an opened dimg … … 1485 1413 ! 1486 1414 !> @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 1415 !> - November, 2013- Initial Version 1416 ! 1417 !> @param[inout] td_file file structure 1418 !------------------------------------------------------------------- 1494 1419 SUBROUTINE iom_rstdimg__write_header(td_file) 1495 1420 IMPLICIT NONE … … 1499 1424 ! local variable 1500 1425 INTEGER(i4) :: il_status 1501 INTEGER(i4) :: il_ attid1426 INTEGER(i4) :: il_ind 1502 1427 INTEGER(i4) :: il_nproc 1503 1428 INTEGER(i4) :: il_niproc … … 1537 1462 1538 1463 ! get domain decomposition 1539 il_ attid=att_get_id( td_file%t_att, "DOMAIN_number_total" )1464 il_ind=att_get_index( td_file%t_att, "DOMAIN_number_total" ) 1540 1465 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" )1466 IF( il_ind /= 0 )THEN 1467 il_nproc = INT(td_file%t_att(il_ind)%d_value(1)) 1468 ENDIF 1469 1470 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_number_total" ) 1546 1471 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" )1472 IF( il_ind /= 0 )THEN 1473 il_niproc = INT(td_file%t_att(il_ind)%d_value(1)) 1474 ENDIF 1475 1476 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_number_total" ) 1552 1477 il_njproc = 0 1553 IF( il_ attid /= 0 )THEN1554 il_njproc = INT(td_file%t_att(il_ attid)%d_value(1))1478 IF( il_ind /= 0 )THEN 1479 il_njproc = INT(td_file%t_att(il_ind)%d_value(1)) 1555 1480 ENDIF 1556 1481 … … 1570 1495 1571 1496 ! get domain number 1572 il_ attid=att_get_id( td_file%t_att, "DOMAIN_number" )1497 il_ind=att_get_index( td_file%t_att, "DOMAIN_number" ) 1573 1498 il_area = 0 1574 IF( il_ attid /= 0 )THEN1575 il_area = INT(td_file%t_att(il_ attid)%d_value(1))1499 IF( il_ind /= 0 )THEN 1500 il_area = INT(td_file%t_att(il_ind)%d_value(1)) 1576 1501 ENDIF 1577 1502 1578 1503 ! get domain global size 1579 il_ attid=att_get_id( td_file%t_att, "DOMAIN_size_global" )1504 il_ind=att_get_index( td_file%t_att, "DOMAIN_size_global" ) 1580 1505 il_iglo = 0 1581 1506 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))1507 IF( il_ind /= 0 )THEN 1508 il_iglo = INT(td_file%t_att(il_ind)%d_value(1)) 1509 il_jglo = INT(td_file%t_att(il_ind)%d_value(2)) 1585 1510 ENDIF 1586 1511 … … 1600 1525 ! allocate local variable 1601 1526 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) )1527 & il_lci(il_nproc), il_lcj(il_nproc), & 1528 & il_ldi(il_nproc), il_ldj(il_nproc), & 1529 & il_lei(il_nproc), il_lej(il_nproc) ) 1605 1530 1606 1531 ! get domain first poistion 1607 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_position_first" )1532 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_first" ) 1608 1533 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" )1534 IF( il_ind /= 0 )THEN 1535 il_impp(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1536 ENDIF 1537 1538 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_first" ) 1614 1539 il_jmpp(:) = 0 1615 IF( il_ attid /= 0 )THEN1616 il_jmpp(:) = INT(td_file%t_att(il_ attid)%d_value(:))1540 IF( il_ind /= 0 )THEN 1541 il_jmpp(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1617 1542 ENDIF 1618 1543 … … 1623 1548 1624 1549 ! get domain last poistion 1625 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_position_last" )1550 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_last" ) 1626 1551 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" )1552 IF( il_ind /= 0 )THEN 1553 il_lci(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1554 ENDIF 1555 1556 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_last" ) 1632 1557 il_lcj(:) = 0 1633 IF( il_ attid /= 0 )THEN1634 il_lcj(:) = INT(td_file%t_att(il_ attid)%d_value(:))1558 IF( il_ind /= 0 )THEN 1559 il_lcj(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1635 1560 ENDIF 1636 1561 … … 1641 1566 1642 1567 ! get halo size start 1643 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_halo_size_start" )1568 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_start" ) 1644 1569 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" )1570 IF( il_ind /= 0 )THEN 1571 il_ldi(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1572 ENDIF 1573 1574 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_start" ) 1650 1575 il_ldj(:) = 0 1651 IF( il_ attid /= 0 )THEN1652 il_ldj(:) = INT(td_file%t_att(il_ attid)%d_value(:))1576 IF( il_ind /= 0 )THEN 1577 il_ldj(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1653 1578 ENDIF 1654 1579 … … 1659 1584 1660 1585 ! get halo size end 1661 il_ attid=att_get_id( td_file%t_att, "DOMAIN_I_halo_size_end" )1586 il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_end" ) 1662 1587 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" )1588 IF( il_ind /= 0 )THEN 1589 il_lei(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1590 ENDIF 1591 1592 il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_end" ) 1668 1593 il_lej(:) = 0 1669 IF( il_ attid /= 0 )THEN1670 il_lej(:) = INT(td_file%t_att(il_ attid)%d_value(:))1594 IF( il_ind /= 0 )THEN 1595 il_lej(:) = INT(td_file%t_att(il_ind)%d_value(:)) 1671 1596 ENDIF 1672 1597 … … 1690 1615 & il_area, & 1691 1616 & il_iglo, il_jglo, & 1692 & il_impp(:), il_jmpp(:), &1693 1617 & il_lci(:), il_lcj(:), & 1694 1618 & il_ldi(:), il_ldj(:), & 1695 & il_lei(:), il_lej(:) 1619 & il_lei(:), il_lej(:), & 1620 & il_impp(:), il_jmpp(:) 1696 1621 1697 1622 DEALLOCATE( il_impp, il_jmpp,& … … 1701 1626 1702 1627 END SUBROUTINE iom_rstdimg__write_header 1703 !> @endcode 1704 !------------------------------------------------------------------- 1705 !> @brief This subroutine write variables in an opened dimg file.</br/> 1706 ! 1628 !------------------------------------------------------------------- 1629 !> @brief This subroutine write variables in an opened dimg file. 1630 !> 1707 1631 !> @author J.Paul 1708 !> - Nov, 2013- Initial Version 1709 ! 1710 !> @param[in] id_fileid : file id 1711 !------------------------------------------------------------------- 1712 !> @code 1632 !> - November, 2013- Initial Version 1633 !> 1634 !> @param[in] id_fileid file id 1635 !------------------------------------------------------------------- 1713 1636 SUBROUTINE iom_rstdimg__write_var(td_file) 1714 1637 IMPLICIT NONE … … 1718 1641 ! local variable 1719 1642 INTEGER(i4) :: il_status 1720 TYPE(TVAR) :: tl_var1643 INTEGER(i4) :: il_rec 1721 1644 1722 1645 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_start 1723 1646 INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_count 1724 CHARACTER(LEN=i p_vnl), DIMENSION(:), ALLOCATABLE :: cl_name1647 CHARACTER(LEN=im_vnl), DIMENSION(:), ALLOCATABLE :: cl_name 1725 1648 REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value 1726 1727 INTEGER(i4), DIMENSION(:,:,:,:), ALLOCATABLE :: il_tmp1728 1649 1729 1650 ! loop indices 1730 1651 INTEGER(i4) :: ji 1652 INTEGER(i4) :: jk 1731 1653 !---------------------------------------------------------------- 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 1654 1797 1655 ! reform name and record 1798 1656 ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) ) 1657 1799 1658 DO ji=1,td_file%i_nvar 1659 1660 ! change FillValue to 0. 1661 CALL var_chg_FillValue(td_file%t_var(ji),0._dp) 1662 1800 1663 cl_name(ji) = TRIM(td_file%t_var(ji)%c_name) 1801 1664 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) 1665 1666 SELECT CASE (TRIM(td_file%t_var(ji)%c_name)) 1667 CASE('no0d','no1d','no2d','no3d') 1668 CASE DEFAULT 1669 DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len 1670 SELECT CASE (td_file%t_var(ji)%i_ndim) 1671 CASE(0) 1672 ! special case for 0d, value save in rec 1673 dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1) 1674 il_rec = td_file%t_var(ji)%i_rec 1675 CASE(1,2) 1676 il_rec = td_file%t_var(ji)%i_rec 1677 CASE(3) 1678 il_rec = td_file%t_var(ji)%i_rec + jk -1 1679 END SELECT 1680 WRITE( td_file%i_id, IOSTAT=il_status, REC=il_rec ) & 1681 & td_file%t_var(ji)%d_value(:,:,jk,1) 1682 CALL fct_err(il_status) 1683 IF( il_status /= 0 )THEN 1684 CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//& 1685 & "write variable "//TRIM(td_file%t_var(ji)%c_name)//& 1686 & " in record "//TRIM(fct_str(il_rec))) 1687 ENDIF 1688 ENDDO 1689 END SELECT 1690 1807 1691 ENDDO 1808 1692 … … 1820 1704 il_start(4) = 1 + il_count(3) 1821 1705 il_count(4) = il_start(4) - 1 + td_file%i_n3d 1822 1823 1706 1824 1707 WRITE(td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )& … … 1827 1710 & cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),& 1828 1711 & cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4)) 1829 1712 CALL fct_err(il_status) 1713 IF( il_status /= 0 )THEN 1714 CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//& 1715 & "write restart header in record "//TRIM(fct_str(td_file%i_rhd))) 1716 ENDIF 1717 1718 ! clean 1719 DEALLOCATE( cl_name, dl_value ) 1830 1720 DEALLOCATE( il_start, il_count ) 1831 1721 1832 1722 END SUBROUTINE iom_rstdimg__write_var 1833 !> @endcode1834 1723 END MODULE iom_rstdimg
Note: See TracChangeset
for help on using the changeset viewer.