Changeset 410 for palm/trunk/SOURCE/netcdf.f90
- Timestamp:
- Dec 4, 2009 5:05:40 PM (14 years ago)
- Location:
- palm/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
SOURCE/netcdf.f90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk
-
Property
svn:mergeinfo
set to
False
/palm/branches/letzel/masked_output 296-409
-
Property
svn:mergeinfo
set to
False
-
palm/trunk/SOURCE/netcdf.f90
r392 r410 8 8 ! ------------------ 9 9 ! 10 ! 11 ! Branch revisions: 12 ! ----------------- 13 ! masked data output 10 14 ! 11 15 ! Former revisions: … … 94 98 CHARACTER (LEN=2000) :: var_list, var_list_old 95 99 96 INTEGER :: av, i, id_x, id_y, id_z, j, ns, ns_old, nz_old100 INTEGER :: av, file_id, i, id_x, id_y, id_z, j, ns, ns_old, nz_old 97 101 98 102 INTEGER, DIMENSION(1) :: id_dim_time_old, id_dim_x_yz_old, & 99 103 id_dim_y_xz_old, id_dim_zu_sp_old, & 100 id_dim_zu_xy_old, id_dim_zu_3d_old 104 id_dim_zu_xy_old, id_dim_zu_3d_old, & 105 id_dim_zu_mask_old 101 106 102 107 LOGICAL :: found … … 108 113 REAL, DIMENSION(1) :: last_time_coordinate 109 114 110 REAL, DIMENSION(:), ALLOCATABLE :: netcdf_data 115 REAL, DIMENSION(:), ALLOCATABLE :: netcdf_data 116 REAL, DIMENSION(:,:), ALLOCATABLE :: netcdf_data_2d 117 111 118 112 119 … … 161 168 CASE ( 'prt' ) 162 169 nc_precision(8) = j 170 CASE ( 'masks' ) 171 nc_precision(11:50) = j 172 CASE ( 'mask01' ) 173 nc_precision(11) = j 174 CASE ( 'mask02' ) 175 nc_precision(12) = j 176 CASE ( 'mask03' ) 177 nc_precision(13) = j 178 CASE ( 'mask04' ) 179 nc_precision(14) = j 180 CASE ( 'mask05' ) 181 nc_precision(15) = j 182 CASE ( 'mask06' ) 183 nc_precision(16) = j 184 CASE ( 'mask07' ) 185 nc_precision(17) = j 186 CASE ( 'mask08' ) 187 nc_precision(18) = j 188 CASE ( 'mask09' ) 189 nc_precision(19) = j 190 CASE ( 'mask10' ) 191 nc_precision(20) = j 192 CASE ( 'mask11' ) 193 nc_precision(21) = j 194 CASE ( 'mask12' ) 195 nc_precision(22) = j 196 CASE ( 'mask13' ) 197 nc_precision(23) = j 198 CASE ( 'mask14' ) 199 nc_precision(24) = j 200 CASE ( 'mask15' ) 201 nc_precision(25) = j 202 CASE ( 'mask16' ) 203 nc_precision(26) = j 204 CASE ( 'mask17' ) 205 nc_precision(27) = j 206 CASE ( 'mask18' ) 207 nc_precision(28) = j 208 CASE ( 'mask19' ) 209 nc_precision(29) = j 210 CASE ( 'mask20' ) 211 nc_precision(30) = j 212 CASE ( 'maskav01' ) 213 nc_precision(31) = j 214 CASE ( 'maskav02' ) 215 nc_precision(32) = j 216 CASE ( 'maskav03' ) 217 nc_precision(33) = j 218 CASE ( 'maskav04' ) 219 nc_precision(34) = j 220 CASE ( 'maskav05' ) 221 nc_precision(35) = j 222 CASE ( 'maskav06' ) 223 nc_precision(36) = j 224 CASE ( 'maskav07' ) 225 nc_precision(37) = j 226 CASE ( 'maskav08' ) 227 nc_precision(38) = j 228 CASE ( 'maskav09' ) 229 nc_precision(39) = j 230 CASE ( 'maskav10' ) 231 nc_precision(40) = j 232 CASE ( 'maskav11' ) 233 nc_precision(41) = j 234 CASE ( 'maskav12' ) 235 nc_precision(42) = j 236 CASE ( 'maskav13' ) 237 nc_precision(43) = j 238 CASE ( 'maskav14' ) 239 nc_precision(44) = j 240 CASE ( 'maskav15' ) 241 nc_precision(45) = j 242 CASE ( 'maskav16' ) 243 nc_precision(46) = j 244 CASE ( 'maskav17' ) 245 nc_precision(47) = j 246 CASE ( 'maskav18' ) 247 nc_precision(48) = j 248 CASE ( 'maskav19' ) 249 nc_precision(49) = j 250 CASE ( 'maskav20' ) 251 nc_precision(50) = j 163 252 CASE ( 'all' ) 164 253 nc_precision = j … … 173 262 174 263 i = i + 1 175 IF ( i > 10 ) EXIT264 IF ( i > 50 ) EXIT 176 265 ENDDO 177 266 … … 191 280 192 281 ! 193 !-- Select the mode to be processed. Possibilities are 3d, xy, xz, yz,282 !-- Select the mode to be processed. Possibilities are 3d, mask, xy, xz, yz, 194 283 !-- pr and ts. 195 284 SELECT CASE ( mode ) 285 286 CASE ( 'ma_new' ) 287 288 ! 289 !-- decompose actual parameter file_id (=formal parameter av) into 290 !-- mid and av 291 file_id = av 292 IF ( file_id <= 140 ) THEN 293 mid = file_id - 120 294 av = 0 295 ELSE 296 mid = file_id - 140 297 av = 1 298 ENDIF 299 300 ! 301 !-- Define some global attributes of the dataset 302 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, & 303 'Conventions', 'COARDS' ) 304 CALL handle_netcdf_error( 'netcdf', 9998 ) 305 306 IF ( av == 0 ) THEN 307 time_average_text = ' ' 308 ELSE 309 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 310 averaging_interval 311 ENDIF 312 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title', & 313 TRIM( run_description_header ) // & 314 TRIM( time_average_text ) ) 315 CALL handle_netcdf_error( 'netcdf', 9998 ) 316 IF ( av == 1 ) THEN 317 WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval 318 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, & 319 'time_avg', TRIM( time_average_text ) ) 320 CALL handle_netcdf_error( 'netcdf', 9998 ) 321 ENDIF 322 323 ! 324 !-- Define time coordinate for volume data (unlimited dimension) 325 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'time', NF90_UNLIMITED, & 326 id_dim_time_mask(mid,av) ) 327 CALL handle_netcdf_error( 'netcdf', 9998 ) 328 329 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'time', NF90_DOUBLE, & 330 id_dim_time_mask(mid,av), & 331 id_var_time_mask(mid,av) ) 332 CALL handle_netcdf_error( 'netcdf', 9998 ) 333 334 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 335 id_var_time_mask(mid,av), 'units', & 336 'seconds') 337 CALL handle_netcdf_error( 'netcdf', 9998 ) 338 339 ! 340 !-- Define spatial dimensions and coordinates: 341 !-- Define vertical coordinate grid (zu grid) 342 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'zu_3d', & 343 mask_size(mid,3), id_dim_zu_mask(mid,av) ) 344 CALL handle_netcdf_error( 'netcdf', 9998 ) 345 346 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'zu_3d', NF90_DOUBLE, & 347 id_dim_zu_mask(mid,av), & 348 id_var_zu_mask(mid,av) ) 349 CALL handle_netcdf_error( 'netcdf', 9998 ) 350 351 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 352 'units', 'meters' ) 353 CALL handle_netcdf_error( 'netcdf', 9998 ) 354 355 ! 356 !-- Define vertical coordinate grid (zw grid) 357 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'zw_3d', & 358 mask_size(mid,3), id_dim_zw_mask(mid,av) ) 359 CALL handle_netcdf_error( 'netcdf', 9998 ) 360 361 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'zw_3d', NF90_DOUBLE, & 362 id_dim_zw_mask(mid,av), & 363 id_var_zw_mask(mid,av) ) 364 CALL handle_netcdf_error( 'netcdf', 9998 ) 365 366 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 367 'units', 'meters' ) 368 CALL handle_netcdf_error( 'netcdf', 9998 ) 369 370 ! 371 !-- Define x-axis (for scalar position) 372 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'x', & 373 mask_size(mid,1), id_dim_x_mask(mid,av) ) 374 CALL handle_netcdf_error( 'netcdf', 9998 ) 375 376 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'x', NF90_DOUBLE, & 377 id_dim_x_mask(mid,av), id_var_x_mask(mid,av) ) 378 CALL handle_netcdf_error( 'netcdf', 9998 ) 379 380 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), id_var_x_mask(mid,av), & 381 'units', 'meters' ) 382 CALL handle_netcdf_error( 'netcdf', 9998 ) 383 384 ! 385 !-- Define x-axis (for u position) 386 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'xu', & 387 mask_size(mid,1), id_dim_xu_mask(mid,av) ) 388 CALL handle_netcdf_error( 'netcdf', 9998 ) 389 390 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'xu', NF90_DOUBLE, & 391 id_dim_xu_mask(mid,av), & 392 id_var_xu_mask(mid,av) ) 393 CALL handle_netcdf_error( 'netcdf', 9998 ) 394 395 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), id_var_xu_mask(mid,av), & 396 'units', 'meters' ) 397 CALL handle_netcdf_error( 'netcdf', 9998 ) 398 399 ! 400 !-- Define y-axis (for scalar position) 401 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'y', & 402 mask_size(mid,2), id_dim_y_mask(mid,av) ) 403 CALL handle_netcdf_error( 'netcdf', 9998 ) 404 405 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'y', NF90_DOUBLE, & 406 id_dim_y_mask(mid,av), id_var_y_mask(mid,av) ) 407 CALL handle_netcdf_error( 'netcdf', 9998 ) 408 409 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), id_var_y_mask(mid,av), & 410 'units', 'meters' ) 411 CALL handle_netcdf_error( 'netcdf', 9998 ) 412 413 ! 414 !-- Define y-axis (for v position) 415 nc_stat = NF90_DEF_DIM( id_set_mask(mid,av), 'yv', & 416 mask_size(mid,2), id_dim_yv_mask(mid,av) ) 417 CALL handle_netcdf_error( 'netcdf', 9998 ) 418 419 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'yv', NF90_DOUBLE, & 420 id_dim_yv_mask(mid,av), & 421 id_var_yv_mask(mid,av) ) 422 CALL handle_netcdf_error( 'netcdf', 9998 ) 423 424 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), id_var_yv_mask(mid,av), & 425 'units', 'meters' ) 426 CALL handle_netcdf_error( 'netcdf', 9998 ) 427 428 ! 429 !-- In case of non-flat topography define 2d-arrays containing the height 430 !-- informations 431 IF ( TRIM( topography ) /= 'flat' ) THEN 432 ! 433 !-- Define zusi = zu(nzb_s_inner) 434 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'zusi', NF90_DOUBLE, & 435 (/ id_dim_x_mask(mid,av), & 436 id_dim_y_mask(mid,av) /), & 437 id_var_zusi_mask(mid,av) ) 438 CALL handle_netcdf_error( 'netcdf', 9998 ) 439 440 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 441 id_var_zusi_mask(mid,av), & 442 'units', 'meters' ) 443 CALL handle_netcdf_error( 'netcdf', 9998 ) 444 445 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 446 id_var_zusi_mask(mid,av), & 447 'long_name', 'zu(nzb_s_inner)' ) 448 CALL handle_netcdf_error( 'netcdf', 9998 ) 449 450 ! 451 !-- Define zwwi = zw(nzb_w_inner) 452 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), 'zwwi', NF90_DOUBLE, & 453 (/ id_dim_x_mask(mid,av), & 454 id_dim_y_mask(mid,av) /), & 455 id_var_zwwi_mask(mid,av) ) 456 CALL handle_netcdf_error( 'netcdf', 9998 ) 457 458 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 459 id_var_zwwi_mask(mid,av), & 460 'units', 'meters' ) 461 CALL handle_netcdf_error( 'netcdf', 9998 ) 462 463 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 464 id_var_zwwi_mask(mid,av), & 465 'long_name', 'zw(nzb_w_inner)' ) 466 CALL handle_netcdf_error( 'netcdf', 9998 ) 467 468 ENDIF 469 470 471 ! 472 !-- Define the variables 473 var_list = ';' 474 i = 1 475 476 DO WHILE ( domask(mid,av,i)(1:1) /= ' ' ) 477 478 ! 479 !-- Check for the grid 480 found = .TRUE. 481 SELECT CASE ( domask(mid,av,i) ) 482 ! 483 !-- Most variables are defined on the scalar grid 484 CASE ( 'e', 'p', 'pc', 'pr', 'pt', 'q', 'ql', 'ql_c', 'ql_v', & 485 'ql_vp', 'qv', 'rho', 's', 'sa', 'vpt' ) 486 487 grid_x = 'x' 488 grid_y = 'y' 489 grid_z = 'zu' 490 ! 491 !-- u grid 492 CASE ( 'u' ) 493 494 grid_x = 'xu' 495 grid_y = 'y' 496 grid_z = 'zu' 497 ! 498 !-- v grid 499 CASE ( 'v' ) 500 501 grid_x = 'x' 502 grid_y = 'yv' 503 grid_z = 'zu' 504 ! 505 !-- w grid 506 CASE ( 'w' ) 507 508 grid_x = 'x' 509 grid_y = 'y' 510 grid_z = 'zw' 511 512 CASE DEFAULT 513 ! 514 !-- Check for user-defined quantities 515 CALL user_define_netcdf_grid( domask(mid,av,i), found, & 516 grid_x, grid_y, grid_z ) 517 518 END SELECT 519 520 ! 521 !-- Select the respective dimension ids 522 IF ( grid_x == 'x' ) THEN 523 id_x = id_dim_x_mask(mid,av) 524 ELSEIF ( grid_x == 'xu' ) THEN 525 id_x = id_dim_xu_mask(mid,av) 526 ENDIF 527 528 IF ( grid_y == 'y' ) THEN 529 id_y = id_dim_y_mask(mid,av) 530 ELSEIF ( grid_y == 'yv' ) THEN 531 id_y = id_dim_yv_mask(mid,av) 532 ENDIF 533 534 IF ( grid_z == 'zu' ) THEN 535 id_z = id_dim_zu_mask(mid,av) 536 ELSEIF ( grid_z == 'zw' ) THEN 537 id_z = id_dim_zw_mask(mid,av) 538 ENDIF 539 540 ! 541 !-- Define the grid 542 nc_stat = NF90_DEF_VAR( id_set_mask(mid,av), domask(mid,av,i), & 543 nc_precision(10+mid+av*20), & 544 (/ id_x, id_y, id_z, & 545 id_dim_time_mask(mid,av) /), & 546 id_var_domask(mid,av,i) ) 547 548 IF ( .NOT. found ) THEN 549 WRITE ( message_string, * ) 'no grid defined for', & 550 ' variable ', TRIM( domask(mid,av,i) ) 551 CALL message( 'define_netcdf_header', 'PA9998', 0, 1, 0, 6, 0 ) 552 ENDIF 553 554 var_list = TRIM( var_list ) // TRIM( domask(mid,av,i) ) // ';' 555 556 CALL handle_netcdf_error( 'netcdf', 9998 ) 557 ! 558 !-- Store the 'real' name of the variable (with *, for example) 559 !-- in the long_name attribute. This is evaluated by Ferret, 560 !-- for example. 561 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 562 id_var_domask(mid,av,i), & 563 'long_name', domask(mid,av,i) ) 564 CALL handle_netcdf_error( 'netcdf', 9998 ) 565 ! 566 !-- Define the variable's unit 567 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), & 568 id_var_domask(mid,av,i), & 569 'units', TRIM( domask_unit(mid,av,i) ) ) 570 CALL handle_netcdf_error( 'netcdf', 9998 ) 571 572 i = i + 1 573 574 ENDDO 575 576 ! 577 !-- No arrays to output 578 IF ( i == 1 ) RETURN 579 580 ! 581 !-- Write the list of variables as global attribute (this is used by 582 !-- restart runs and by combine_plot_fields) 583 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, & 584 'VAR_LIST', var_list ) 585 CALL handle_netcdf_error( 'netcdf', 9998 ) 586 587 ! 588 !-- Leave NetCDF define mode 589 nc_stat = NF90_ENDDEF( id_set_mask(mid,av) ) 590 CALL handle_netcdf_error( 'netcdf', 9998 ) 591 592 ! 593 !-- Write data for x (shifted by +dx/2) and xu axis 594 ALLOCATE( netcdf_data(mask_size(mid,1)) ) 595 596 netcdf_data = ( mask_i_global(mid,:mask_size(mid,1)) + 0.5 ) * dx 597 598 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_x_mask(mid,av), & 599 netcdf_data, start = (/ 1 /), & 600 count = (/ mask_size(mid,1) /) ) 601 CALL handle_netcdf_error( 'netcdf', 9998 ) 602 603 netcdf_data = mask_i_global(mid,:mask_size(mid,1)) * dx 604 605 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_xu_mask(mid,av),& 606 netcdf_data, start = (/ 1 /), & 607 count = (/ mask_size(mid,1) /) ) 608 CALL handle_netcdf_error( 'netcdf', 9998 ) 609 610 DEALLOCATE( netcdf_data ) 611 612 ! 613 !-- Write data for y (shifted by +dy/2) and yv axis 614 ALLOCATE( netcdf_data(mask_size(mid,2)) ) 615 616 netcdf_data = ( mask_j_global(mid,:mask_size(mid,2)) + 0.5 ) * dy 617 618 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_y_mask(mid,av), & 619 netcdf_data, start = (/ 1 /), & 620 count = (/ mask_size(mid,2) /)) 621 CALL handle_netcdf_error( 'netcdf', 9998 ) 622 623 netcdf_data = mask_j_global(mid,:mask_size(mid,2)) * dy 624 625 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_yv_mask(mid,av), & 626 netcdf_data, start = (/ 1 /), & 627 count = (/ mask_size(mid,2) /)) 628 CALL handle_netcdf_error( 'netcdf', 9998 ) 629 630 DEALLOCATE( netcdf_data ) 631 632 ! 633 !-- Write zu and zw data (vertical axes) 634 ALLOCATE( netcdf_data(mask_size(mid,3)) ) 635 636 netcdf_data = zu( mask_k_global(mid,:mask_size(mid,3)) ) 637 638 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zu_mask(mid,av), & 639 netcdf_data, start = (/ 1 /), & 640 count = (/ mask_size(mid,3) /) ) 641 CALL handle_netcdf_error( 'netcdf', 9998 ) 642 643 netcdf_data = zw( mask_k_global(mid,:mask_size(mid,3)) ) 644 645 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_zw_mask(mid,av), & 646 netcdf_data, start = (/ 1 /), & 647 count = (/ mask_size(mid,3) /) ) 648 CALL handle_netcdf_error( 'netcdf', 9998 ) 649 650 DEALLOCATE( netcdf_data ) 651 652 ! 653 !-- In case of non-flat topography write height information 654 IF ( TRIM( topography ) /= 'flat' ) THEN 655 656 ALLOCATE( netcdf_data_2d(mask_size(mid,1),mask_size(mid,2)) ) 657 netcdf_data_2d = zu_s_inner( mask_i_global(mid,:mask_size(mid,1)),& 658 mask_j_global(mid,:mask_size(mid,2)) ) 659 660 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 661 id_var_zusi_mask(mid,av), & 662 netcdf_data_2d, & 663 start = (/ 1, 1 /), & 664 count = (/ mask_size(mid,1), & 665 mask_size(mid,2) /) ) 666 CALL handle_netcdf_error( 'netcdf', 9998 ) 667 668 netcdf_data_2d = zw_w_inner( mask_i_global(mid,:mask_size(mid,1)),& 669 mask_j_global(mid,:mask_size(mid,2)) ) 670 671 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 672 id_var_zwwi_mask(mid,av), & 673 netcdf_data_2d, & 674 start = (/ 1, 1 /), & 675 count = (/ mask_size(mid,1), & 676 mask_size(mid,2) /) ) 677 CALL handle_netcdf_error( 'netcdf', 9998 ) 678 679 DEALLOCATE( netcdf_data_2d ) 680 681 ENDIF 682 ! 683 !-- restore original parameter file_id (=formal parameter av) into av 684 av = file_id 685 686 687 CASE ( 'ma_ext' ) 688 689 ! 690 !-- decompose actual parameter file_id (=formal parameter av) into 691 !-- mid and av 692 file_id = av 693 IF ( file_id <= 140 ) THEN 694 mid = file_id - 120 695 av = 0 696 ELSE 697 mid = file_id - 140 698 av = 1 699 ENDIF 700 701 ! 702 !-- Get the list of variables and compare with the actual run. 703 !-- First var_list_old has to be reset, since GET_ATT does not assign 704 !-- trailing blanks. 705 var_list_old = ' ' 706 nc_stat = NF90_GET_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'VAR_LIST',& 707 var_list_old ) 708 CALL handle_netcdf_error( 'netcdf', 9998 ) 709 710 var_list = ';' 711 i = 1 712 DO WHILE ( domask(mid,av,i)(1:1) /= ' ' ) 713 var_list = TRIM(var_list) // TRIM( domask(mid,av,i) ) // ';' 714 i = i + 1 715 ENDDO 716 717 IF ( av == 0 ) THEN 718 var = '(mask)' 719 ELSE 720 var = '(mask_av)' 721 ENDIF 722 723 IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN 724 WRITE ( message_string, * ) 'NetCDF file for ', TRIM( var ), & 725 ' data for mask', mid, ' from previous run found,', & 726 '&but this file cannot be extended due to variable ', & 727 'mismatch.&New file is created instead.' 728 CALL message( 'define_netcdf_header', 'PA9998', 0, 1, 0, 6, 0 ) 729 extend = .FALSE. 730 RETURN 731 ENDIF 732 733 ! 734 !-- Get and compare the number of vertical gridpoints 735 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'zu', & 736 id_var_zu_mask(mid,av) ) 737 CALL handle_netcdf_error( 'netcdf', 9998 ) 738 739 nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av), & 740 id_var_zu_mask(mid,av), & 741 dimids = id_dim_zu_mask_old ) 742 CALL handle_netcdf_error( 'netcdf', 9998 ) 743 id_dim_zu_mask(mid,av) = id_dim_zu_mask_old(1) 744 745 nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av), & 746 id_dim_zu_mask(mid,av), & 747 len = nz_old ) 748 CALL handle_netcdf_error( 'netcdf', 9998 ) 749 750 IF ( mask_size(mid,3) /= nz_old ) THEN 751 WRITE ( message_string, * ) 'NetCDF file for ', TRIM( var ), & 752 ' data for mask', mid, ' from previous run found,', & 753 '&but this file cannot be extended due to mismatch in ', & 754 ' number of&vertical grid points.', & 755 '&New file is created instead.' 756 CALL message( 'define_netcdf_header', 'PA9998', 0, 1, 0, 6, 0 ) 757 extend = .FALSE. 758 RETURN 759 ENDIF 760 761 ! 762 !-- Get the id of the time coordinate (unlimited coordinate) and its 763 !-- last index on the file. The next time level is plmask..count+1. 764 !-- The current time must be larger than the last output time 765 !-- on the file. 766 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), 'time', & 767 id_var_time_mask(mid,av) ) 768 CALL handle_netcdf_error( 'netcdf', 9998 ) 769 770 nc_stat = NF90_INQUIRE_VARIABLE( id_set_mask(mid,av), & 771 id_var_time_mask(mid,av), & 772 dimids = id_dim_time_old ) 773 CALL handle_netcdf_error( 'netcdf', 9998 ) 774 id_dim_time_mask(mid,av) = id_dim_time_old(1) 775 776 nc_stat = NF90_INQUIRE_DIMENSION( id_set_mask(mid,av), & 777 id_dim_time_mask(mid,av), & 778 len = domask_time_count(mid,av) ) 779 CALL handle_netcdf_error( 'netcdf', 9998 ) 780 781 nc_stat = NF90_GET_VAR( id_set_mask(mid,av), & 782 id_var_time_mask(mid,av), & 783 last_time_coordinate, & 784 start = (/ domask_time_count(mid,av) /), & 785 count = (/ 1 /) ) 786 CALL handle_netcdf_error( 'netcdf', 9998 ) 787 788 IF ( last_time_coordinate(1) >= simulated_time ) THEN 789 WRITE ( message_string, * ) 'NetCDF file for ', TRIM( var ), & 790 ' data for mask', mid, ' from previous run found,', & 791 '&but this file cannot be extended because the current ', & 792 'output time&is less or equal than the last output time ', & 793 'on this file.&New file is created instead.' 794 CALL message( 'define_netcdf_header', 'PA9998', 0, 1, 0, 6, 0 ) 795 domask_time_count(mid,av) = 0 796 extend = .FALSE. 797 RETURN 798 ENDIF 799 800 ! 801 !-- Dataset seems to be extendable. 802 !-- Now get the variable ids. 803 i = 1 804 DO WHILE ( domask(mid,av,i)(1:1) /= ' ' ) 805 nc_stat = NF90_INQ_VARID( id_set_mask(mid,av), & 806 TRIM( domask(mid,av,i) ), & 807 id_var_domask(mid,av,i) ) 808 CALL handle_netcdf_error( 'netcdf', 9998 ) 809 i = i + 1 810 ENDDO 811 812 ! 813 !-- Update the title attribute on file 814 !-- In order to avoid 'data mode' errors if updated attributes are larger 815 !-- than their original size, NF90_PUT_ATT is called in 'define mode' 816 !-- enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a possible 817 !-- performance loss due to data copying; an alternative strategy would be 818 !-- to ensure equal attribute size in a job chain. Maybe revise later. 819 IF ( av == 0 ) THEN 820 time_average_text = ' ' 821 ELSE 822 WRITE (time_average_text, '('', '',F7.1,'' s average'')') & 823 averaging_interval 824 ENDIF 825 nc_stat = NF90_REDEF( id_set_mask(mid,av) ) 826 CALL handle_netcdf_error( 'netcdf', 9998 ) 827 nc_stat = NF90_PUT_ATT( id_set_mask(mid,av), NF90_GLOBAL, 'title', & 828 TRIM( run_description_header ) // & 829 TRIM( time_average_text ) ) 830 CALL handle_netcdf_error( 'netcdf', 9998 ) 831 nc_stat = NF90_ENDDEF( id_set_mask(mid,av) ) 832 CALL handle_netcdf_error( 'netcdf', 9998 ) 833 WRITE ( message_string, * ) 'NetCDF file for ', TRIM( var ), & 834 ' data for mask', mid, ' from previous run found.', & 835 '&This file will be extended.' 836 CALL message( 'define_netcdf_header', 'PA9998', 0, 0, 0, 6, 0 ) 837 ! 838 !-- restore original parameter file_id (=formal parameter av) into av 839 av = file_id 840 196 841 197 842 CASE ( '3d_new' )
Note: See TracChangeset
for help on using the changeset viewer.
