#if defined( __ibmy_special ) @PROCESS NOOPTimize #endif SUBROUTINE define_netcdf_header( callmode, extend, av ) !------------------------------------------------------------------------------! ! Current revisions: ! ------------------ ! ! ! Former revisions: ! ----------------- ! $Id: netcdf.f90 98 2007-06-21 09:36:33Z raasch $ ! ! 97 2007-06-21 08:23:15Z raasch ! Grids defined for rho and sa ! ! 48 2007-03-06 12:28:36Z raasch ! Output topography height information (zu_s_inner, zw_s_inner) to 2d-xy and 3d ! datasets ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.12 2006/09/26 19:35:16 raasch ! Bugfix yv coordinates for yz cross sections ! ! Revision 1.1 2005/05/18 15:37:16 raasch ! Initial revision ! ! ! Description: ! ------------ ! In case of extend = .FALSE.: ! Define all necessary dimensions, axes and variables for the different ! NetCDF datasets. This subroutine is called from check_open after a new ! dataset is created. It leaves the open NetCDF files ready to write. ! ! In case of extend = .TRUE.: ! Find out if dimensions and variables of an existing file match the values ! of the actual run. If so, get all necessary informations (ids, etc.) from ! this file. ! ! Parameter av can assume values 0 (non-averaged data) and 1 (time averaged ! data) !------------------------------------------------------------------------------! #if defined( __netcdf ) USE arrays_3d USE constants USE control_parameters USE grid_variables USE indices USE netcdf_control USE pegrid USE particle_attributes USE profil_parameter USE spectrum USE statistics IMPLICIT NONE CHARACTER (LEN=2) :: suffix CHARACTER (LEN=2), INTENT (IN) :: callmode CHARACTER (LEN=3) :: suffix1 CHARACTER (LEN=4) :: grid_x, grid_y, grid_z CHARACTER (LEN=6) :: mode CHARACTER (LEN=10) :: netcdf_var_name, netcdf_var_name_base, & precision, var CHARACTER (LEN=80) :: time_average_text CHARACTER (LEN=2000) :: var_list, var_list_old INTEGER :: av, i, id_x, id_y, id_z, j, ns, ns_old, nz_old INTEGER, DIMENSION(1) :: id_dim_time_old, id_dim_x_yz_old, & id_dim_y_xz_old, id_dim_zu_sp_old, & id_dim_zu_xy_old, id_dim_zu_3d_old LOGICAL :: found LOGICAL, INTENT (INOUT) :: extend LOGICAL, SAVE :: init_netcdf = .FALSE. REAL, DIMENSION(1) :: last_time_coordinate REAL, DIMENSION(:), ALLOCATABLE :: netcdf_data ! !-- Initializing actions (return to calling routine check_parameters afterwards) IF ( .NOT. init_netcdf ) THEN ! !-- Check and set accuracy for NetCDF output. First set default value nc_precision = NF90_REAL4 i = 1 DO WHILE ( netcdf_precision(i) /= ' ' ) j = INDEX( netcdf_precision(i), '_' ) IF ( j == 0 ) THEN IF ( myid == 0 ) THEN PRINT*, '+++ define_netcdf_header: netcdf_precision must ', & 'contain a "_" netcdf_precision(', i, ')="', & TRIM( netcdf_precision(i) ),'"' ENDIF CALL local_stop ENDIF var = netcdf_precision(i)(1:j-1) precision = netcdf_precision(i)(j+1:) IF ( precision == 'NF90_REAL4' ) THEN j = NF90_REAL4 ELSEIF ( precision == 'NF90_REAL8' ) THEN j = NF90_REAL8 ELSE IF ( myid == 0 ) THEN PRINT*, '+++ define_netcdf_header: illegal netcdf precision: ',& 'netcdf_precision(', i, ')="', & TRIM( netcdf_precision(i) ),'"' ENDIF CALL local_stop ENDIF SELECT CASE ( var ) CASE ( 'xy' ) nc_precision(1) = j CASE ( 'xz' ) nc_precision(2) = j CASE ( 'yz' ) nc_precision(3) = j CASE ( '2d' ) nc_precision(1:3) = j CASE ( '3d' ) nc_precision(4) = j CASE ( 'pr' ) nc_precision(5) = j CASE ( 'ts' ) nc_precision(6) = j CASE ( 'sp' ) nc_precision(7) = j CASE ( 'prt' ) nc_precision(8) = j CASE ( 'all' ) nc_precision = j CASE DEFAULT IF ( myid == 0 ) THEN PRINT*, '+++ define_netcdf_header: unknown variable in ', & 'inipar assignment: netcdf_precision(', i, ')="',& TRIM( netcdf_precision(i) ),'"' ENDIF CALL local_stop END SELECT i = i + 1 IF ( i > 10 ) EXIT ENDDO init_netcdf = .TRUE. RETURN ENDIF ! !-- Determine the mode to be processed IF ( extend ) THEN mode = callmode // '_ext' ELSE mode = callmode // '_new' ENDIF ! !-- Select the mode to be processed. Possibilities are xy, xz, yz, pr and ts. SELECT CASE ( mode ) CASE ( '3d_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'Conventions', & 'COARDS' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 62 ) IF ( av == 0 ) THEN time_average_text = ' ' ELSE WRITE (time_average_text, '('', '',F7.1,'' s average'')') & averaging_interval ENDIF nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 63 ) IF ( av == 1 ) THEN WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 63 ) ENDIF ! !-- Define time coordinate for volume data (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'time', NF90_UNLIMITED, & id_dim_time_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 64 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'time', NF90_DOUBLE, & id_dim_time_3d(av), id_var_time_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 65 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_time_3d(av), 'units', & 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 66 ) ! !-- Define spatial dimensions and coordinates: !-- Define vertical coordinate grid (zu grid) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1, & id_dim_zu_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 67 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zu_3d', NF90_DOUBLE, & id_dim_zu_3d(av), id_var_zu_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 68 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zu_3d(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 69 ) ! !-- Define vertical coordinate grid (zw grid) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1, & id_dim_zw_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 70 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zw_3d', NF90_DOUBLE, & id_dim_zw_3d(av), id_var_zw_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 71 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zw_3d(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 72 ) ! !-- Define x-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'x', nx+2, id_dim_x_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 73 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'x', NF90_DOUBLE, & id_dim_x_3d(av), id_var_x_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 74 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_x_3d(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 75 ) ! !-- Define x-axis (for u position) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'xu', nx+2, id_dim_xu_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 358 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'xu', NF90_DOUBLE, & id_dim_xu_3d(av), id_var_xu_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 359 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_xu_3d(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 360 ) ! !-- Define y-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'y', ny+2, id_dim_y_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 76 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'y', NF90_DOUBLE, & id_dim_y_3d(av), id_var_y_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 77 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_y_3d(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 78 ) ! !-- Define y-axis (for v position) nc_stat = NF90_DEF_DIM( id_set_3d(av), 'yv', ny+2, id_dim_yv_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 361 ) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'yv', NF90_DOUBLE, & id_dim_yv_3d(av), id_var_yv_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 362 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_yv_3d(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 363 ) ! !-- In case of non-flat topography define 2d-arrays containing the height !-- informations IF ( TRIM( topography ) /= 'flat' ) THEN ! !-- Define zusi = zu(nzb_s_inner) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zusi', NF90_DOUBLE, & (/ id_dim_x_3d(av), id_dim_y_3d(av) /), & id_var_zusi_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 413 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zusi_3d(av), & 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 414 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zusi_3d(av), & 'long_name', 'zu(nzb_s_inner)' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 415 ) ! !-- Define zwwi = zw(nzb_w_inner) nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zwwi', NF90_DOUBLE, & (/ id_dim_x_3d(av), id_dim_y_3d(av) /), & id_var_zwwi_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 416 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zwwi_3d(av), & 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 417 ) nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zwwi_3d(av), & 'long_name', 'zw(nzb_w_inner)' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 418 ) ENDIF ! !-- Define the variables var_list = ';' i = 1 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) ! !-- Check for the grid found = .TRUE. SELECT CASE ( do3d(av,i) ) ! !-- Most variables are defined on the scalar grid CASE ( 'e', 'p', 'pc', 'pr', 'pt', 'q', 'ql', 'ql_c', 'ql_v', & 'ql_vp', 'qv', 'rho', 's', 'sa', 'vpt' ) grid_x = 'x' grid_y = 'y' grid_z = 'zu' ! !-- u grid CASE ( 'u' ) grid_x = 'xu' grid_y = 'y' grid_z = 'zu' ! !-- v grid CASE ( 'v' ) grid_x = 'x' grid_y = 'yv' grid_z = 'zu' ! !-- w grid CASE ( 'w' ) grid_x = 'x' grid_y = 'y' grid_z = 'zw' CASE DEFAULT ! !-- Check for user-defined quantities CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, & grid_y, grid_z ) END SELECT ! !-- Select the respective dimension ids IF ( grid_x == 'x' ) THEN id_x = id_dim_x_3d(av) ELSEIF ( grid_x == 'xu' ) THEN id_x = id_dim_xu_3d(av) ENDIF IF ( grid_y == 'y' ) THEN id_y = id_dim_y_3d(av) ELSEIF ( grid_y == 'yv' ) THEN id_y = id_dim_yv_3d(av) ENDIF IF ( grid_z == 'zu' ) THEN id_z = id_dim_zu_3d(av) ELSEIF ( grid_z == 'zw' ) THEN id_z = id_dim_zw_3d(av) ENDIF ! !-- Define the grid nc_stat = NF90_DEF_VAR( id_set_3d(av), do3d(av,i), & nc_precision(4), & (/ id_x, id_y, id_z, id_dim_time_3d(av) /), & id_var_do3d(av,i) ) IF ( .NOT. found ) THEN PRINT*, '+++ define_netcdf_header: no grid defined for', & ' variable ', do3d(av,i) ENDIF var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';' IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 79 ) ! !-- Store the 'real' name of the variable (with *, for example) !-- in the long_name attribute. This is evaluated by Ferret, !-- for example. nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_do3d(av,i), & 'long_name', do3d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 80 ) ! !-- Define the variable's unit nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_do3d(av,i), & 'units', TRIM( do3d_unit(av,i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 357 ) i = i + 1 ENDDO ! !-- No arrays to output IF ( i == 1 ) RETURN ! !-- Write the list of variables as global attribute (this is used by !-- restart runs and by combine_plot_fields) nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', & var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 81 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 82 ) ! !-- Write data for x and xu axis (shifted by -dx/2) ALLOCATE( netcdf_data(0:nx+1) ) DO i = 0, nx+1 netcdf_data(i) = i * dx ENDDO nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av), netcdf_data, & start = (/ 1 /), count = (/ nx+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 83 ) DO i = 0, nx+1 netcdf_data(i) = ( i - 0.5 ) * dx ENDDO nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), & netcdf_data, start = (/ 1 /), & count = (/ nx+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 385 ) DEALLOCATE( netcdf_data ) ! !-- Write data for y and yv axis (shifted by -dy/2) ALLOCATE( netcdf_data(0:ny+1) ) DO i = 0, ny+1 netcdf_data(i) = i * dy ENDDO nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av), netcdf_data, & start = (/ 1 /), count = (/ ny+2 /)) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 84 ) DO i = 0, ny+1 netcdf_data(i) = ( i - 0.5 ) * dy ENDDO nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), & netcdf_data, start = (/ 1 /), & count = (/ ny+2 /)) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 387 ) DEALLOCATE( netcdf_data ) ! !-- Write zu and zw data (vertical axes) nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av), & zu(nzb:nz_do3d), start = (/ 1 /), & count = (/ nz_do3d-nzb+1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 85 ) nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av), & zw(nzb:nz_do3d), start = (/ 1 /), & count = (/ nz_do3d-nzb+1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 86 ) ! !-- In case of non-flat topography write height information IF ( TRIM( topography ) /= 'flat' ) THEN nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), & zu_s_inner(0:nx+1,0:ny+1), & start = (/ 1, 1 /), & count = (/ nx+2, ny+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 419 ) nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), & zw_w_inner(0:nx+1,0:ny+1), & start = (/ 1, 1 /), & count = (/ nx+2, ny+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 420 ) ENDIF CASE ( '3d_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 87 ) var_list = ';' i = 1 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) var_list = TRIM(var_list) // TRIM( do3d(av,i) ) // ';' i = i + 1 ENDDO IF ( av == 0 ) THEN var = '(3d)' ELSE var = '(3d_av)' ENDIF IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for volume data ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get and compare the number of vertical gridpoints nc_stat = NF90_INQ_VARID( id_set_3d(av), 'zu_3d', id_var_zu_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 88 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), & dimids = id_dim_zu_3d_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 89 ) id_dim_zu_3d(av) = id_dim_zu_3d_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), & len = nz_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 90 ) IF ( nz_do3d-nzb+1 /= nz_old ) THEN PRINT*, '+++ WARNING: NetCDF file for volume data ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' mismatch in number of' PRINT*, ' vertical grid points (nz_do3d).' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is pl3d..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 91 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 92 ) id_dim_time_3d(av) = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), & len = do3d_time_count(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 93 ) nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), & last_time_coordinate, & start = (/ do3d_time_count(av) /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 94 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for volume data ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' do3d_time_count(av) = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. i = 1 DO WHILE ( do3d(av,i)(1:1) /= ' ' ) nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), & id_var_do3d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 95 ) i = i + 1 ENDDO ! !-- Change the titel attribute on file nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 96 ) PRINT*, '*** NetCDF file for volume data ' // TRIM( var ) // & ' from previous run found.' PRINT*, ' This file will be extended.' CASE ( 'xy_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'Conventions', & 'COARDS' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 97 ) IF ( av == 0 ) THEN time_average_text = ' ' ELSE WRITE (time_average_text, '('', '',F7.1,'' s average'')') & averaging_interval ENDIF nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 98 ) IF ( av == 1 ) THEN WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 98 ) ENDIF ! !-- Define time coordinate for xy sections (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'time', NF90_UNLIMITED, & id_dim_time_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 99 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'time', NF90_DOUBLE, & id_dim_time_xy(av), id_var_time_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 100 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_time_xy(av), 'units', & 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 101 ) ! !-- Define the spatial dimensions and coordinates for xy-sections. !-- First, determine the number of horizontal sections to be written. IF ( section(1,1) == -9999 ) THEN RETURN ELSE ns = 1 DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ENDIF ! !-- Define vertical coordinate grid (zu grid) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zu_xy', ns, id_dim_zu_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 102 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zu_xy', NF90_DOUBLE, & id_dim_zu_xy(av), id_var_zu_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 103 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zu_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 104 ) ! !-- Define vertical coordinate grid (zw grid) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zw_xy', ns, id_dim_zw_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 105 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zw_xy', NF90_DOUBLE, & id_dim_zw_xy(av), id_var_zw_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 106 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zw_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 107 ) ! !-- Define a pseudo vertical coordinate grid for the surface variables !-- u* and t* to store their height level nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zu1_xy', 1, & id_dim_zu1_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 108 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zu1_xy', NF90_DOUBLE, & id_dim_zu1_xy(av), id_var_zu1_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 109 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zu1_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 110 ) ! !-- Define a variable to store the layer indices of the horizontal cross !-- sections, too nc_stat = NF90_DEF_VAR( id_set_xy(av), 'ind_z_xy', NF90_DOUBLE, & id_dim_zu_xy(av), id_var_ind_z_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 111 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_ind_z_xy(av), 'units', & 'gridpoints') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 112 ) ! !-- Define x-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'x', nx+2, id_dim_x_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 113 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'x', NF90_DOUBLE, & id_dim_x_xy(av), id_var_x_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 114 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_x_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 115 ) ! !-- Define x-axis (for u position) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'xu', nx+2, id_dim_xu_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 388 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'xu', NF90_DOUBLE, & id_dim_xu_xy(av), id_var_xu_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 389 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_xu_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 390 ) ! !-- Define y-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'y', ny+2, id_dim_y_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 116 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'y', NF90_DOUBLE, & id_dim_y_xy(av), id_var_y_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 117 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_y_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 118 ) ! !-- Define y-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_xy(av), 'yv', ny+2, id_dim_yv_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 364 ) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'yv', NF90_DOUBLE, & id_dim_yv_xy(av), id_var_yv_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 365 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_yv_xy(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 366 ) ! !-- In case of non-flat topography define 2d-arrays containing the height !-- informations IF ( TRIM( topography ) /= 'flat' ) THEN ! !-- Define zusi = zu(nzb_s_inner) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zusi', NF90_DOUBLE, & (/ id_dim_x_xy(av), id_dim_y_xy(av) /), & id_var_zusi_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 421 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zusi_xy(av), & 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 422 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zusi_xy(av), & 'long_name', 'zu(nzb_s_inner)' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 423 ) ! !-- Define zwwi = zw(nzb_w_inner) nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zwwi', NF90_DOUBLE, & (/ id_dim_x_xy(av), id_dim_y_xy(av) /), & id_var_zwwi_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 424 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zwwi_xy(av), & 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 425 ) nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zwwi_xy(av), & 'long_name', 'zw(nzb_w_inner)' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 426 ) ENDIF ! !-- Define the variables var_list = ';' i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN ! !-- If there is a star in the variable name (u* or t*), it is a !-- surface variable. Define it with id_dim_zu1_xy. IF ( INDEX( do2d(av,i), '*' ) /= 0 ) THEN ! !-- First, remove those characters not allowed by NetCDF netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) nc_stat = NF90_DEF_VAR( id_set_xy(av), netcdf_var_name, & nc_precision(1), & (/ id_dim_x_xy(av), id_dim_y_xy(av),& id_dim_zu1_xy(av), & id_dim_time_xy(av) /), & id_var_do2d(av,i) ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ELSE ! !-- Check for the grid found = .TRUE. SELECT CASE ( do2d(av,i) ) ! !-- Most variables are defined on the zu grid CASE ( 'e_xy', 'p_xy', 'pc_xy', 'pr_xy', 'pt_xy', 'q_xy',& 'ql_xy', 'ql_c_xy', 'ql_v_xy', 'ql_vp_xy', & 'qv_xy', 'rho_xy', 's_xy', 'sa_xy', 'vpt_xy' ) grid_x = 'x' grid_y = 'y' grid_z = 'zu' ! !-- u grid CASE ( 'u_xy' ) grid_x = 'xu' grid_y = 'y' grid_z = 'zu' ! !-- v grid CASE ( 'v_xy' ) grid_x = 'x' grid_y = 'yv' grid_z = 'zu' ! !-- w grid CASE ( 'w_xy' ) grid_x = 'x' grid_y = 'y' grid_z = 'zw' CASE DEFAULT ! !-- Check for user-defined quantities CALL user_define_netcdf_grid( do2d(av,i), found, & grid_x, grid_y, grid_z ) END SELECT ! !-- Select the respective dimension ids IF ( grid_x == 'x' ) THEN id_x = id_dim_x_xy(av) ELSEIF ( grid_x == 'xu' ) THEN id_x = id_dim_xu_xy(av) ENDIF IF ( grid_y == 'y' ) THEN id_y = id_dim_y_xy(av) ELSEIF ( grid_y == 'yv' ) THEN id_y = id_dim_yv_xy(av) ENDIF IF ( grid_z == 'zu' ) THEN id_z = id_dim_zu_xy(av) ELSEIF ( grid_z == 'zw' ) THEN id_z = id_dim_zw_xy(av) ENDIF ! !-- Define the grid nc_stat = NF90_DEF_VAR( id_set_xy(av), do2d(av,i), & nc_precision(1), & (/ id_x, id_y, id_z, id_dim_time_xy(av) /), & id_var_do2d(av,i) ) IF ( .NOT. found ) THEN PRINT*, '+++ define_netcdf_header: no grid defined ', & 'for variable ', do2d(av,i) ENDIF var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';' ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 119 ) ! !-- Store the 'real' name of the variable (with *, for example) !-- in the long_name attribute. This is evaluated by Ferret, !-- for example. nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_do2d(av,i), & 'long_name', do2d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 120 ) ! !-- Define the variable's unit nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_do2d(av,i), & 'units', TRIM( do2d_unit(av,i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 354 ) ENDIF i = i + 1 ENDDO ! !-- No arrays to output. Close the netcdf file and return. IF ( i == 1 ) RETURN ! !-- Write the list of variables as global attribute (this is used by !-- restart runs and by combine_plot_fields) nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', & var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 121 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 122 ) ! !-- Write axis data: z_xy, x, y ALLOCATE( netcdf_data(1:ns) ) ! !-- Write zu data DO i = 1, ns IF( section(i,1) == -1 ) THEN netcdf_data(i) = -1.0 ! section averaged along z ELSE netcdf_data(i) = zu( section(i,1) ) ENDIF ENDDO nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), & netcdf_data, start = (/ 1 /), & count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 123 ) ! !-- Write zw data DO i = 1, ns IF( section(i,1) == -1 ) THEN netcdf_data(i) = -1.0 ! section averaged along z ELSE netcdf_data(i) = zw( section(i,1) ) ENDIF ENDDO nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), & netcdf_data, start = (/ 1 /), & count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 124 ) ! !-- Write gridpoint number data netcdf_data(1:ns) = section(1:ns,1) nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), & netcdf_data, start = (/ 1 /), & count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 125 ) DEALLOCATE( netcdf_data ) ! !-- Write the cross section height u*, t* nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), & (/ zu(nzb+1) /), start = (/ 1 /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 126 ) ! !-- Write data for x and xu axis (shifted by -dx/2) ALLOCATE( netcdf_data(0:nx+1) ) DO i = 0, nx+1 netcdf_data(i) = i * dx ENDDO nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), netcdf_data, & start = (/ 1 /), count = (/ nx+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 127 ) DO i = 0, nx+1 netcdf_data(i) = ( i - 0.5 ) * dx ENDDO nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), & netcdf_data, start = (/ 1 /), & count = (/ nx+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 367 ) DEALLOCATE( netcdf_data ) ! !-- Write data for y and yv axis (shifted by -dy/2) ALLOCATE( netcdf_data(0:ny+1) ) DO i = 0, ny+1 netcdf_data(i) = i * dy ENDDO nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), netcdf_data, & start = (/ 1 /), count = (/ ny+2 /)) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 128 ) DO i = 0, ny+1 netcdf_data(i) = ( i - 0.5 ) * dy ENDDO nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), & netcdf_data, start = (/ 1 /), & count = (/ ny+2 /)) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 368 ) DEALLOCATE( netcdf_data ) ! !-- In case of non-flat topography write height information IF ( TRIM( topography ) /= 'flat' ) THEN nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), & zu_s_inner(0:nx+1,0:ny+1), & start = (/ 1, 1 /), & count = (/ nx+2, ny+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 427 ) nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), & zw_w_inner(0:nx+1,0:ny+1), & start = (/ 1, 1 /), & count = (/ nx+2, ny+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 428 ) ENDIF CASE ( 'xy_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 129 ) var_list = ';' i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ENDIF i = i + 1 ENDDO IF ( av == 0 ) THEN var = '(xy)' ELSE var = '(xy_av)' ENDIF IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Calculate the number of current sections ns = 1 DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ! !-- Get and compare the number of horizontal cross sections nc_stat = NF90_INQ_VARID( id_set_xy(av), 'zu_xy', id_var_zu_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 130 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), & dimids = id_dim_zu_xy_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 131 ) id_dim_zu_xy(av) = id_dim_zu_xy_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), & len = ns_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 132 ) IF ( ns /= ns_old ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' mismatch in number of' PRINT*, ' cross sections.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get and compare the heights of the cross sections ALLOCATE( netcdf_data(1:ns_old) ) nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_zu_xy(av), netcdf_data ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 133 ) DO i = 1, ns IF ( section(i,1) /= -1 ) THEN IF ( zu(section(i,1)) /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended' // & ' due to mismatch in cross' PRINT*, ' section levels.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ELSE IF ( -1.0 /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended' // & ' due to mismatch in cross' PRINT*, ' section levels.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ENDIF ENDDO DEALLOCATE( netcdf_data ) ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is do2d..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 134 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 135 ) id_dim_time_xy(av) = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), & len = do2d_xy_time_count(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 136 ) nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av), & last_time_coordinate, & start = (/ do2d_xy_time_count(av) /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 137 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for cross sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' do2d_xy_time_count(av) = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) nc_stat = NF90_INQ_VARID( id_set_xy(av), netcdf_var_name, & id_var_do2d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 138 ) ENDIF i = i + 1 ENDDO ! !-- Change the titel attribute on file nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 139 ) PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // & ' from previous run found.' PRINT*, ' This file will be extended.' CASE ( 'xz_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'Conventions', & 'COARDS' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 140 ) IF ( av == 0 ) THEN time_average_text = ' ' ELSE WRITE (time_average_text, '('', '',F7.1,'' s average'')') & averaging_interval ENDIF nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 141 ) IF ( av == 1 ) THEN WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 141 ) ENDIF ! !-- Define time coordinate for xz sections (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'time', NF90_UNLIMITED, & id_dim_time_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 142 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'time', NF90_DOUBLE, & id_dim_time_xz(av), id_var_time_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 143 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_time_xz(av), 'units', & 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 144 ) ! !-- Define the spatial dimensions and coordinates for xz-sections. !-- First, determine the number of vertical sections to be written. IF ( section(1,2) == -9999 ) THEN RETURN ELSE ns = 1 DO WHILE ( section(ns,2) /= -9999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ENDIF ! !-- Define y-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 145 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'y_xz', NF90_DOUBLE, & id_dim_y_xz(av), id_var_y_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 146 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_y_xz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 147 ) ! !-- Define y-axis (for v position) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'yv_xz', ns, id_dim_yv_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 369 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'yv_xz', NF90_DOUBLE, & id_dim_yv_xz(av), id_var_yv_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 370 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_yv_xz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 371 ) ! !-- Define a variable to store the layer indices of the vertical cross !-- sections nc_stat = NF90_DEF_VAR( id_set_xz(av), 'ind_y_xz', NF90_DOUBLE, & id_dim_y_xz(av), id_var_ind_y_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 148 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_ind_y_xz(av), 'units', & 'gridpoints') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 149 ) ! !-- Define x-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'x', nx+2, id_dim_x_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 150 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'x', NF90_DOUBLE, & id_dim_x_xz(av), id_var_x_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 151 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_x_xz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 152 ) ! !-- Define x-axis (for u position) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'xu', nx+2, id_dim_xu_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 372 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'xu', NF90_DOUBLE, & id_dim_xu_xz(av), id_var_xu_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 373 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_xu_xz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 374 ) ! !-- Define the two z-axes (zu and zw) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 153 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'zu', NF90_DOUBLE, & id_dim_zu_xz(av), id_var_zu_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 154 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_zu_xz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 155 ) nc_stat = NF90_DEF_DIM( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 156 ) nc_stat = NF90_DEF_VAR( id_set_xz(av), 'zw', NF90_DOUBLE, & id_dim_zw_xz(av), id_var_zw_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 157 ) nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_zw_xz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 158 ) ! !-- Define the variables var_list = ';' i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN ! !-- Check for the grid found = .TRUE. SELECT CASE ( do2d(av,i) ) ! !-- Most variables are defined on the zu grid CASE ( 'e_xz', 'p_xz', 'pc_xz', 'pr_xz', 'pt_xz', 'q_xz', & 'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qv_xz', & 'rho_xz', 's_xz', 'sa_xz', 'vpt_xz' ) grid_x = 'x' grid_y = 'y' grid_z = 'zu' ! !-- u grid CASE ( 'u_xz' ) grid_x = 'xu' grid_y = 'y' grid_z = 'zu' ! !-- v grid CASE ( 'v_xz' ) grid_x = 'x' grid_y = 'yv' grid_z = 'zu' ! !-- w grid CASE ( 'w_xz' ) grid_x = 'x' grid_y = 'y' grid_z = 'zw' CASE DEFAULT ! !-- Check for user-defined quantities CALL user_define_netcdf_grid( do2d(av,i), found, & grid_x, grid_y, grid_z ) END SELECT ! !-- Select the respective dimension ids IF ( grid_x == 'x' ) THEN id_x = id_dim_x_xz(av) ELSEIF ( grid_x == 'xu' ) THEN id_x = id_dim_xu_xz(av) ENDIF IF ( grid_y == 'y' ) THEN id_y = id_dim_y_xz(av) ELSEIF ( grid_y == 'yv' ) THEN id_y = id_dim_yv_xz(av) ENDIF IF ( grid_z == 'zu' ) THEN id_z = id_dim_zu_xz(av) ELSEIF ( grid_z == 'zw' ) THEN id_z = id_dim_zw_xz(av) ENDIF ! !-- Define the grid nc_stat = NF90_DEF_VAR( id_set_xz(av), do2d(av,i), & nc_precision(2), & (/ id_x, id_y, id_z, id_dim_time_xz(av) /), & id_var_do2d(av,i) ) IF ( .NOT. found ) THEN PRINT*, '+++ define_netcdf_header: no grid defined for', & ' variable ', do2d(av,i) ENDIF var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';' IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 159 ) ! !-- Store the 'real' name of the variable (with *, for example) !-- in the long_name attribute. This is evaluated by Ferret, !-- for example. nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_do2d(av,i), & 'long_name', do2d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 160 ) ! !-- Define the variable's unit nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_do2d(av,i), & 'units', TRIM( do2d_unit(av,i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 355 ) ENDIF i = i + 1 ENDDO ! !-- No arrays to output. Close the netcdf file and return. IF ( i == 1 ) RETURN ! !-- Write the list of variables as global attribute (this is used by !-- restart runs and by combine_plot_fields) nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', & var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 161 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 162 ) ! !-- Write axis data: y_xz, x, zu, zw ALLOCATE( netcdf_data(1:ns) ) ! !-- Write y_xz data DO i = 1, ns IF( section(i,2) == -1 ) THEN netcdf_data(i) = -1.0 ! section averaged along y ELSE netcdf_data(i) = section(i,2) * dy ENDIF ENDDO nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data, & start = (/ 1 /), count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 163 ) ! !-- Write yv_xz data DO i = 1, ns IF( section(i,2) == -1 ) THEN netcdf_data(i) = -1.0 ! section averaged along y ELSE netcdf_data(i) = ( section(i,2) - 0.5 ) * dy ENDIF ENDDO nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), & netcdf_data, start = (/ 1 /), & count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 375 ) ! !-- Write gridpoint number data netcdf_data(1:ns) = section(1:ns,2) nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), & netcdf_data, start = (/ 1 /), & count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 164 ) DEALLOCATE( netcdf_data ) ! !-- Write data for x and xu axis (shifted by -dx/2) ALLOCATE( netcdf_data(0:nx+1) ) DO i = 0, nx+1 netcdf_data(i) = i * dx ENDDO nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), netcdf_data, & start = (/ 1 /), count = (/ nx+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 165 ) DO i = 0, nx+1 netcdf_data(i) = ( i - 0.5 ) * dx ENDDO nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), & netcdf_data, start = (/ 1 /), & count = (/ nx+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 376 ) DEALLOCATE( netcdf_data ) ! !-- Write zu and zw data (vertical axes) ALLOCATE( netcdf_data(0:nz+1) ) netcdf_data(0:nz+1) = zu(nzb:nzt+1) nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), & netcdf_data, start = (/ 1 /), & count = (/ nz+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 166 ) netcdf_data(0:nz+1) = zw(nzb:nzt+1) nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), & netcdf_data, start = (/ 1 /), & count = (/ nz+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 167 ) DEALLOCATE( netcdf_data ) CASE ( 'xz_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 168 ) var_list = ';' i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ENDIF i = i + 1 ENDDO IF ( av == 0 ) THEN var = '(xz)' ELSE var = '(xz_av)' ENDIF IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Calculate the number of current sections ns = 1 DO WHILE ( section(ns,2) /= -9999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ! !-- Get and compare the number of vertical cross sections nc_stat = NF90_INQ_VARID( id_set_xz(av), 'y_xz', id_var_y_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 169 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), & dimids = id_dim_y_xz_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 170 ) id_dim_y_xz(av) = id_dim_y_xz_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), & len = ns_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 171 ) IF ( ns /= ns_old ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' mismatch in number of' PRINT*, ' cross sections.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get and compare the heights of the cross sections ALLOCATE( netcdf_data(1:ns_old) ) nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 172 ) DO i = 1, ns IF ( section(i,2) /= -1 ) THEN IF ( ( section(i,2) * dy ) /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended' // & ' due to mismatch in cross' PRINT*, ' section indices.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ELSE IF ( -1.0 /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended' // & ' due to mismatch in cross' PRINT*, ' section indices.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ENDIF ENDDO DEALLOCATE( netcdf_data ) ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is do2d..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 173 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 174 ) id_dim_time_xz(av) = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), & len = do2d_xz_time_count(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 175 ) nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av), & last_time_coordinate, & start = (/ do2d_xz_time_count(av) /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 176 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for cross sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' do2d_xz_time_count(av) = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) nc_stat = NF90_INQ_VARID( id_set_xz(av), netcdf_var_name, & id_var_do2d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 177 ) ENDIF i = i + 1 ENDDO ! !-- Change the titel attribute on file nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 178 ) PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // & ' from previous run found.' PRINT*, ' This file will be extended.' CASE ( 'yz_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'Conventions', & 'COARDS' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 179 ) IF ( av == 0 ) THEN time_average_text = ' ' ELSE WRITE (time_average_text, '('', '',F7.1,'' s average'')') & averaging_interval ENDIF nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 180 ) IF ( av == 1 ) THEN WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 180 ) ENDIF ! !-- Define time coordinate for yz sections (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'time', NF90_UNLIMITED, & id_dim_time_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 181 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'time', NF90_DOUBLE, & id_dim_time_yz(av), id_var_time_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 182 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_time_yz(av), 'units', & 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 183 ) ! !-- Define the spatial dimensions and coordinates for yz-sections. !-- First, determine the number of vertical sections to be written. IF ( section(1,3) == -9999 ) THEN RETURN ELSE ns = 1 DO WHILE ( section(ns,3) /= -9999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ENDIF ! !-- Define x axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 184 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'x_yz', NF90_DOUBLE, & id_dim_x_yz(av), id_var_x_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 185 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_x_yz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 186 ) ! !-- Define x axis (for u position) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'xu_yz', ns, id_dim_xu_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 377 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'xu_yz', NF90_DOUBLE, & id_dim_xu_yz(av), id_var_xu_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 378 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_xu_yz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 379 ) ! !-- Define a variable to store the layer indices of the vertical cross !-- sections nc_stat = NF90_DEF_VAR( id_set_yz(av), 'ind_x_yz', NF90_DOUBLE, & id_dim_x_yz(av), id_var_ind_x_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 187 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_ind_x_yz(av), 'units', & 'gridpoints') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 188 ) ! !-- Define y-axis (for scalar position) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'y', ny+2, id_dim_y_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 189 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'y', NF90_DOUBLE, & id_dim_y_yz(av), id_var_y_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 190 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_y_yz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 191 ) ! !-- Define y-axis (for v position) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'yv', ny+2, id_dim_yv_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 380 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'yv', NF90_DOUBLE, & id_dim_yv_yz(av), id_var_yv_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 381 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_yv_yz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 382 ) ! !-- Define the two z-axes (zu and zw) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 192 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'zu', NF90_DOUBLE, & id_dim_zu_yz(av), id_var_zu_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 193 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_zu_yz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 194 ) nc_stat = NF90_DEF_DIM( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 195 ) nc_stat = NF90_DEF_VAR( id_set_yz(av), 'zw', NF90_DOUBLE, & id_dim_zw_yz(av), id_var_zw_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 196 ) nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_zw_yz(av), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 197 ) ! !-- Define the variables var_list = ';' i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN ! !-- Check for the grid found = .TRUE. SELECT CASE ( do2d(av,i) ) ! !-- Most variables are defined on the zu grid CASE ( 'e_yz', 'p_yz', 'pc_yz', 'pr_yz', 'pt_yz', 'q_yz', & 'ql_yz', 'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qv_yz', & 'rho_yz', 's_yz', 'sa_yz', 'vpt_yz' ) grid_x = 'x' grid_y = 'y' grid_z = 'zu' ! !-- u grid CASE ( 'u_yz' ) grid_x = 'xu' grid_y = 'y' grid_z = 'zu' ! !-- v grid CASE ( 'v_yz' ) grid_x = 'x' grid_y = 'yv' grid_z = 'zu' ! !-- w grid CASE ( 'w_yz' ) grid_x = 'x' grid_y = 'y' grid_z = 'zw' CASE DEFAULT ! !-- Check for user-defined quantities CALL user_define_netcdf_grid( do2d(av,i), found, & grid_x, grid_y, grid_z ) END SELECT ! !-- Select the respective dimension ids IF ( grid_x == 'x' ) THEN id_x = id_dim_x_yz(av) ELSEIF ( grid_x == 'xu' ) THEN id_x = id_dim_xu_yz(av) ENDIF IF ( grid_y == 'y' ) THEN id_y = id_dim_y_yz(av) ELSEIF ( grid_y == 'yv' ) THEN id_y = id_dim_yv_yz(av) ENDIF IF ( grid_z == 'zu' ) THEN id_z = id_dim_zu_yz(av) ELSEIF ( grid_z == 'zw' ) THEN id_z = id_dim_zw_yz(av) ENDIF ! !-- Define the grid nc_stat = NF90_DEF_VAR( id_set_yz(av), do2d(av,i), & nc_precision(3), & (/ id_x, id_y, id_z, id_dim_time_yz(av) /), & id_var_do2d(av,i) ) IF ( .NOT. found ) THEN PRINT*, '+++ define_netcdf_header: no grid defined for', & ' variable ', do2d(av,i) ENDIF var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';' IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 198 ) ! !-- Store the 'real' name of the variable (with *, for example) !-- in the long_name attribute. This is evaluated by Ferret, !-- for example. nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_do2d(av,i), & 'long_name', do2d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 199 ) ! !-- Define the variable's unit nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_do2d(av,i), & 'units', TRIM( do2d_unit(av,i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 356 ) ENDIF i = i + 1 ENDDO ! !-- No arrays to output. Close the netcdf file and return. IF ( i == 1 ) RETURN ! !-- Write the list of variables as global attribute (this is used by !-- restart runs and by combine_plot_fields) nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', & var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 200 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 201 ) ! !-- Write axis data: x_yz, y, zu, zw ALLOCATE( netcdf_data(1:ns) ) ! !-- Write x_yz data DO i = 1, ns IF( section(i,3) == -1 ) THEN netcdf_data(i) = -1.0 ! section averaged along x ELSE netcdf_data(i) = section(i,3) * dx ENDIF ENDDO nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data, & start = (/ 1 /), count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 202 ) ! !-- Write x_yz data (xu grid) DO i = 1, ns IF( section(i,3) == -1 ) THEN netcdf_data(i) = -1.0 ! section averaged along x ELSE netcdf_data(i) = (section(i,3)-0.5) * dx ENDIF ENDDO nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av), netcdf_data, & start = (/ 1 /), count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 383 ) ! !-- Write gridpoint number data netcdf_data(1:ns) = section(1:ns,3) nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av), & netcdf_data, start = (/ 1 /), & count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 203 ) DEALLOCATE( netcdf_data ) ! !-- Write data for y and yv axis (shifted by -dy/2) ALLOCATE( netcdf_data(0:ny+1) ) DO j = 0, ny+1 netcdf_data(j) = j * dy ENDDO nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av), netcdf_data, & start = (/ 1 /), count = (/ ny+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 204 ) DO j = 0, ny+1 netcdf_data(j) = ( j - 0.5 ) * dy ENDDO nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av), & netcdf_data, start = (/ 1 /), & count = (/ ny+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 384 ) DEALLOCATE( netcdf_data ) ! !-- Write zu and zw data (vertical axes) ALLOCATE( netcdf_data(0:nz+1) ) netcdf_data(0:nz+1) = zu(nzb:nzt+1) nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av), & netcdf_data, start = (/ 1 /), & count = (/ nz+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 205 ) netcdf_data(0:nz+1) = zw(nzb:nzt+1) nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av), & netcdf_data, start = (/ 1 /), & count = (/ nz+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 206 ) DEALLOCATE( netcdf_data ) CASE ( 'yz_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 207 ) var_list = ';' i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ENDIF i = i + 1 ENDDO IF ( av == 0 ) THEN var = '(yz)' ELSE var = '(yz_av)' ENDIF IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Calculate the number of current sections ns = 1 DO WHILE ( section(ns,3) /= -9999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ! !-- Get and compare the number of vertical cross sections nc_stat = NF90_INQ_VARID( id_set_yz(av), 'x_yz', id_var_x_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 208 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_x_yz(av), & dimids = id_dim_x_yz_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 209 ) id_dim_x_yz(av) = id_dim_x_yz_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), & len = ns_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 210 ) IF ( ns /= ns_old ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' mismatch in number of' PRINT*, ' cross sections.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get and compare the heights of the cross sections ALLOCATE( netcdf_data(1:ns_old) ) nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 211 ) DO i = 1, ns IF ( section(i,3) /= -1 ) THEN IF ( ( section(i,3) * dx ) /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended' // & ' due to mismatch in cross' PRINT*, ' section indices.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ELSE IF ( -1.0 /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended' // & ' due to mismatch in cross' PRINT*, ' section indices.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ENDIF ENDDO DEALLOCATE( netcdf_data ) ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is pl2d..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_yz(av), 'time', id_var_time_yz(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 212 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av), & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 213 ) id_dim_time_yz(av) = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), & len = do2d_yz_time_count(av) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 214 ) nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av), & last_time_coordinate, & start = (/ do2d_yz_time_count(av) /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 215 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for cross sections ' // & TRIM( var ) // ' from previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' do2d_yz_time_count(av) = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. i = 1 DO WHILE ( do2d(av,i)(1:1) /= ' ' ) IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN netcdf_var_name = do2d(av,i) CALL clean_netcdf_varname( netcdf_var_name ) nc_stat = NF90_INQ_VARID( id_set_yz(av), netcdf_var_name, & id_var_do2d(av,i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 216 ) ENDIF i = i + 1 ENDDO ! !-- Change the titel attribute on file nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 217 ) PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // & ' from previous run found.' PRINT*, ' This file will be extended.' CASE ( 'pr_new' ) ! !-- Define some global attributes of the dataset IF ( averaging_interval_pr /= 0.0 ) THEN WRITE (time_average_text,'('', '',F7.1,'' s average'')') & averaging_interval_pr nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 218 ) WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_pr nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) ELSE nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 219 ) ! !-- Define time coordinate for profiles (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_pr, 'time', NF90_UNLIMITED, & id_dim_time_pr ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 220 ) nc_stat = NF90_DEF_VAR( id_set_pr, 'time', NF90_DOUBLE, & id_dim_time_pr, id_var_time_pr ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 221 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_time_pr, 'units', 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 222 ) ! !-- Define the variables var_list = ';' DO i = 1, dopr_n ! !-- First, remove those characters not allowed by NetCDF netcdf_var_name = data_output_pr(i) CALL clean_netcdf_varname( netcdf_var_name ) IF ( statistic_regions == 0 ) THEN ! !-- Define the z-axes (each variable gets its own z-axis) nc_stat = NF90_DEF_DIM( id_set_pr, 'z'//TRIM(netcdf_var_name), & nzt+2-nzb, id_dim_z_pr(i,0) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 223 ) nc_stat = NF90_DEF_VAR( id_set_pr, 'z'//TRIM(netcdf_var_name), & NF90_DOUBLE, id_dim_z_pr(i,0), & id_var_z_pr(i,0) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 224 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_z_pr(i,0), 'units', & 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 225 ) ! !-- Define the variable nc_stat = NF90_DEF_VAR( id_set_pr, netcdf_var_name, & nc_precision(5), (/ id_dim_z_pr(i,0), & id_dim_time_pr /), id_var_dopr(i,0) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 226 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,0), & 'long_name', TRIM( data_output_pr(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 227 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,0), & 'units', TRIM( dopr_unit(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 228 ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ELSE ! !-- If statistic regions are defined, add suffix _SR+#SR to the !-- names DO j = 0, statistic_regions WRITE ( suffix, '(''_'',I1)' ) j ! !-- Define the z-axes (each variable gets it own z-axis) nc_stat = NF90_DEF_DIM( id_set_pr, & 'z'//TRIM(netcdf_var_name)//suffix, & nzt+2-nzb, id_dim_z_pr(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 229 ) nc_stat = NF90_DEF_VAR( id_set_pr, & 'z'//TRIM(netcdf_var_name)//suffix, & nc_precision(5), id_dim_z_pr(i,j), & id_var_z_pr(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 230 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_z_pr(i,j), & 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 231 ) ! !-- Define the variable nc_stat = NF90_DEF_VAR( id_set_pr, & TRIM( netcdf_var_name ) // suffix, & nc_precision(5), & (/ id_dim_z_pr(i,j), & id_dim_time_pr /), id_var_dopr(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 232 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,j), & 'long_name', & TRIM( data_output_pr(i) ) // ' SR ' & // suffix(2:2) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 233 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,j), & 'units', TRIM( dopr_unit(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 234 ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // & suffix // ';' ENDDO ENDIF ENDDO ! !-- Write the list of variables as global attribute (this is used by !-- restart runs) nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 235 ) ! !-- Define normalization variables (as time series) DO i = 1, dopr_norm_num nc_stat = NF90_DEF_VAR( id_set_pr, 'NORM_' // & TRIM( dopr_norm_names(i) ), & nc_precision(5), (/ id_dim_time_pr /), & id_var_norm_dopr(i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 236 ) nc_stat = NF90_PUT_ATT( id_set_pr, id_var_norm_dopr(i), & 'long_name', & TRIM( dopr_norm_longnames(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 237 ) ENDDO ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_pr ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 238 ) ! !-- Write z-axes data DO i = 1, dopr_n DO j = 0, statistic_regions nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j), & hom(nzb:nzt+1,2,dopr_index(i),0), & start = (/ 1 /), & count = (/ nzt-nzb+2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 239 ) ENDDO ENDDO CASE ( 'pr_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 240 ) var_list = ';' DO i = 1, dopr_n netcdf_var_name = data_output_pr(i) CALL clean_netcdf_varname( netcdf_var_name ) IF ( statistic_regions == 0 ) THEN var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ELSE DO j = 0, statistic_regions WRITE ( suffix, '(''_'',I1)' ) j var_list = TRIM(var_list) // TRIM(netcdf_var_name) // & suffix // ';' ENDDO ENDIF ENDDO IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for vertical profiles from' // & ' previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is dopr..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_pr, 'time', id_var_time_pr ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 241 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 242 ) id_dim_time_pr = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, & len = dopr_time_count ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 243 ) nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr, & last_time_coordinate, & start = (/ dopr_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 244 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for vertical profiles from' // & ' previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' dopr_time_count = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. i = 1 DO i = 1, dopr_n netcdf_var_name_base = data_output_pr(i) CALL clean_netcdf_varname( netcdf_var_name_base ) IF ( statistic_regions == 0 ) THEN nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name_base, & id_var_dopr(i,0) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 245 ) ELSE DO j = 0, statistic_regions WRITE ( suffix, '(''_'',I1)' ) j netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name, & id_var_dopr(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 246 ) ENDDO ENDIF ENDDO ! !-- Get ids of the normalization variables DO i = 1, dopr_norm_num nc_stat = NF90_INQ_VARID( id_set_pr, & 'NORM_' // TRIM( dopr_norm_names(i) ), & id_var_norm_dopr(i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 247 ) ENDDO ! !-- Change the title attribute on file nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 248 ) PRINT*, '*** NetCDF file for vertical profiles from previous run' // & ' found.' PRINT*, ' This file will be extended.' CASE ( 'ts_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 249 ) ! !-- Define time coordinate for time series (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_ts, 'time', NF90_UNLIMITED, & id_dim_time_ts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 250 ) nc_stat = NF90_DEF_VAR( id_set_ts, 'time', NF90_DOUBLE, & id_dim_time_ts, id_var_time_ts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 251 ) nc_stat = NF90_PUT_ATT( id_set_ts, id_var_time_ts, 'units', 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 252 ) ! !-- Define the variables var_list = ';' DO i = 1, dots_num ! !-- First, remove those characters not allowed by NetCDF netcdf_var_name = dots_label(i) CALL clean_netcdf_varname( netcdf_var_name ) IF ( statistic_regions == 0 ) THEN nc_stat = NF90_DEF_VAR( id_set_ts, netcdf_var_name, & nc_precision(6), (/ id_dim_time_ts /), & id_var_dots(i,0) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 253 ) nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,0), & 'long_name', TRIM( dots_label(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 254 ) nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,0), & 'units', TRIM( dots_unit(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 255 ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ELSE ! !-- If statistic regions are defined, add suffix _SR+#SR to the !-- names DO j = 0, statistic_regions WRITE ( suffix, '(''_'',I1)' ) j nc_stat = NF90_DEF_VAR( id_set_ts, & TRIM( netcdf_var_name ) // suffix, & nc_precision(6), & (/ id_dim_time_ts /), & id_var_dots(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 256 ) nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,j), & 'long_name', & TRIM( dots_label(i) ) // ' SR ' // & suffix(2:2) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 257 ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // & suffix // ';' ENDDO ENDIF ENDDO ! !-- Write the list of variables as global attribute (this is used by !-- restart runs) nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 258 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_ts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 259 ) CASE ( 'ts_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 260 ) var_list = ';' i = 1 DO i = 1, dots_num netcdf_var_name = dots_label(i) CALL clean_netcdf_varname( netcdf_var_name ) IF ( statistic_regions == 0 ) THEN var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';' ELSE DO j = 0, statistic_regions WRITE ( suffix, '(''_'',I1)' ) j var_list = TRIM(var_list) // TRIM(netcdf_var_name) // & suffix // ';' ENDDO ENDIF ENDDO IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for time series from' //& ' previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is dots..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_ts, 'time', id_var_time_ts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 261 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts, & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 262 ) id_dim_time_ts = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts, & len = dots_time_count ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 263 ) nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts, & last_time_coordinate, & start = (/ dots_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 264 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for time series from' // & ' previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' dots_time_count = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids i = 1 DO i = 1, dots_num netcdf_var_name_base = dots_label(i) CALL clean_netcdf_varname( netcdf_var_name_base ) IF ( statistic_regions == 0 ) THEN nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name_base, & id_var_dots(i,0) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 265 ) ELSE DO j = 0, statistic_regions WRITE ( suffix, '(''_'',I1)' ) j netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, & id_var_dots(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 266 ) ENDDO ENDIF ENDDO ! !-- Change the title attribute on file nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 267 ) PRINT*, '*** NetCDF file for time series from previous run found.' PRINT*, ' This file will be extended.' CASE ( 'sp_new' ) ! !-- Define some global attributes of the dataset IF ( averaging_interval_sp /= 0.0 ) THEN WRITE (time_average_text,'('', '',F7.1,'' s average'')') & averaging_interval_sp nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 268 ) WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_sp nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) ELSE nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 269 ) ! !-- Define time coordinate for spectra (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_sp, 'time', NF90_UNLIMITED, & id_dim_time_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 270 ) nc_stat = NF90_DEF_VAR( id_set_sp, 'time', NF90_DOUBLE, & id_dim_time_sp, id_var_time_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 271 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_time_sp, 'units', 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 272 ) ! !-- Define the spatial dimensions and coordinates for spectra. !-- First, determine the number of vertical levels for which spectra !-- are to be output. ns = 1 DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ! !-- Define vertical coordinate grid (zu grid) nc_stat = NF90_DEF_DIM( id_set_sp, 'zu_sp', ns, id_dim_zu_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 273 ) nc_stat = NF90_DEF_VAR( id_set_sp, 'zu_sp', NF90_DOUBLE, & id_dim_zu_sp, id_var_zu_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 274 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_zu_sp, 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 275 ) ! !-- Define vertical coordinate grid (zw grid) nc_stat = NF90_DEF_DIM( id_set_sp, 'zw_sp', ns, id_dim_zw_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 276 ) nc_stat = NF90_DEF_VAR( id_set_sp, 'zw_sp', NF90_DOUBLE, & id_dim_zw_sp, id_var_zw_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 277 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_zw_sp, 'units', 'meters' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 278 ) ! !-- Define x-axis nc_stat = NF90_DEF_DIM( id_set_sp, 'k_x', nx/2, id_dim_x_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 279 ) nc_stat = NF90_DEF_VAR( id_set_sp, 'k_x', NF90_DOUBLE, id_dim_x_sp, & id_var_x_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 280 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_x_sp, 'units', 'm-1' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 281 ) ! !-- Define y-axis nc_stat = NF90_DEF_DIM( id_set_sp, 'k_y', ny/2, id_dim_y_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 282 ) nc_stat = NF90_DEF_VAR( id_set_sp, 'k_y', NF90_DOUBLE, id_dim_y_sp, & id_var_y_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 283 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_y_sp, 'units', 'm-1' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 284 ) ! !-- Define the variables var_list = ';' i = 1 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 ) IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN ! !-- Define the variable netcdf_var_name = TRIM( data_output_sp(i) ) // '_x' IF ( data_output_sp(i) == 'w' ) THEN nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, & nc_precision(7), (/ id_dim_x_sp, & id_dim_zw_sp, id_dim_time_sp /), & id_var_dospx(i) ) ELSE nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, & nc_precision(7), (/ id_dim_x_sp, & id_dim_zu_sp, id_dim_time_sp /), & id_var_dospx(i) ) ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 285 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospx(i), & 'long_name', netcdf_var_name ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 286 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospx(i), & 'units', 'unknown' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 287 ) var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';' ENDIF IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN ! !-- Define the variable netcdf_var_name = TRIM( data_output_sp(i) ) // '_y' IF ( data_output_sp(i) == 'w' ) THEN nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, & nc_precision(7), (/ id_dim_y_sp, & id_dim_zw_sp, id_dim_time_sp /), & id_var_dospy(i) ) ELSE nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, & nc_precision(7), (/ id_dim_y_sp, & id_dim_zu_sp, id_dim_time_sp /), & id_var_dospy(i) ) ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 288 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospy(i), & 'long_name', netcdf_var_name ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 289 ) nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospy(i), & 'units', 'unknown' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 290 ) var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';' ENDIF i = i + 1 ENDDO ! !-- Write the list of variables as global attribute (this is used by !-- restart runs) nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 291 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 292 ) ! !-- Write axis data: zu_sp, zw_sp, k_x, k_y ALLOCATE( netcdf_data(1:ns) ) ! !-- Write zu data netcdf_data(1:ns) = zu( comp_spectra_level(1:ns) ) nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data, & start = (/ 1 /), count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 293 ) ! !-- Write zw data netcdf_data(1:ns) = zw( comp_spectra_level(1:ns) ) nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data, & start = (/ 1 /), count = (/ ns /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 294 ) DEALLOCATE( netcdf_data ) ! !-- Write data for x and y axis (wavenumbers) ALLOCATE( netcdf_data(nx/2) ) DO i = 1, nx/2 netcdf_data(i) = 2.0 * pi * i / ( dx * ( nx + 1 ) ) ENDDO nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data, & start = (/ 1 /), count = (/ nx/2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 295 ) DEALLOCATE( netcdf_data ) ALLOCATE( netcdf_data(ny/2) ) DO i = 1, ny/2 netcdf_data(i) = 2.0 * pi * i / ( dy * ( ny + 1 ) ) ENDDO nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data, & start = (/ 1 /), count = (/ ny/2 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 296 ) DEALLOCATE( netcdf_data ) CASE ( 'sp_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 297 ) var_list = ';' i = 1 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 ) IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN netcdf_var_name = TRIM( data_output_sp(i) ) // '_x' var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';' ENDIF IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN netcdf_var_name = TRIM( data_output_sp(i) ) // '_y' var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';' ENDIF i = i + 1 ENDDO IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' //& 'run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Determine the number of current vertical levels for which spectra !-- shall be output ns = 1 DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 ) ns = ns + 1 ENDDO ns = ns - 1 ! !-- Get and compare the number of vertical levels nc_stat = NF90_INQ_VARID( id_set_sp, 'zu_sp', id_var_zu_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 298 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, & dimids = id_dim_zu_sp_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 299 ) id_dim_zu_sp = id_dim_zu_sp_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, & len = ns_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 300 ) IF ( ns /= ns_old ) THEN PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' //& 'run found,' PRINT*, ' but this file cannot be extended due to' // & ' mismatch in number of' PRINT*, ' vertical levels.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get and compare the heights of the cross sections ALLOCATE( netcdf_data(1:ns_old) ) nc_stat = NF90_GET_VAR( id_set_sp, id_var_zu_sp, netcdf_data ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 301 ) DO i = 1, ns IF ( zu(comp_spectra_level(i)) /= netcdf_data(i) ) THEN PRINT*, '+++ WARNING: NetCDF file for spectra from previou' // & 's run found,' PRINT*, ' but this file cannot be extended due' // & ' to mismatch in heights' PRINT*, ' of vertical levels.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ENDDO DEALLOCATE( netcdf_data ) ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is plsp..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_sp, 'time', id_var_time_sp ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 302 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 303 ) id_dim_time_sp = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, & len = dosp_time_count ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 304 ) nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp, & last_time_coordinate, & start = (/ dosp_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 305 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' // & 'run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' dosp_time_count = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. i = 1 DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 ) IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN netcdf_var_name = TRIM( data_output_sp(i) ) // '_x' nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, & id_var_dospx(i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 306 ) ENDIF IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN netcdf_var_name = TRIM( data_output_sp(i) ) // '_y' nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, & id_var_dospy(i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 307 ) ENDIF i = i + 1 ENDDO ! !-- Change the titel attribute on file IF ( averaging_interval_sp /= 0.0 ) THEN WRITE (time_average_text,'('', '',F7.1,'' s average'')') & averaging_interval_sp nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & TRIM( run_description_header ) // & TRIM( time_average_text ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 308 ) WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_sp nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', & TRIM( time_average_text ) ) ELSE nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 309 ) PRINT*, '*** NetCDF file for spectra from previous run found.' PRINT*, ' This file will be extended.' CASE ( 'pt_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 310 ) ! !-- Define time coordinate for particles (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_prt, 'time', NF90_UNLIMITED, & id_dim_time_prt ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 311 ) nc_stat = NF90_DEF_VAR( id_set_prt, 'time', NF90_DOUBLE, & id_dim_time_prt, id_var_time_prt ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 312 ) nc_stat = NF90_PUT_ATT( id_set_prt, id_var_time_prt, 'units', & 'seconds' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 313 ) ! !-- Define particle coordinate (maximum particle number) nc_stat = NF90_DEF_DIM( id_set_prt, 'particle_number', & maximum_number_of_particles, id_dim_prtnum ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 314 ) nc_stat = NF90_DEF_VAR( id_set_prt, 'particle_number', NF90_DOUBLE, & id_dim_prtnum, id_var_prtnum ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 315 ) nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prtnum, 'units', & 'particle number' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 316 ) ! !-- Define variable which contains the real number of particles in use nc_stat = NF90_DEF_VAR( id_set_prt, 'real_num_of_prt', NF90_INT, & id_dim_time_prt, id_var_rnop_prt ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 317 ) nc_stat = NF90_PUT_ATT( id_set_prt, id_var_rnop_prt, 'units', & 'particle number' ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 318 ) ! !-- Define the variables DO i = 1, 17 nc_stat = NF90_DEF_VAR( id_set_prt, prt_var_names(i), & nc_precision(8), & (/ id_dim_prtnum, id_dim_time_prt /), & id_var_prt(i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 319 ) nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prt(i), & 'long_name', TRIM( prt_var_names(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 320 ) nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prt(i), & 'units', TRIM( prt_var_units(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 321 ) ENDDO ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_prt ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 322 ) CASE ( 'pt_ext' ) ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is prt..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_prt, 'time', id_var_time_prt ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 323 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 324 ) id_dim_time_prt = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, & len = prt_time_count ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 325 ) nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt, & last_time_coordinate, & start = (/ prt_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 326 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for particles from previous ' //& 'run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' prt_time_count = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids. nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt', & id_var_rnop_prt ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 327 ) DO i = 1, 17 nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i), & id_var_prt(i) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 328 ) ENDDO IF ( myid == 0 ) THEN PRINT*, '*** NetCDF file for particles from previous run found.' PRINT*, ' This file will be extended.' ENDIF CASE ( 'ps_new' ) ! !-- Define some global attributes of the dataset nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 396 ) ! !-- Define time coordinate for particle time series (unlimited dimension) nc_stat = NF90_DEF_DIM( id_set_pts, 'time', NF90_UNLIMITED, & id_dim_time_pts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 397 ) nc_stat = NF90_DEF_VAR( id_set_pts, 'time', NF90_DOUBLE, & id_dim_time_pts, id_var_time_pts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 398 ) nc_stat = NF90_PUT_ATT( id_set_pts, id_var_time_pts, 'units', & 'seconds') IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 399 ) ! !-- Define the variables. If more than one particle group is defined, !-- define seperate variables for each group var_list = ';' DO i = 1, dopts_num ! !-- First, remove those characters not allowed by NetCDF netcdf_var_name = dopts_label(i) CALL clean_netcdf_varname( netcdf_var_name ) DO j = 0, number_of_particle_groups IF ( j == 0 ) THEN suffix1 = '' ELSE WRITE ( suffix1, '(''_'',I2.2)' ) j ENDIF nc_stat = NF90_DEF_VAR( id_set_pts, & TRIM( netcdf_var_name ) // suffix1, & nc_precision(6), & (/ id_dim_time_pts /), & id_var_dopts(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 400 ) IF ( j == 0 ) THEN nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), & 'long_name', & TRIM( dopts_label(i) ) ) ELSE nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), & 'long_name', & TRIM( dopts_label(i) ) // ' PG ' // & suffix1(2:3) ) ENDIF IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 401 ) nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), & 'units', TRIM( dopts_unit(i) ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 402 ) var_list = TRIM(var_list) // TRIM(netcdf_var_name) // & suffix1 // ';' IF ( number_of_particle_groups == 1 ) EXIT ENDDO ENDDO ! !-- Write the list of variables as global attribute (this is used by !-- restart runs) nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', & var_list ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 403 ) ! !-- Leave NetCDF define mode nc_stat = NF90_ENDDEF( id_set_pts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 404 ) CASE ( 'ps_ext' ) ! !-- Get the list of variables and compare with the actual run. !-- First var_list_old has to be reset, since GET_ATT does not assign !-- trailing blanks. var_list_old = ' ' nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', & var_list_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 405 ) var_list = ';' i = 1 DO i = 1, dopts_num netcdf_var_name = dopts_label(i) CALL clean_netcdf_varname( netcdf_var_name ) DO j = 0, number_of_particle_groups IF ( j == 0 ) THEN suffix1 = '' ELSE WRITE ( suffix1, '(''_'',I2.2)' ) j ENDIF var_list = TRIM(var_list) // TRIM(netcdf_var_name) // & suffix1 // ';' IF ( number_of_particle_groups == 1 ) EXIT ENDDO ENDDO IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN PRINT*, '+++ WARNING: NetCDF file for particle time series ' //& 'from previuos run found,' PRINT*, ' but this file cannot be extended due to' // & ' variable mismatch.' PRINT*, ' New file is created instead.' extend = .FALSE. RETURN ENDIF ! !-- Get the id of the time coordinate (unlimited coordinate) and its !-- last index on the file. The next time level is dots..count+1. !-- The current time must be larger than the last output time !-- on the file. nc_stat = NF90_INQ_VARID( id_set_pts, 'time', id_var_time_pts ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 406 ) nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, & dimids = id_dim_time_old ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 407 ) id_dim_time_pts = id_dim_time_old(1) nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, & len = dopts_time_count ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 408 ) nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts, & last_time_coordinate, & start = (/ dopts_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 409 ) IF ( last_time_coordinate(1) >= simulated_time ) THEN PRINT*, '+++ WARNING: NetCDF file for time series from' // & ' previuos run found,' PRINT*, ' but this file cannot be extended becaus' // & 'e the current output time' PRINT*, ' is less or equal than the last output t' // & 'ime on this file.' PRINT*, ' New file is created instead.' dopts_time_count = 0 extend = .FALSE. RETURN ENDIF ! !-- Dataset seems to be extendable. !-- Now get the variable ids i = 1 DO i = 1, dopts_num netcdf_var_name_base = dopts_label(i) CALL clean_netcdf_varname( netcdf_var_name_base ) DO j = 0, number_of_particle_groups IF ( j == 0 ) THEN suffix1 = '' ELSE WRITE ( suffix1, '(''_'',I2.2)' ) j ENDIF netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix1 nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, & id_var_dopts(i,j) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 410 ) IF ( number_of_particle_groups == 1 ) EXIT ENDDO ENDDO ! !-- Change the title attribute on file nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', & TRIM( run_description_header ) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 411 ) PRINT*, '*** NetCDF file for particle time series from previous ', & 'run found.' PRINT*, ' This file will be extended.' CASE DEFAULT PRINT*, '+++ define_netcdf_header: mode "', mode, '" not supported' END SELECT #endif END SUBROUTINE define_netcdf_header SUBROUTINE handle_netcdf_error( errno ) #if defined( __netcdf ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Prints out a text message corresponding to the current status. !------------------------------------------------------------------------------! USE netcdf USE netcdf_control USE pegrid IMPLICIT NONE INTEGER :: errno IF ( nc_stat /= NF90_NOERR ) THEN PRINT*, '+++ netcdf error ', errno,': ', TRIM( NF90_STRERROR( nc_stat ) ) #if defined( __parallel ) CALL MPI_ABORT( comm2d, 9999, ierr ) #else CALL local_stop #endif ENDIF #endif END SUBROUTINE handle_netcdf_error SUBROUTINE clean_netcdf_varname( string ) #if defined( __netcdf ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Replace those characters in string which are not allowed by NetCDF. !------------------------------------------------------------------------------! USE netcdf_control IMPLICIT NONE CHARACTER (LEN=10), INTENT(INOUT) :: string INTEGER :: i, ic DO i = 1, replace_num DO ic = INDEX( string, replace_char(i) ) IF ( ic /= 0 ) THEN string(ic:ic) = replace_by(i) ELSE EXIT ENDIF ENDDO ENDDO #endif END SUBROUTINE clean_netcdf_varname