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

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

inifor: Use PALM's working precision; improved error handling, coding style, and comments

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