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

Last change on this file since 4019 was 3997, checked in by eckhard, 5 years ago

inifor: Read origin_z from static driver if given; alert user to warnings

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