Ignore:
Timestamp:
Dec 4, 2009 5:05:40 PM (12 years ago)
Author:
letzel
Message:
  • reintegrate branch letzel/masked_output into trunk; new funtionality: masked data output (not yet documented)
Location:
palm/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk

    • Property svn:mergeinfo set to False
      /palm/branches/letzel/masked_output296-409
  • palm/trunk/SOURCE/netcdf.f90

    r392 r410  
    88! ------------------
    99!
     10!
     11! Branch revisions:
     12! -----------------
     13! masked data output
    1014!
    1115! Former revisions:
     
    9498    CHARACTER (LEN=2000)           ::  var_list, var_list_old
    9599
    96     INTEGER ::  av, i, id_x, id_y, id_z, j, ns, ns_old, nz_old
     100    INTEGER ::  av, file_id, i, id_x, id_y, id_z, j, ns, ns_old, nz_old
    97101
    98102    INTEGER, DIMENSION(1) ::  id_dim_time_old, id_dim_x_yz_old,  &
    99103                              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
    101106
    102107    LOGICAL ::  found
     
    108113    REAL, DIMENSION(1) ::  last_time_coordinate
    109114
    110     REAL, DIMENSION(:), ALLOCATABLE ::  netcdf_data
     115    REAL, DIMENSION(:), ALLOCATABLE   ::  netcdf_data
     116    REAL, DIMENSION(:,:), ALLOCATABLE ::  netcdf_data_2d
     117
    111118
    112119
     
    161168             CASE ( 'prt' )
    162169                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
    163252             CASE ( 'all' )
    164253                nc_precision    = j
     
    173262
    174263          i = i + 1
    175           IF ( i > 10 )  EXIT
     264          IF ( i > 50 )  EXIT
    176265       ENDDO
    177266
     
    191280
    192281!
    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,
    194283!-- pr and ts.
    195284    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
    196841
    197842       CASE ( '3d_new' )
Note: See TracChangeset for help on using the changeset viewer.