source: palm/trunk/UTIL/inifor/src/inifor_io.f90 @ 4523

Last change on this file since 4523 was 4523, checked in by eckhard, 4 years ago

fixed constant-density pressure extrapolation, respect integer working precision

  • Property svn:keywords set to Id
File size: 56.7 KB
RevLine 
[3447]1!> @file src/inifor_io.f90
[2696]2!------------------------------------------------------------------------------!
[2718]3! This file is part of the PALM model system.
[2696]4!
[2718]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
[2696]8! version.
9!
[2718]10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
[2696]13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
[4481]17! Copyright 2017-2020 Leibniz Universitaet Hannover
18! Copyright 2017-2020 Deutscher Wetterdienst Offenbach
[2696]19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
[3183]23!
24!
25! Former revisions:
26! -----------------
27! $Id: inifor_io.f90 4523 2020-05-07 15:58:16Z eckhard $
[4523]28! respect integer working precision (iwp) specified in inifor_defs.f90
29!
30!
31! 4481 2020-03-31 18:55:54Z maronga
[4074]32! Pass hhl_file directly instead of entire INIFOR configuration
33!
34!
35! 3997 2019-05-23 12:35:57Z eckhard
[3997]36! Added boolean indicator for --elevation option invocation
37! Stop INIFOR if no command-line options given
38!
39!
40! 3866 2019-04-05 14:25:01Z eckhard
[3866]41! Use PALM's working precision
42! Improved coding style
43!
44!
45! 3801 2019-03-15 17:14:25Z eckhard
[3801]46! Added routine get_cosmo_grid() to read in COSMO rotated pole from COSMO domain
47! Moved get_soil_layer_thickness() here from inifor_grid
48!
49! 3785 2019-03-06 10:41:14Z eckhard
[3779]50! Temporariliy disabled height-based geostrophic wind averaging
51! Improved variable naming
52!
53!
54! 3764 2019-02-26 13:42:09Z eckhard
[3764]55! Removed dependency on radiation input files
56!
57!
58! 3716 2019-02-05 17:02:38Z eckhard
[3716]59! Removed dependency on soilmoisture input files
60!
61!
62! 3680 2019-01-18 14:54:12Z knoop
[3678]63! Moved get_input_file_list() here from grid module, added check for presence of
64!    input files
65!
66!
67! 3618 2018-12-10 13:25:22Z eckhard
[3618]68! Prefixed all INIFOR modules with inifor_
69!
70!
71! 3615 2018-12-10 07:21:03Z raasch
[3615]72! bugfix: abort replaced by inifor_abort
73!
74! 3557 2018-11-22 16:01:22Z eckhard
[3557]75! Updated documentation, removed unused subroutine write_netcdf_variable_2d()
76!
77!
78! 3537 2018-11-20 10:53:14Z eckhard
[3537]79! New routine get_netcdf_dim_vector()
80!
81!
82! 3534 2018-11-19 15:35:16Z raasch
[3534]83! bugfix: INTENT attribute changed
84!
85! 3456 2018-10-30 14:29:54Z eckhard
[3456]86! NetCDf output of internal arrays only with --debug option
87!
88!
89! 3447 2018-10-29 15:52:54Z eckhard
[3447]90! Removed INCLUDE statement for get_netcdf_variable()
91! Renamed source files for compatibilty with PALM build system
92!
93!
94! 3395 2018-10-22 17:32:49Z eckhard
[3395]95! Added command-line options for configuring the computation of geostrophic
96!     winds (--averagin-mode, --averaging-angle)
97! Added command-line option --input-prefix for setting input file prefixes all
98!     at once
99! Added --debug option for more verbose terminal output
100! Added option-specific *_is_set LOGICALs to indicate invocation from the
101!     command-line
102! Improved error messages in case of empty file-name strings
103! Improved routine naming
[3262]104!
105! 3183 2018-07-27 14:25:55Z suehring
[3182]106! Introduced new PALM grid stretching
107! Updated variable names and metadata for PIDS v1.9 compatibility
108! Improved handling of the start date string
109! Better compatibility with older Intel compilers:
110! - avoiding implicit array allocation with new get_netcdf_variable()
111!   subroutine instead of function
112! Improved command line interface:
113! - Added configuration validation
114! - New options to configure input file prefixes
115! - GNU-style short and long option names
116! - Added version and copyright output
[2696]117!
[3182]118!
[3183]119! 3182 2018-07-27 13:36:03Z suehring
[2696]120! Initial revision
121!
122!
123!
124! Authors:
125! --------
[3557]126!> @author Eckhard Kadasch (Deutscher Wetterdienst, Offenbach)
[2696]127!
128! Description:
129! ------------
130!> The io module contains the functions needed to read and write netCDF data in
131!> INIFOR.
132!------------------------------------------------------------------------------!
[3680]133#if defined ( __netcdf )
[3618]134 MODULE inifor_io
[2696]135
[3618]136    USE inifor_control
137    USE inifor_defs,                                                           &
[3866]138        ONLY:  DATE, SNAME, PATH, PI, TO_RADIANS, TO_DEGREES, VERSION,         &
[3801]139               NC_DEPTH_NAME, NC_HHL_NAME, NC_RLAT_NAME, NC_RLON_NAME,         &
140               NC_ROTATED_POLE_NAME, NC_POLE_LATITUDE_NAME,                    &
[4523]141               NC_POLE_LONGITUDE_NAME, RHO_L, iwp, wp
[3618]142    USE inifor_types
143    USE inifor_util,                                                           &
[3678]144        ONLY:  add_hours_to, reverse, str, real_to_str
[2696]145    USE netcdf
146
147    IMPLICIT NONE
148
[3557]149!------------------------------------------------------------------------------!
150! Description:
151! ------------
152!> get_netcdf_variable() reads the netCDF data and metadate for the netCDF
[3866]153!> variable 'in_var%name' from the file 'in_file'. The netCDF data array is
[3557]154!> stored in the 'buffer' array and metadata added to the respective members of
155!> the given 'in_var'.
156!------------------------------------------------------------------------------!
[3182]157    INTERFACE get_netcdf_variable
[3997]158       MODULE PROCEDURE get_netcdf_variable_int
159       MODULE PROCEDURE get_netcdf_variable_real
[3182]160    END INTERFACE get_netcdf_variable
161
162    PRIVATE ::  get_netcdf_variable_int, get_netcdf_variable_real
163
[2696]164 CONTAINS
165
[3557]166!------------------------------------------------------------------------------!
167! Description:
168! ------------
169!> get_netcdf_variable_int() implements the integer variant for the
170!> get_netcdf_variable interface.
171!------------------------------------------------------------------------------!
[3866]172 SUBROUTINE get_netcdf_variable_int(in_file, in_var, buffer)
[3182]173
[3866]174    CHARACTER(LEN=PATH), INTENT(IN)          ::  in_file
175    TYPE(nc_var), INTENT(INOUT)              ::  in_var
176    INTEGER(iwp), ALLOCATABLE, INTENT(INOUT) ::  buffer(:,:,:)
[3182]177
[3866]178    INTEGER               ::  ncid
179    INTEGER, DIMENSION(3) ::  start, count
[3182]180
[3866]181    IF ( nf90_open( TRIM(in_file), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
182         nf90_inq_varid( ncid, in_var%name, in_var%varid ) .EQ. NF90_NOERR )  THEN
[3447]183
[3866]184       CALL get_input_dimensions(in_var, ncid)
[3447]185
[3866]186       CALL get_netcdf_start_and_count(in_var, start, count)
187       CALL log_runtime('time', 'read')
[3447]188
[3866]189       ALLOCATE( buffer( count(1), count(2), count(3) ) )
190       CALL log_runtime('time', 'alloc')
[3447]191
[3866]192       CALL check(nf90_get_var( ncid, in_var%varid, buffer,                  &
193                                start = start,                                 &
194                                count = count ))
[3447]195
[3866]196    ELSE
[3447]197
[3866]198       message = "Failed to read '" // TRIM(in_var%name) // &
199          "' from file '" // TRIM(in_file) // "'."
200       CALL inifor_abort('get_netcdf_variable', message)
[3447]201
[3866]202    ENDIF
[3447]203
[3866]204    CALL check(nf90_close(ncid))
205    CALL log_runtime('time', 'read')
[3447]206
[3866]207 END SUBROUTINE get_netcdf_variable_int
[3182]208
209
[3557]210!------------------------------------------------------------------------------!
211! Description:
212! ------------
213!> get_netcdf_variable_real() implements the real variant for the
214!> get_netcdf_variable interface.
215!------------------------------------------------------------------------------!
[3866]216 SUBROUTINE get_netcdf_variable_real(in_file, in_var, buffer)
[3182]217
[3866]218    CHARACTER(LEN=PATH), INTENT(IN)      ::  in_file
219    TYPE(nc_var), INTENT(INOUT)          ::  in_var
220    REAL(wp), ALLOCATABLE, INTENT(INOUT) ::  buffer(:,:,:)
[3182]221
[3866]222    INTEGER               ::  ncid
223    INTEGER, DIMENSION(3) ::  start, count
[3182]224
[3866]225    IF ( nf90_open( TRIM(in_file), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
226         nf90_inq_varid( ncid, in_var%name, in_var%varid ) .EQ. NF90_NOERR )  THEN
[3447]227
[3866]228       CALL get_input_dimensions(in_var, ncid)
[3447]229
[3866]230       CALL get_netcdf_start_and_count(in_var, start, count)
231       CALL log_runtime('time', 'read')
[3447]232
[3866]233       ALLOCATE( buffer( count(1), count(2), count(3) ) )
234       CALL log_runtime('time', 'alloc')
[3447]235
[3866]236       CALL check(nf90_get_var( ncid, in_var%varid, buffer,                  &
237                                start = start,                                 &
238                                count = count ))
[3447]239
[3866]240    ELSE
[3447]241
[3866]242       message = "Failed to read '" // TRIM(in_var%name) // &
243          "' from file '" // TRIM(in_file) // "'."
244       CALL inifor_abort('get_netcdf_variable', message)
[3447]245
[3866]246    ENDIF
[3447]247
[3866]248    CALL check(nf90_close(ncid))
249    CALL log_runtime('time', 'read')
[3447]250
[3866]251 END SUBROUTINE get_netcdf_variable_real
[3182]252
253
[3557]254!------------------------------------------------------------------------------!
255! Description:
256! ------------
257!> get_netcdf_dim_vector() reads the coordinate array 'coordname' from the
258!> netCDF file 'filename'.
259!------------------------------------------------------------------------------!
[3866]260 SUBROUTINE get_netcdf_dim_vector(filename, coordname, coords)
[3537]261
[3866]262    CHARACTER(LEN=*), INTENT(IN)         ::  filename
263    CHARACTER(LEN=*), INTENT(IN)         ::  coordname
264    REAL(wp), ALLOCATABLE, INTENT(INOUT) ::  coords(:)
[3537]265
[3866]266    INTEGER ::  ncid, varid, dimlen
267    INTEGER ::  dimids(NF90_MAX_VAR_DIMS)
[3537]268
[3866]269    IF ( nf90_open( TRIM(filename), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
270         nf90_inq_varid( ncid, coordname, varid ) .EQ. NF90_NOERR )  THEN
[3537]271
[3866]272       CALL check(nf90_inquire_variable( ncid, varid, dimids = dimids ))
273       CALL check(nf90_inquire_dimension( ncid, dimids(1), len = dimlen ))
[3537]274
[3866]275       ALLOCATE(coords(dimlen))
276       CALL check(nf90_get_var( ncid, varid, coords))
[3537]277
[3866]278    ELSE
[3537]279
[3866]280       message = "Failed to read '" // TRIM(coordname) // &
281          "' from file '" // TRIM(filename) // "'."
282       CALL inifor_abort('get_netcdf_dim_vector', message)
[3537]283
[3866]284    ENDIF
[3537]285
[3866]286 END SUBROUTINE get_netcdf_dim_vector
[3537]287
288
[3557]289!------------------------------------------------------------------------------!
290! Description:
291! ------------
292!> get_input_dimensions() reads dimensions metadata of the netCDF variable given
[3866]293!> by 'in_var%name' into 'in_var' data structure.
[3557]294!------------------------------------------------------------------------------!
[3866]295 SUBROUTINE get_input_dimensions(in_var, ncid)
[3447]296
[3866]297    TYPE(nc_var), INTENT(INOUT) ::  in_var
298    INTEGER, INTENT(IN)         ::  ncid
[3447]299
[3866]300    INTEGER ::  i
[3447]301
[3866]302    CALL check(nf90_get_att( ncid, in_var%varid, "long_name",             &
303                             in_var%long_name))
[3447]304
[3866]305    CALL check(nf90_get_att( ncid, in_var%varid, "units",                 &
306                             in_var%units ))
[3447]307
[3866]308    CALL check(nf90_inquire_variable( ncid, in_var%varid,                 &
309                                      ndims  = in_var%ndim,               &
310                                      dimids = in_var%dimids ))
[3447]311
[3866]312    DO  i = 1, in_var%ndim
313       CALL check(nf90_inquire_dimension( ncid, in_var%dimids(i),         &
314                                          name = in_var%dimname(i),       &
315                                          len  = in_var%dimlen(i) ))
316    ENDDO
[3447]317
[3866]318 END SUBROUTINE get_input_dimensions
[3447]319
320
[3557]321!------------------------------------------------------------------------------!
322! Description:
323! ------------
324!> get_netcdf_start_and_count() gets the start position and element counts for
325!> the given netCDF file. This information is used in get_netcdf_variable_int()
326!> and _real() for reading input variables..
327!------------------------------------------------------------------------------!
[3866]328 SUBROUTINE get_netcdf_start_and_count(in_var, start, count)
[3447]329
[3866]330    TYPE(nc_var), INTENT(INOUT)        ::  in_var
331    INTEGER, DIMENSION(3), INTENT(OUT) ::  start, count
[3447]332
[3866]333    INTEGER ::  ndim
[3447]334
[3866]335    IF ( in_var%ndim .LT. 2  .OR.  in_var%ndim .GT. 4 )  THEN
[3447]336
[3866]337       message = "Failed reading NetCDF variable " //                       &
[4523]338          TRIM(in_var%name) // " with " //                                  &
339          TRIM(str(INT(in_var%ndim, kind=iwp))) //                          &
[3866]340          " dimensions because only two- and and three-dimensional" //      &
341          " variables are supported."
342       CALL inifor_abort('get_netcdf_start_and_count', message)
[3447]343
[3866]344    ENDIF
[3447]345
[3866]346    start = (/ 1, 1, 1 /)
347    IF ( TRIM(in_var%name) .EQ. 'T_SO' )  THEN
[3557]348!
[3866]349!--    Skip depth = 0.0 for T_SO and reduce number of depths from 9 to 8
350       in_var%dimlen(3) = in_var%dimlen(3) - 1
[3447]351
[3557]352!
[3866]353!--    Start reading from second level, e.g. depth = 0.005 instead of 0.0
354       start(3) = 2
355    ENDIF
[3447]356
[3866]357    IF (in_var%ndim .EQ. 2)  THEN
358       in_var%dimlen(3) = 1
359    ENDIF
[3447]360
[3866]361    ndim = MIN(in_var%ndim, 3)
362    count = (/ 1, 1, 1 /)
363    count(1:ndim) = in_var%dimlen(1:ndim)
[3447]364
[3866]365 END SUBROUTINE get_netcdf_start_and_count
[3447]366
367
[3557]368!------------------------------------------------------------------------------!
369! Description:
370! ------------
371!> Routine for defining netCDF variables in the dynamic driver, INIFOR's netCDF
372!> output.
373!------------------------------------------------------------------------------!
[3866]374 SUBROUTINE netcdf_define_variable(var, ncid)
[2696]375
[3866]376     TYPE(nc_var), INTENT(INOUT) ::  var
377     INTEGER, INTENT(IN)         ::  ncid
[2696]378
[3866]379     CALL check(nf90_def_var(ncid, var%name, NF90_FLOAT,       var%dimids(1:var%ndim), var%varid))
380     CALL check(nf90_put_att(ncid, var%varid, "long_name",     var%long_name))
381     CALL check(nf90_put_att(ncid, var%varid, "units",         var%units))
382     IF ( var%lod .GE. 0 )  THEN
383        CALL check(nf90_put_att(ncid, var%varid, "lod",           var%lod))
384     ENDIF
385     CALL check(nf90_put_att(ncid, var%varid, "source",        var%source))
386     CALL check(nf90_put_att(ncid, var%varid, "_FillValue",    NF90_FILL_REAL))
[2696]387
[3866]388 END SUBROUTINE netcdf_define_variable
[2696]389   
390
[3557]391!------------------------------------------------------------------------------!
392! Description:
393! ------------
394!> netcdf_get_dimensions() reads in all dimensions and their lengths and stores
395!> them in the given the 'var' data structure. This information is used later
396!> for writing output variables in update_output().
397!------------------------------------------------------------------------------!
[3866]398 SUBROUTINE netcdf_get_dimensions(var, ncid)
[2696]399
[3866]400     TYPE(nc_var), INTENT(INOUT) ::  var
401     INTEGER, INTENT(IN)         ::  ncid
402     INTEGER                     ::  i
403     CHARACTER(SNAME)            ::  null
[2696]404
[3866]405     DO  i = 1, var%ndim
406        CALL check(nf90_inquire_dimension(ncid, var%dimids(i), &
407                                          name = null, &
408                                          len  = var%dimlen(i)  ) )
409     ENDDO
[2696]410
[3866]411 END SUBROUTINE netcdf_get_dimensions
[2696]412
413
414!------------------------------------------------------------------------------!
415! Description:
416! ------------
[3557]417!> This routine parses and interpretes the command-line options and stores the
418!> resulting settings in the 'cfg' data structure.
[2696]419!------------------------------------------------------------------------------!
[3866]420 SUBROUTINE parse_command_line_arguments( cfg )
[2696]421
[3866]422    TYPE(inifor_config), INTENT(INOUT) ::  cfg
[2696]423
[3866]424    CHARACTER(LEN=PATH)                ::  option, arg
425    INTEGER                            ::  arg_count, i
[2696]426
[3866]427    cfg%flow_prefix_is_set = .FALSE.
428    cfg%input_prefix_is_set = .FALSE.
[3997]429    cfg%p0_is_set = .FALSE.
[3866]430    cfg%radiation_prefix_is_set = .FALSE.
431    cfg%soil_prefix_is_set = .FALSE.
432    cfg%soilmoisture_prefix_is_set = .FALSE.
[3997]433    cfg%ug_defined_by_user = .FALSE.
434    cfg%vg_defined_by_user = .FALSE.
435    cfg%z0_is_set = .FALSE.
[3395]436
[3866]437    arg_count = COMMAND_ARGUMENT_COUNT()
438    IF (arg_count .GT. 0)  THEN
[2696]439
[3866]440       message = "The -clon and -clat command line options are depricated. " // &
441          "Please remove them form your inifor command and specify the " // &
442          "location of the PALM-4U origin either" // NEW_LINE(' ') // &
443          "   - by setting the namelist parameters 'longitude' and 'latitude', or" // NEW_LINE(' ') // &
444          "   - by providing a static driver netCDF file via the -static command-line option."
[2696]445
[3866]446       i = 1
447       DO  WHILE (i .LE. arg_count)
[2696]448
[3866]449          CALL GET_COMMAND_ARGUMENT( i, option )
[2696]450
[3866]451          SELECT CASE( TRIM(option) )
[2696]452
[3395]453             CASE( '--averaging-mode' )
454                CALL get_option_argument( i, arg )
[3866]455                cfg%averaging_mode = TRIM(arg)
[3395]456
[3182]457             CASE( '-date', '-d', '--date' )
458                CALL get_option_argument( i, arg )
[3866]459                cfg%start_date = TRIM(arg)
[2696]460
[3395]461             CASE( '--debug' )
[3866]462                cfg%debug = .TRUE.
[3395]463
[3182]464             CASE( '-z0', '-z', '--elevation' )
[3997]465                cfg%z0_is_set = .TRUE.
[3182]466                CALL get_option_argument( i, arg )
[3866]467                READ(arg, *) cfg%z0
[2696]468
[3182]469             CASE( '-p0', '-r', '--surface-pressure' )
[3866]470                cfg%p0_is_set = .TRUE.
[3182]471                CALL get_option_argument( i, arg )
[3866]472                READ(arg, *) cfg%p0
[2696]473
[3182]474             CASE( '-ug', '-u', '--geostrophic-u' )
[3866]475                cfg%ug_defined_by_user = .TRUE.
[3182]476                CALL get_option_argument( i, arg )
[3866]477                READ(arg, *) cfg%ug
[2696]478
[3182]479             CASE( '-vg', '-v', '--geostrophic-v' )
[3866]480                cfg%vg_defined_by_user = .TRUE.
[3182]481                CALL get_option_argument( i, arg )
[3866]482                READ(arg, *) cfg%vg
[2696]483
[3182]484             CASE( '-clon', '-clat' )
[3615]485                CALL inifor_abort('parse_command_line_arguments', message)
[2696]486
[3182]487             CASE( '-path', '-p', '--path' )
488                CALL get_option_argument( i, arg )
[3866]489                 cfg%input_path = TRIM(arg)
[2696]490
[3182]491             CASE( '-hhl', '-l', '--hhl-file' )
492                CALL get_option_argument( i, arg )
[3866]493                cfg%hhl_file = TRIM(arg)
[2696]494
[3395]495             CASE( '--input-prefix')
496                CALL get_option_argument( i, arg )
[3866]497                cfg%input_prefix = TRIM(arg)
498                cfg%input_prefix_is_set = .TRUE.
[3395]499   
500             CASE( '-a', '--averaging-angle' )
501                CALL get_option_argument( i, arg )
[3866]502                READ(arg, *) cfg%averaging_angle
[3395]503
[3182]504             CASE( '-static', '-t', '--static-driver' )
505                CALL get_option_argument( i, arg )
[3866]506                cfg%static_driver_file = TRIM(arg)
[2696]507
[3182]508             CASE( '-soil', '-s', '--soil-file')
509                CALL get_option_argument( i, arg )
[3866]510                cfg%soiltyp_file = TRIM(arg)
[2696]511
[3182]512             CASE( '--flow-prefix')
513                CALL get_option_argument( i, arg )
[3866]514                cfg%flow_prefix = TRIM(arg)
515                cfg%flow_prefix_is_set = .TRUE.
[3395]516   
[3182]517             CASE( '--radiation-prefix')
518                CALL get_option_argument( i, arg )
[3866]519                cfg%radiation_prefix = TRIM(arg)
520                cfg%radiation_prefix_is_set = .TRUE.
[3395]521   
[3182]522             CASE( '--soil-prefix')
523                CALL get_option_argument( i, arg )
[3866]524                cfg%soil_prefix = TRIM(arg)
525                cfg%soil_prefix_is_set = .TRUE.
[3395]526   
[3182]527             CASE( '--soilmoisture-prefix')
528                CALL get_option_argument( i, arg )
[3866]529                cfg%soilmoisture_prefix = TRIM(arg)
530                cfg%soilmoisture_prefix_is_set = .TRUE.
[2696]531
[3182]532             CASE( '-o', '--output' )
533                CALL get_option_argument( i, arg )
[3866]534                cfg%output_file = TRIM(arg)
[2696]535
[3182]536             CASE( '-n', '--namelist' )
537                CALL get_option_argument( i, arg )
[3866]538                cfg%namelist_file = TRIM(arg)
[2696]539
[3182]540             CASE( '-mode', '-i', '--init-mode' )
541                CALL get_option_argument( i, arg )
[3866]542                cfg%ic_mode = TRIM(arg)
[3182]543
544             CASE( '-f', '--forcing-mode' )
545                CALL get_option_argument( i, arg )
[3866]546                cfg%bc_mode = TRIM(arg)
[3182]547
548             CASE( '--version' )
[3866]549                CALL print_version
[3182]550                STOP
551
552             CASE( '--help' )
[3866]553                CALL print_version
[3182]554                PRINT *, ""
555                PRINT *, "For a list of command-line options have a look at the README file."
556                STOP
557
[2696]558             CASE DEFAULT
[3182]559                message = "unknown option '" // TRIM(option) // "'."
[3615]560                CALL inifor_abort('parse_command_line_arguments', message)
[2696]561
[3866]562          END SELECT
[2696]563
[3866]564          i = i + 1
[3182]565
[3866]566       ENDDO
[2696]567
[3866]568    ELSE
569         
[3997]570       CALL print_version
571       CALL report( 'parse_command_line_arguments', 'No arguments present, exiting.' )
572       STOP
[2696]573
[3866]574    ENDIF
[2696]575
[3866]576 END SUBROUTINE parse_command_line_arguments
[2696]577
[3678]578
[3997]579
[3866]580 SUBROUTINE get_datetime_file_list( start_date_string, start_hour, end_hour, &
581                                    step_hour, input_path, prefix, suffix,   &
582                                    file_list )
[3678]583
[3866]584    CHARACTER (LEN=DATE), INTENT(IN) ::  start_date_string
585    CHARACTER (LEN=*),    INTENT(IN) ::  prefix, suffix, input_path
[4523]586    INTEGER(iwp),         INTENT(IN) ::  start_hour, end_hour, step_hour
[3866]587    CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) ::  file_list(:)
[3678]588
[4523]589    INTEGER(iwp)        ::  number_of_intervals, hour, i
[3866]590    CHARACTER(LEN=DATE) ::  date_string
[3678]591
[3866]592    number_of_intervals = CEILING( REAL(end_hour - start_hour) / step_hour )
593    ALLOCATE( file_list(number_of_intervals + 1) )
[3678]594
[3866]595    DO  i = 0, number_of_intervals
[3678]596
[3866]597       hour = start_hour + i * step_hour
598       date_string = add_hours_to(start_date_string, hour)
[3678]599
[3866]600       file_list(i+1) = TRIM(input_path) // TRIM(prefix) //                  &
601                        TRIM(date_string) // TRIM(suffix) // '.nc'
[3678]602
[3866]603    ENDDO
[3678]604
[3866]605 END SUBROUTINE get_datetime_file_list
[3678]606
[3557]607!------------------------------------------------------------------------------!
608! Description:
609! ------------
[3678]610!> Establish a list of files based on the given start and end times and file
611!> prefixes and suffixes.
612!------------------------------------------------------------------------------!
[3866]613 SUBROUTINE get_input_file_list( start_date_string, start_hour, end_hour,    &
614                                 step_hour, input_path, prefix, suffix,      &
615                                 file_list, nocheck )
[3678]616
[3866]617    CHARACTER (LEN=DATE), INTENT(IN) ::  start_date_string
618    CHARACTER (LEN=*),    INTENT(IN) ::  prefix, suffix, input_path
[4523]619    INTEGER(iwp),         INTENT(IN) ::  start_hour, end_hour, step_hour
[3866]620    CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) ::  file_list(:)
621    LOGICAL, OPTIONAL, INTENT(IN)    ::  nocheck
[3678]622
[4523]623    INTEGER(iwp) ::  i
624    LOGICAL      ::  check_files
[3678]625
[3866]626    CALL get_datetime_file_list( start_date_string, start_hour, end_hour,    &
627                                 step_hour, input_path, prefix, suffix,      &
628                                 file_list )
[3678]629
[3866]630    check_files = .TRUE.
631    IF ( PRESENT ( nocheck ) )  THEN
632       IF ( nocheck )  check_files = .FALSE.
633    ENDIF
[3678]634
[3866]635    IF ( check_files )  THEN
[3678]636
[3866]637       tip = "Please check if you specified the correct file prefix " //     &
638             "using the options --input-prefix, --flow-prefix, etc."
[3716]639
[3866]640       DO  i = 1, SIZE(file_list)
641           CALL verify_file(file_list(i), 'input', tip)
642       ENDDO
[3716]643
[3866]644    ENDIF
[3716]645
[3866]646 END SUBROUTINE get_input_file_list
[3678]647
648
649!------------------------------------------------------------------------------!
650! Description:
651! ------------
652!> Abort INIFOR if the given file is not present.
653!------------------------------------------------------------------------------!
[3866]654 SUBROUTINE verify_file(file_name, file_kind, tip)
[3678]655
[3866]656    CHARACTER(LEN=*), INTENT(IN)           ::  file_name, file_kind
657    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  tip
[3678]658
[3866]659    IF (.NOT. file_present(file_name))  THEN
[3678]660
[3866]661       IF (LEN(TRIM(file_name)) == 0)  THEN
[3678]662
[3866]663          message = "No name was given for the " // TRIM(file_kind) // " file."
[3678]664
[3866]665       ELSE
[3678]666
[3866]667          message = "The " // TRIM(file_kind) // " file '" //                &
668                    TRIM(file_name) // "' was not found."
[3678]669
[3866]670          IF (PRESENT(tip))  THEN
671             message = TRIM(message) // " " // TRIM(tip)
672          ENDIF
[3678]673
[3866]674       ENDIF
[3678]675
[3866]676       CALL inifor_abort('verify_file', message)
[3678]677
[3866]678    ENDIF
[3678]679
[3866]680    message = "Set up input file name '" // TRIM(file_name) // "'"
681    CALL report('verify_file', message)
[3764]682
[3866]683 END SUBROUTINE verify_file
[3678]684
685
686!------------------------------------------------------------------------------!
687! Description:
688! ------------
[3557]689!> Get the argument of the i'th command line option, which is at the location
690!> i+1 of the argument list.
691!------------------------------------------------------------------------------!
[3866]692 SUBROUTINE get_option_argument(i, arg)
693    CHARACTER(LEN=PATH), INTENT(INOUT) ::  arg
694    INTEGER, INTENT(INOUT)             ::  i
[2696]695
[3866]696    i = i + 1
697    CALL GET_COMMAND_ARGUMENT(i, arg)
[3182]698
[3866]699 END SUBROUTINE
[3182]700
701
[3557]702!------------------------------------------------------------------------------!
703! Description:
704! ------------
705!> Checks the INIFOR configuration 'cfg' for plausibility.
706!------------------------------------------------------------------------------!
[3866]707 SUBROUTINE validate_config(cfg)
708    TYPE(inifor_config), INTENT(IN) ::  cfg
[3182]709
[3866]710    CALL verify_file(cfg%hhl_file, 'HHL')
711    CALL verify_file(cfg%namelist_file, 'NAMELIST')
712    CALL verify_file(cfg%soiltyp_file, 'SOILTYP')
[3182]713
[3557]714!
[3866]715!-- Only check optional static driver file name, if it has been given.
716    IF (TRIM(cfg%static_driver_file) .NE. '')  THEN
717       CALL verify_file(cfg%static_driver_file, 'static driver')
718    ENDIF
[3182]719
[3866]720    SELECT CASE( TRIM(cfg%ic_mode) )
721       CASE( 'profile', 'volume')
722       CASE DEFAULT
723          message = "Initialization mode '" // TRIM(cfg%ic_mode) //&
724                    "' is not supported. " //&
725                    "Please select either 'profile' or 'volume', " //&
726                    "or omit the -i/--init-mode/-mode option entirely, which corresponds "//&
727                    "to the latter."
728          CALL inifor_abort( 'validate_config', message )
729    END SELECT
[3182]730
[3866]731    SELECT CASE( TRIM(cfg%bc_mode) )
732       CASE( 'real', 'ideal')
733       CASE DEFAULT
734          message = "Forcing mode '" // TRIM(cfg%bc_mode) //& 
735                    "' is not supported. " //&
736                    "Please select either 'real' or 'ideal', " //&
737                    "or omit the -f/--forcing-mode option entirely, which corresponds "//&
738                    "to the latter."
739          CALL inifor_abort( 'validate_config', message )
740    END SELECT
[3182]741
[3866]742    SELECT CASE( TRIM(cfg%averaging_mode) )
743       CASE( 'level' )
744       CASE( 'height' )
745          message = "Averaging mode '" // TRIM(cfg%averaging_mode) //&
746                    "' is currently not supported. " //&
747                    "Please use level-based averaging by selecting 'level', " //&
748                    "or by omitting the --averaging-mode option entirely."
749          CALL inifor_abort( 'validate_config', message )
750       CASE DEFAULT
751          message = "Averaging mode '" // TRIM(cfg%averaging_mode) //&
752                    "' is not supported. " //&
753          !          "Please select either 'height' or 'level', " //&
754          !          "or omit the --averaging-mode option entirely, which corresponds "//&
755          !          "to the latter."
756                    "Please use level-based averaging by selecting 'level', " //&
757                    "or by omitting the --averaging-mode option entirely."
758          CALL inifor_abort( 'validate_config', message )
759    END SELECT
[3182]760
[3866]761    IF ( cfg%ug_defined_by_user .NEQV. cfg%vg_defined_by_user )  THEN
762       message = "You specified only one component of the geostrophic " // &
763                 "wind. Please specify either both or none."
764       CALL inifor_abort( 'validate_config', message )
765    ENDIF
[3182]766
[3866]767 END SUBROUTINE validate_config
[3395]768
[3182]769
[4074]770 SUBROUTINE get_cosmo_grid( hhl_file, soil_file, rlon, rlat, hhl, hfl, depths, &
[3866]771                            d_depth, d_depth_rho_inv, phi_n, lambda_n,       &
772                            phi_equat,                                       &
773                            lonmin_cosmo, lonmax_cosmo,                      &
774                            latmin_cosmo, latmax_cosmo,                      &
775                            nlon, nlat, nlev, ndepths )
[3182]776
[4074]777    CHARACTER(LEN=PATH), INTENT(IN)                      ::  hhl_file  !< path to file containing the HHL variable (height of half layers)
778    CHARACTER(LEN=PATH), INTENT(IN)                      ::  soil_file !< path to one of the soil input files for reading soil layer depths
[3866]779    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(OUT)     ::  rlon      !< longitudes of COSMO-DE's rotated-pole grid
780    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(OUT)     ::  rlat      !< latitudes of COSMO-DE's rotated-pole grid
781    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(OUT) ::  hhl       !< heights of half layers (cell faces) above sea level in COSMO-DE, read in from external file
782    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(OUT) ::  hfl       !< heights of full layers (cell centres) above sea level in COSMO-DE, computed as arithmetic average of hhl
783    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(OUT)     ::  depths    !< COSMO-DE's TERRA-ML soil layer depths
784    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(OUT)     ::  d_depth
785    REAL(wp), DIMENSION(:), ALLOCATABLE, INTENT(OUT)     ::  d_depth_rho_inv
786    REAL(wp), INTENT(OUT)                                ::  phi_n
787    REAL(wp), INTENT(OUT)                                ::  phi_equat
788    REAL(wp), INTENT(OUT)                                ::  lambda_n
789    REAL(wp), INTENT(OUT)                                ::  lonmin_cosmo !< Minimunm longitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad]
790    REAL(wp), INTENT(OUT)                                ::  lonmax_cosmo !< Maximum longitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad]
791    REAL(wp), INTENT(OUT)                                ::  latmin_cosmo !< Minimunm latitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad]
792    REAL(wp), INTENT(OUT)                                ::  latmax_cosmo !< Maximum latitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad]
[4523]793    INTEGER(iwp), INTENT(OUT)                            ::  nlon, nlat, nlev, ndepths
[3801]794
[3866]795    TYPE(nc_var) ::  cosmo_var !< COSMO dummy variable, used for reading HHL, rlon, rlat
[4523]796    INTEGER(iwp) ::  k
[3801]797
798!
[3866]799!-- Read in COSMO's heights of half layers (vertical cell faces)
800    cosmo_var%name = NC_HHL_NAME
[4074]801    CALL get_netcdf_variable( hhl_file, cosmo_var, hhl )
802    CALL get_netcdf_dim_vector( hhl_file, NC_RLON_NAME, rlon )
803    CALL get_netcdf_dim_vector( hhl_file, NC_RLAT_NAME, rlat )
[3866]804    CALL get_netcdf_dim_vector( soil_file, NC_DEPTH_NAME, depths)
805    CALL log_runtime( 'time', 'read' )
[3801]806
[3866]807    CALL reverse( hhl )
808    nlon = SIZE( hhl, 1 )
809    nlat = SIZE( hhl, 2 )
810    nlev = SIZE( hhl, 3 )
811    ndepths = SIZE( depths )
[3801]812
[3866]813    CALL log_runtime( 'time', 'comp' )
[3801]814
[3866]815    ALLOCATE( hfl( nlon, nlat, nlev-1 ) )
816    ALLOCATE( d_depth( ndepths ), d_depth_rho_inv( ndepths ) )
817    CALL log_runtime('time', 'alloc')
[3801]818
[3866]819    CALL get_soil_layer_thickness( depths, d_depth )
820    d_depth_rho_inv = 1.0_wp / ( d_depth * RHO_L )
[3801]821
822!
[3866]823!-- Compute COSMO's heights of full layers (cell centres)
824    DO  k = 1, nlev-1
825       hfl(:,:,k) = 0.5_wp * ( hhl(:,:,k) +                                  &
826                               hhl(:,:,k+1) )
827    ENDDO
[3801]828!
[3866]829!-- COSMO rotated pole coordinates
830    phi_n = TO_RADIANS                                                       &
[4074]831          * get_netcdf_variable_attribute( hhl_file,                         &
[3866]832                                           NC_ROTATED_POLE_NAME,             &
833                                           NC_POLE_LATITUDE_NAME )
[3801]834
[3866]835    lambda_n = TO_RADIANS                                                    &
[4074]836             * get_netcdf_variable_attribute( hhl_file,                      &
[3866]837                                              NC_ROTATED_POLE_NAME,          &
838                                              NC_POLE_LONGITUDE_NAME )
[3801]839
[3866]840    phi_equat = 90.0_wp * TO_RADIANS - phi_n
[3801]841
[3866]842    lonmin_cosmo = MINVAL( rlon ) * TO_RADIANS
843    lonmax_cosmo = MAXVAL( rlon ) * TO_RADIANS
844    latmin_cosmo = MINVAL( rlat ) * TO_RADIANS
845    latmax_cosmo = MAXVAL( rlat ) * TO_RADIANS
846    CALL log_runtime('time', 'comp')
[3801]847
[3866]848 END SUBROUTINE get_cosmo_grid
[3801]849
850
[3557]851!------------------------------------------------------------------------------!
852! Description:
853! ------------
[3801]854!> Fills the thickness array of the COSMO soil layers. Since COSMO's (i.e.
855!> TERRA_ML's [1]) soil layer boundaries follow the rule
856!>
857!>    depth(0) = 0.0, and
858!>    depth(k) = 0.01 * 3**(k-1), k in [1,2,3,...,7]
859!>
860!> and full levels are defined as the midpoints between two layer boundaries,
861!> all except the first layer thicknesses equal the depth of the midpoint.
862!>
863!> [1] A Description of the Nonhydrostatic Regional COSMO Model Part II :
864!>     Physical Parameterization*, Sect. 11 TERRA_ML.
865!>     http://www.cosmo-model.org/content/model/documentation/core/cosmoPhysParamtr.pdf)
866!>
867!> Input parameters:
868!> -----------------
869!>
870!> depths: array of full soil layer depths (cell midpoints)
871!>
872!>
873!> Output parameters:
874!> ------------------
875!>
876!> d_depth: array of soil layer thicknesses
877!>
878!------------------------------------------------------------------------------!
[3866]879 SUBROUTINE get_soil_layer_thickness(depths, d_depth)
[3801]880
[3866]881    REAL(wp), INTENT(IN)  ::  depths(:)
882    REAL(wp), INTENT(OUT) ::  d_depth(:)
[3801]883
[3866]884    d_depth(:) = depths(:)
885    d_depth(1) = 2.0_wp * depths(1)
[3801]886
[3866]887 END SUBROUTINE get_soil_layer_thickness
[3801]888!------------------------------------------------------------------------------!
889! Description:
890! ------------
[3557]891!> Check whether the given file is present on the filesystem.
892!------------------------------------------------------------------------------!
[3866]893 LOGICAL FUNCTION file_present(filename)
894    CHARACTER(LEN=PATH), INTENT(IN) ::  filename
[3182]895
[3866]896    INQUIRE(FILE=filename, EXIST=file_present)
[3182]897
[3866]898 END FUNCTION file_present
[3182]899
900
[2696]901!------------------------------------------------------------------------------!
902! Description:
903! ------------
[3557]904!> This routine initializes the dynamic driver file, i.e. INIFOR's netCDF output
905!> file.
[2696]906!>
907!> Besides writing metadata, such as global attributes, coordinates, variables,
[3557]908!> in the netCDF file, various netCDF IDs are saved for later, when INIFOR
[2696]909!> writes the actual data.
910!------------------------------------------------------------------------------!
[3866]911 SUBROUTINE setup_netcdf_dimensions( output_file, palm_grid,                  &
912                                     start_date_string, origin_lon, origin_lat )
[2696]913
[3866]914    TYPE(nc_file), INTENT(INOUT)      ::  output_file
915    TYPE(grid_definition), INTENT(IN) ::  palm_grid
916    CHARACTER (LEN=DATE), INTENT(IN)  ::  start_date_string
917    REAL(wp), INTENT(IN)              ::  origin_lon, origin_lat
[2696]918
[3866]919    CHARACTER (LEN=8)     ::  date_string
920    CHARACTER (LEN=10)    ::  time_string
921    CHARACTER (LEN=5)     ::  zone_string
922    CHARACTER (LEN=SNAME) ::  history_string
[4523]923    INTEGER               ::  nx, ny, nz, nt
924    INTEGER               ::  ncid, dimids(3), dimvarids(3)
[3866]925    REAL(wp)              ::  z0
[2696]926
[3866]927    message = "Initializing PALM-4U dynamic driver file '" //               &
928              TRIM(output_file%name) // "' and setting up dimensions."
929    CALL report('setup_netcdf_dimensions', message)
[3182]930
[3557]931!
[3866]932!-- Create the netCDF file as in netCDF-4/HDF5 format if __netcdf4 preprocessor flag is given
[3182]933#if defined( __netcdf4 )
[3866]934    CALL check(nf90_create(TRIM(output_file%name), OR(NF90_CLOBBER, NF90_HDF5), ncid))
[3182]935#else
[3866]936    CALL check(nf90_create(TRIM(output_file%name), NF90_CLOBBER, ncid))
[3182]937#endif
[2696]938
[3395]939!------------------------------------------------------------------------------
940!- Section 1: Define NetCDF dimensions and coordinates
941!------------------------------------------------------------------------------
[3866]942    nt = SIZE(output_file%time)
943    nx = palm_grid%nx
944    ny = palm_grid%ny
945    nz = palm_grid%nz
946    z0 = palm_grid%z0
[3395]947
948
[2696]949!
950!------------------------------------------------------------------------------
[3395]951!- Section 2: Write global NetCDF attributes
[2696]952!------------------------------------------------------------------------------
[3866]953    CALL date_and_time(DATE=date_string, TIME=time_string, ZONE=zone_string)
954    history_string =                                                        &
955        'Created on '// date_string      //                                 &
956        ' at '       // time_string(1:2) // ':' // time_string(3:4) //      &
957        ' (UTC'      // zone_string // ')'
[3182]958
[3866]959    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'title',          'PALM input file for scenario ...'))
960    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'institution',    'Deutscher Wetterdienst, Offenbach'))
961    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'author',         'Eckhard Kadasch, eckhard.kadasch@dwd.de'))
962    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'history',        TRIM(history_string)))
963    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'references',     '--'))
964    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'comment',        '--'))
965    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_lat',     TRIM(real_to_str(origin_lat*TO_DEGREES, '(F18.13)'))))
966    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_lon',     TRIM(real_to_str(origin_lon*TO_DEGREES, '(F18.13)'))))
[3557]967!
[3866]968!-- FIXME: This is the elevation relative to COSMO-DE/D2 sea level and does
969!-- FIXME: not necessarily comply with DHHN2016 (c.f. PALM Input Data
970!-- FIXME: Standard v1.9., origin_z)
971    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_z',       TRIM(real_to_str(z0, '(F18.13)'))))
972    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'inifor_version', TRIM(VERSION)))
973    CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'palm_version',   '--'))
[2696]974
975!
976!
977!------------------------------------------------------------------------------
978!- Section 2a: Define dimensions for cell centers (scalars in soil and atmosph.)
979!------------------------------------------------------------------------------
[3557]980!
[3866]981!-- reset dimids first
982    dimids = (/0, 0, 0/)
983    CALL check( nf90_def_dim(ncid, "x", nx+1, dimids(1)) )
984    CALL check( nf90_def_dim(ncid, "y", ny+1, dimids(2)) )
985    CALL check( nf90_def_dim(ncid, "z", nz, dimids(3)) )
[3557]986!
[3866]987!-- save dimids for later
988    output_file%dimids_scl = dimids 
[2696]989
[3557]990!
[3866]991!-- reset dimvarids first
992    dimvarids = (/0, 0, 0/)
993    CALL check(nf90_def_var(ncid, "x", NF90_FLOAT, dimids(1), dimvarids(1)))
994    CALL check(nf90_put_att(ncid, dimvarids(1), "standard_name", "x coordinate of cell centers"))
995    CALL check(nf90_put_att(ncid, dimvarids(1), "units", "m"))
[2696]996
[3866]997    CALL check(nf90_def_var(ncid, "y", NF90_FLOAT, dimids(2), dimvarids(2)))
998    CALL check(nf90_put_att(ncid, dimvarids(2), "standard_name", "y coordinate of cell centers"))
999    CALL check(nf90_put_att(ncid, dimvarids(2), "units", "m"))
[2696]1000
[3866]1001    CALL check(nf90_def_var(ncid, "z", NF90_FLOAT, dimids(3), dimvarids(3)))
1002    CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "z coordinate of cell centers"))
1003    CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
[3557]1004!
[3866]1005!-- save dimvarids for later
1006    output_file%dimvarids_scl = dimvarids
[2696]1007
[3557]1008!
[3866]1009!-- overwrite third dimid with the one of depth
1010    CALL check(nf90_def_dim(ncid, "zsoil", SIZE(palm_grid%depths), dimids(3)) )
[3557]1011!
[3866]1012!-- save dimids for later
1013    output_file%dimids_soil = dimids
[2696]1014
[3557]1015!
[3866]1016!-- overwrite third dimvarid with the one of depth
1017    CALL check(nf90_def_var(ncid, "zsoil", NF90_FLOAT, output_file%dimids_soil(3), dimvarids(3)))
1018    CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "depth_below_land"))
1019    CALL check(nf90_put_att(ncid, dimvarids(3), "positive", "down"))
1020    CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
[2696]1021!
[3866]1022!-- save dimvarids for later
1023    output_file%dimvarids_soil = dimvarids
[3557]1024!
[2696]1025!------------------------------------------------------------------------------
1026!- Section 2b: Define dimensions for cell faces/velocities
1027!------------------------------------------------------------------------------
[3557]1028!
[3866]1029!-- reset dimids first
1030    dimids = (/0, 0, 0/)
1031    CALL check(nf90_def_dim(ncid, "xu", nx, dimids(1)) )
1032    CALL check(nf90_def_dim(ncid, "yv", ny, dimids(2)) )
1033    CALL check(nf90_def_dim(ncid, "zw", nz-1, dimids(3)) )
[3557]1034!
[3866]1035!-- save dimids for later
1036    output_file%dimids_vel = dimids
[2696]1037
[3557]1038!
[3866]1039!-- reset dimvarids first
1040    dimvarids = (/0, 0, 0/)
1041    CALL check(nf90_def_var(ncid, "xu", NF90_FLOAT, dimids(1), dimvarids(1)))
1042    CALL check(nf90_put_att(ncid, dimvarids(1), "standard_name", "x coordinate of cell faces"))
1043    CALL check(nf90_put_att(ncid, dimvarids(1), "units", "m"))
[2696]1044
[3866]1045    CALL check(nf90_def_var(ncid, "yv", NF90_FLOAT, dimids(2), dimvarids(2)))
1046    CALL check(nf90_put_att(ncid, dimvarids(2), "standard_name", "y coordinate of cell faces"))
1047    CALL check(nf90_put_att(ncid, dimvarids(2), "units", "m"))
[2696]1048
[3866]1049    CALL check(nf90_def_var(ncid, "zw", NF90_FLOAT, dimids(3), dimvarids(3)))
1050    CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "z coordinate of cell faces"))
1051    CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
[3557]1052!
[3866]1053!-- save dimvarids for later
1054    output_file%dimvarids_vel = dimvarids
[2696]1055
1056!
1057!------------------------------------------------------------------------------
1058!- Section 2c: Define time dimension
1059!------------------------------------------------------------------------------
[3866]1060    CALL check(nf90_def_dim(ncid, "time", nt, output_file%dimid_time) )
1061    CALL check(nf90_def_var(ncid, "time", NF90_FLOAT, &
1062                                          output_file%dimid_time, &
1063                                          output_file%dimvarid_time))
1064    CALL check(nf90_put_att(ncid, output_file%dimvarid_time, "standard_name", "time"))
1065    CALL check(nf90_put_att(ncid, output_file%dimvarid_time, "long_name", "time"))
1066    CALL check(nf90_put_att(ncid, output_file%dimvarid_time, "units",     &
1067                            "seconds since " // start_date_string // " UTC"))
[2696]1068
[3866]1069    CALL check(nf90_enddef(ncid))
[2696]1070
1071!
1072!------------------------------------------------------------------------------
1073!- Section 3: Write grid coordinates
1074!------------------------------------------------------------------------------
[3866]1075    CALL check(nf90_put_var(ncid, output_file%dimvarids_scl(1), palm_grid%x))
1076    CALL check(nf90_put_var(ncid, output_file%dimvarids_scl(2), palm_grid%y))
1077    CALL check(nf90_put_var(ncid, output_file%dimvarids_scl(3), palm_grid%z))
[2696]1078
[3866]1079    CALL check(nf90_put_var(ncid, output_file%dimvarids_vel(1), palm_grid%xu))
1080    CALL check(nf90_put_var(ncid, output_file%dimvarids_vel(2), palm_grid%yv))
1081    CALL check(nf90_put_var(ncid, output_file%dimvarids_vel(3), palm_grid%zw))
[2696]1082
[3557]1083!
[3866]1084!-- TODO Read in soil depths from input file before this.
1085    CALL check(nf90_put_var(ncid, output_file%dimvarids_soil(3), palm_grid%depths))
[2696]1086
[3557]1087!
[3866]1088!-- Write time vector
1089    CALL check(nf90_put_var(ncid, output_file%dimvarid_time, output_file%time))
[2696]1090
[3557]1091!
[3866]1092!-- Close the file
1093    CALL check(nf90_close(ncid))
[2696]1094
[3866]1095 END SUBROUTINE setup_netcdf_dimensions
[2696]1096
1097
[3557]1098!------------------------------------------------------------------------------!
1099! Description:
1100! ------------
1101!> Defines the netCDF variables to be written to the dynamic driver file
1102!------------------------------------------------------------------------------!
[3866]1103 SUBROUTINE setup_netcdf_variables(filename, output_variable_table)
[2696]1104
[3866]1105    CHARACTER (LEN=*), INTENT(IN)        ::  filename
1106    TYPE(nc_var), INTENT(INOUT), TARGET  ::  output_variable_table(:)
[3456]1107
[3866]1108    TYPE(nc_var), POINTER                ::  var
[4523]1109    INTEGER(iwp)                         ::  i
1110    INTEGER                              ::  ncid
[3866]1111    LOGICAL                              ::  to_be_written
[2696]1112
[3866]1113    message = "Defining variables in dynamic driver '" // TRIM(filename) // "'."
1114    CALL report('setup_netcdf_variables', message)
[2696]1115
[3866]1116    CALL check(nf90_open(TRIM(filename), NF90_WRITE, ncid))
1117    CALL check(nf90_redef(ncid))
[2696]1118
[3866]1119    DO  i = 1, SIZE(output_variable_table)
[2696]1120
[3866]1121       var => output_variable_table(i)
[2696]1122
[3866]1123       !to_be_written = ( var%to_be_processed  .AND. .NOT. var%is_internal) .OR. &
1124       !                ( var%is_internal  .AND.  debug )
1125       to_be_written = ( var%to_be_processed  .AND. .NOT. var%is_internal)
[3456]1126
[3866]1127       IF ( to_be_written )  THEN
1128          message = "  variable #" // TRIM(str(i)) // " '" // TRIM(var%name) // "'."
1129          CALL report('setup_netcdf_variables', message)
[2696]1130
[3866]1131          CALL netcdf_define_variable(var, ncid)
1132          CALL netcdf_get_dimensions(var, ncid)
1133       ENDIF
1134       
1135    ENDDO
[2696]1136
[3866]1137    CALL check(nf90_enddef(ncid))
1138    CALL check(nf90_close(ncid))
[2696]1139
[3866]1140    message = "Dynamic driver '" // TRIM(filename) // "' initialized successfully."
1141    CALL report('setup_netcdf_variables', message)
[2696]1142
[3866]1143 END SUBROUTINE setup_netcdf_variables
[2696]1144
1145
1146!------------------------------------------------------------------------------!
1147! Description:
1148! ------------
1149!> This routine reads and returns all input variables of the given IO group
1150!> It accomodates the data by allocating a container variable that represents a
1151!> list of arrays of the same length as the groups variable list. (This list
1152!> will typically contain one or two items.) After the container, its members
1153!> are allocated one by one with the appropriate, possibly different,
1154!> dimensions.
1155!>
1156!> The 'group' is an INTENT(INOUT) variable so that 'get_netcdf_variable()' can
1157!> record netCDF IDs in the 'in_var_list()' member variable.
1158!------------------------------------------------------------------------------!
[3866]1159 SUBROUTINE read_input_variables(group, iter, buffer)
1160    TYPE(io_group), INTENT(INOUT), TARGET       ::  group
[4523]1161    INTEGER(iwp), INTENT(IN)                    ::  iter
[3866]1162    TYPE(container), ALLOCATABLE, INTENT(INOUT) ::  buffer(:)
[4523]1163    INTEGER(iwp)                                ::  hour, buf_id
[3866]1164    TYPE(nc_var), POINTER                       ::  input_var
1165    CHARACTER(LEN=PATH), POINTER                ::  input_file
[4523]1166    INTEGER(iwp)                                ::  ivar, nbuffers
[2696]1167
[3866]1168    message = "Reading data for I/O group '" // TRIM(group%in_var_list(1)%name) // "'."
1169    CALL report('read_input_variables', message)
[2696]1170
[3866]1171    input_file => group%in_files(iter)
[2696]1172
1173!
1174!------------------------------------------------------------------------------
1175!- Section 1: Load input buffers for accumulated variables
1176!------------------------------------------------------------------------------
[3557]1177!
[3866]1178!-- radiation budgets, precipitation
1179    IF (group%kind == 'running average' .OR.                              &
1180        group%kind == 'accumulated')  THEN
[2696]1181
[3866]1182       IF (SIZE(group%in_var_list) .GT. 1 ) THEN
1183          message = "I/O groups may not contain more than one " // & 
1184                    "accumulated variable. Group '" // TRIM(group%kind) //&
1185                    "' contains " //                                        &
[4523]1186                    TRIM( str(SIZE(group%in_var_list, kind=iwp)) ) // "."
[3866]1187          CALL inifor_abort('read_input_variables | accumulation', message)
1188       ENDIF
[2696]1189
[3557]1190!
[3866]1191!--    use two buffer arrays
1192       nbuffers = 2
1193       IF ( .NOT. ALLOCATED( buffer ) )  ALLOCATE( buffer(nbuffers) )
[2696]1194
[3557]1195!
[3866]1196!--    hour of the day
1197       hour = iter - 1
[3557]1198!
[3866]1199!--    chose correct buffer array
1200       buf_id = select_buffer(hour)
[2696]1201
[3866]1202       CALL log_runtime('time', 'read')
1203       IF ( ALLOCATED(buffer(buf_id)%array) )  DEALLOCATE(buffer(buf_id)%array)
1204       CALL log_runtime('time', 'alloc')
[2696]1205
[3866]1206       input_var => group%in_var_list(1)
1207       CALL get_netcdf_variable(input_file, input_var, buffer(buf_id)%array)
1208       CALL report('read_input_variables', "Read accumulated " // TRIM(group%in_var_list(1)%name)) 
[2696]1209
[3866]1210       IF ( input_var%is_upside_down )  CALL reverse(buffer(buf_id)%array)
1211       CALL log_runtime('time', 'comp')
[2696]1212         
1213!------------------------------------------------------------------------------
1214!- Section 2: Load input buffers for normal I/O groups
1215!------------------------------------------------------------------------------
[3866]1216    ELSE
[2696]1217
[3557]1218!
[3866]1219!--    Allocate one input buffer per input_variable. If more quantities
1220!--    have to be computed than input variables exist in this group,
1221!--    allocate more buffers. For instance, in the thermodynamics group,
1222!--    there are three input variabels (PP, T, Qv) and four quantities
1223!--    necessart (P, Theta, Rho, qv) for the corresponding output fields
1224!--    (p0, Theta, qv, ug, and vg)
1225       nbuffers = MAX( group%n_inputs, group%n_output_quantities )
1226       ALLOCATE( buffer(nbuffers) )
1227       CALL log_runtime('time', 'alloc')
1228       
[3557]1229!
[3866]1230!--    Read in all input variables, leave extra buffers-if any-untouched.
1231       DO  ivar = 1, group%n_inputs
[2696]1232
[3866]1233          input_var => group%in_var_list(ivar)
[2696]1234
[3557]1235!
[3866]1236!         Check wheather P or PP is present in input file
1237          IF (input_var%name == 'P')  THEN
1238             input_var%name = TRIM( get_pressure_varname(input_file) )
1239          CALL log_runtime('time', 'read')
1240          ENDIF
[2696]1241
[3866]1242          CALL get_netcdf_variable(input_file, input_var, buffer(ivar)%array)
[2696]1243
[3866]1244          IF ( input_var%is_upside_down )  CALL reverse(buffer(ivar)%array)
1245          CALL log_runtime('time', 'comp')
[2696]1246
[3866]1247       ENDDO
1248    ENDIF
[2696]1249
[3866]1250 END SUBROUTINE read_input_variables
[2696]1251
1252
[3557]1253!------------------------------------------------------------------------------!
1254! Description:
1255! ------------
1256!> Select the appropriate buffer ID for accumulated COSMO input variables
1257!> depending on the current hour.
1258!------------------------------------------------------------------------------!
[4523]1259 INTEGER(iwp) FUNCTION select_buffer(hour)
1260    INTEGER(iwp), INTENT(IN) ::  hour
1261    INTEGER(iwp)             ::  step
[2696]1262
[4523]1263    select_buffer = 0_iwp
1264    step = MODULO(hour, 3_iwp) + 1_iwp
[2696]1265
[3866]1266    SELECT CASE(step)
[2696]1267       CASE(1, 3)
[4523]1268           select_buffer = 1_iwp
[2696]1269       CASE(2)
[4523]1270           select_buffer = 2_iwp
[2696]1271       CASE DEFAULT
1272           message = "Invalid step '" // TRIM(str(step))
[3615]1273           CALL inifor_abort('select_buffer', message)
[3866]1274    END SELECT
1275 END FUNCTION select_buffer
[2696]1276
1277
1278!------------------------------------------------------------------------------!
1279! Description:
1280! ------------
1281!> Checks if the input_file contains the absolute pressure, 'P', or the pressure
1282!> perturbation, 'PP', and returns the appropriate string.
1283!------------------------------------------------------------------------------!
[3866]1284 CHARACTER(LEN=2) FUNCTION get_pressure_varname(input_file) RESULT(var)
1285    CHARACTER(LEN=*) ::  input_file
1286    INTEGER          ::  ncid, varid
[2696]1287
[3866]1288    CALL check(nf90_open( TRIM(input_file), NF90_NOWRITE, ncid ))
1289    IF ( nf90_inq_varid( ncid, 'P', varid ) .EQ. NF90_NOERR )  THEN
[2696]1290
[3866]1291       var = 'P'
[2696]1292
[3866]1293    ELSE IF ( nf90_inq_varid( ncid, 'PP', varid ) .EQ. NF90_NOERR )  THEN
[2696]1294
[3866]1295       var = 'PP'
1296       CALL report('get_pressure_var', 'Using PP instead of P')
[2696]1297
[3866]1298    ELSE
[2696]1299
[3866]1300       message = "Failed to read '" // TRIM(var) // &
1301                 "' from file '" // TRIM(input_file) // "'."
1302       CALL inifor_abort('get_pressure_var', message)
[2696]1303
[3866]1304    ENDIF
[2696]1305
[3866]1306    CALL check(nf90_close(ncid))
[2696]1307
[3866]1308 END FUNCTION get_pressure_varname
[2696]1309
1310
[3557]1311!------------------------------------------------------------------------------!
1312! Description:
1313! ------------
1314!> Read the given global attribute form the given netCDF file.
1315!------------------------------------------------------------------------------!
[3866]1316 FUNCTION get_netcdf_attribute(filename, attribute) RESULT(attribute_value)
[2696]1317
[3866]1318    CHARACTER(LEN=*), INTENT(IN) ::  filename, attribute
1319    REAL(wp)                     ::  attribute_value
[2696]1320
[3866]1321    INTEGER                      ::  ncid
[2696]1322
[3866]1323    IF ( nf90_open( TRIM(filename), NF90_NOWRITE, ncid ) == NF90_NOERR )  THEN
[2696]1324
[3866]1325       CALL check(nf90_get_att(ncid, NF90_GLOBAL, TRIM(attribute), attribute_value))
1326       CALL check(nf90_close(ncid))
[2696]1327
[3866]1328    ELSE
[2696]1329
[3866]1330       message = "Failed to read '" // TRIM(attribute) // &
1331                 "' from file '" // TRIM(filename) // "'."
1332       CALL inifor_abort('get_netcdf_attribute', message)
[2696]1333
[3866]1334    ENDIF
[2696]1335
[3866]1336 END FUNCTION get_netcdf_attribute
[2696]1337
1338
[3801]1339!------------------------------------------------------------------------------!
1340! Description:
1341! ------------
1342!> Read the attribute of the given variable form the given netCDF file.
1343!------------------------------------------------------------------------------!
[3866]1344 FUNCTION get_netcdf_variable_attribute(filename, varname, attribute)       &
1345    RESULT(attribute_value)
[3557]1346
[3866]1347    CHARACTER(LEN=*), INTENT(IN) ::  filename, varname, attribute
1348    REAL(wp)                     ::  attribute_value
[3801]1349
[3866]1350    INTEGER                      ::  ncid, varid
[3801]1351
[3866]1352    IF ( nf90_open( TRIM(filename), NF90_NOWRITE, ncid ) == NF90_NOERR )  THEN
[3801]1353
[3866]1354       CALL check( nf90_inq_varid( ncid, TRIM( varname ), varid ) )
1355       CALL check( nf90_get_att( ncid, varid, TRIM( attribute ),            &
1356                   attribute_value ) )
1357       CALL check( nf90_close( ncid ) )
[3801]1358
[3866]1359    ELSE
[3801]1360
[3866]1361       message = "Failed to read '" // TRIM( varname ) // ":" //            &
1362                 TRIM( attribute ) // "' from file '" // TRIM(filename) // "'."
1363       CALL inifor_abort('get_netcdf_variable_attribute', message)
[3801]1364
[3866]1365    ENDIF
[3801]1366
[3866]1367 END FUNCTION get_netcdf_variable_attribute
[3801]1368
[3557]1369!------------------------------------------------------------------------------!
1370! Description:
1371! ------------
1372!> Updates the dynamic driver with the interpolated field of the current
1373!> variable at the current time step.
1374!------------------------------------------------------------------------------!
[3866]1375 SUBROUTINE update_output(var, array, iter, output_file, cfg)
1376    TYPE(nc_var), INTENT(IN)  ::  var
1377    REAL(wp), INTENT(IN)      ::  array(:,:,:)
[4523]1378    INTEGER(iwp), INTENT(IN)  ::  iter
[3866]1379    TYPE(nc_file), INTENT(IN) ::  output_file
1380    TYPE(inifor_config)       ::  cfg
[2696]1381
[4523]1382    INTEGER      ::  ncid, ndim, start(4), count(4)
1383    LOGICAL      ::  var_is_time_dependent
[2696]1384
[3866]1385    var_is_time_dependent = (                                               &
1386       var%dimids( var%ndim ) == output_file%dimid_time               &
1387    )
[2696]1388
[3557]1389!
[3866]1390!-- Skip time dimension for output
1391    ndim = var%ndim
1392    IF ( var_is_time_dependent )  ndim = var%ndim - 1
[2696]1393
[3866]1394    start(:)      = (/1,1,1,1/)
1395    start(ndim+1) = iter
1396    count(1:ndim) = var%dimlen(1:ndim)
[2696]1397
[3866]1398    CALL check(nf90_open(output_file%name, NF90_WRITE, ncid))
[2696]1399
[3557]1400!
[3866]1401!-- Reduce dimension of output array according to variable kind
1402    SELECT CASE (TRIM(var%kind))
[2696]1403       
1404       CASE ( 'init scalar profile', 'init u profile', 'init v profile',       &
1405              'init w profile' )
1406
1407          CALL check(nf90_put_var( ncid, var%varid, array(1,1,:) ) )
1408
1409       CASE ( 'init soil', 'init scalar', 'init u', 'init v', 'init w' )
1410
1411          CALL check(nf90_put_var( ncid, var%varid, array(:,:,:) ) )
1412
1413       CASE( 'left scalar', 'right scalar', 'left w', 'right w' ) 
1414
1415          CALL check(nf90_put_var( ncid, var%varid, array(1,:,:),              &
1416                                   start=start(1:ndim+1),                      &
1417                                   count=count(1:ndim) ) )
1418         
1419
[3866]1420          IF (.NOT. SIZE(array, 2) .EQ. var%dimlen(1))  THEN
[2696]1421             PRINT *, "inifor: update_output: Dimension ", 1, " of variable ", &
[3866]1422                 TRIM(var%name), " (", var%dimlen(1),                      &
[2696]1423                 ") does not match the dimension of the output array (",       &
1424                 SIZE(array, 2), ")."
1425             STOP
[3785]1426          ENDIF
[2696]1427         
1428
1429       CASE( 'north scalar', 'south scalar', 'north w', 'south w' )
1430
1431          CALL check(nf90_put_var( ncid, var%varid, array(:,1,:),              &
1432                                   start=start(1:ndim+1),                      &
1433                                   count=count(1:ndim) ) )
1434         
1435
1436       CASE( 'surface forcing', 'top scalar', 'top w' )
1437
1438          CALL check(nf90_put_var( ncid, var%varid, array(:,:,1),              &
1439                                   start=start(1:ndim+1),                      &
1440                                   count=count(1:ndim) ) )
1441         
1442       CASE ( 'left u', 'right u', 'left v', 'right v' )
1443
1444          CALL check(nf90_put_var( ncid, var%varid, array(1,:,:),              &
1445                                   start=start(1:ndim+1),                      &
1446                                   count=count(1:ndim) ) )
1447
1448       CASE ( 'north u', 'south u', 'north v', 'south v' )
1449
1450          CALL check(nf90_put_var( ncid, var%varid, array(:,1,:),              &
1451                                   start=start(1:ndim+1),                      &
1452                                   count=count(1:ndim) ) )
1453
1454       CASE ( 'top u', 'top v' )
1455
1456          CALL check(nf90_put_var( ncid, var%varid, array(:,:,1),              &
1457                                   start=start(1:ndim+1),                      &
1458                                   count=count(1:ndim) ) )
1459
1460       CASE ( 'time series' )
1461
1462          CALL check(nf90_put_var( ncid, var%varid, array(1,1,1),              &
1463                                   start=start(1:ndim+1) ) )
1464
[3456]1465       CASE ( 'constant scalar profile', 'geostrophic' )
[2696]1466
1467          CALL check(nf90_put_var( ncid, var%varid, array(1,1,:),              &
1468                                   start=start(1:ndim+1),                      &
1469                                   count=count(1:ndim) ) )
1470
[3456]1471       CASE ( 'internal profile' )
1472
[3866]1473          IF ( cfg%debug )  THEN
[3456]1474             CALL check(nf90_put_var( ncid, var%varid, array(1,1,:),           &
1475                                      start=start(1:ndim+1),                   &
1476                                      count=count(1:ndim) ) )
[3785]1477          ENDIF
[3456]1478
[3182]1479       CASE ( 'large-scale scalar forcing', 'large-scale w forcing' )
1480
1481           message = "Doing nothing in terms of writing large-scale forings."
1482           CALL report('update_output', message)
1483
[2696]1484       CASE DEFAULT
1485
[3866]1486           message = "Variable kind '" // TRIM(var%kind) //                  &
[2696]1487                    "' not recognized."
[3615]1488           CALL inifor_abort('update_output', message)
[2696]1489
[3866]1490    END SELECT
[2696]1491
[3866]1492    CALL check(nf90_close(ncid))
[2696]1493
[3866]1494 END SUBROUTINE update_output
[2696]1495
1496
[3557]1497!------------------------------------------------------------------------------!
1498! Description:
1499! ------------
1500!> Checks the status of a netCDF API call and aborts if an error occured
1501!------------------------------------------------------------------------------!
[3866]1502 SUBROUTINE check(status)
[2696]1503
[3866]1504    INTEGER, INTENT(IN) ::  status
[2696]1505
[3866]1506    IF (status /= nf90_noerr)  THEN
1507       message = "NetCDF API call failed with error: " //                     &
1508                 TRIM( nf90_strerror(status) )
1509       CALL inifor_abort('io.check', message)
1510    ENDIF
[2696]1511
[3866]1512 END SUBROUTINE check
[2696]1513
[3618]1514 END MODULE inifor_io
[3680]1515#endif
Note: See TracBrowser for help on using the repository browser.