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

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

Removed unused variable

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