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

Last change on this file since 3524 was 3456, checked in by eckhard, 6 years ago

inifor: Removed surface forcing and internal arrays from netCDF output

  • Property svn:keywords set to Id
File size: 42.6 KB
Line 
1!> @file src/inifor_io.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
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
8! version.
9!
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.
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!
17! Copyright 2017-2018 Leibniz Universitaet Hannover
18! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
19!------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23!
24!
25! Former revisions:
26! -----------------
27! $Id: inifor_io.f90 3456 2018-10-30 14:29:54Z raasch $
28! NetCDf output of internal arrays only with --debug option
29!
30!
31! 3447 2018-10-29 15:52:54Z eckhard
32! Removed INCLUDE statement for get_netcdf_variable()
33! Renamed source files for compatibilty with PALM build system
34!
35!
36! 3395 2018-10-22 17:32:49Z eckhard
37! Added command-line options for configuring the computation of geostrophic
38!     winds (--averagin-mode, --averaging-angle)
39! Added command-line option --input-prefix for setting input file prefixes all
40!     at once
41! Added --debug option for more verbose terminal output
42! Added option-specific *_is_set LOGICALs to indicate invocation from the
43!     command-line
44! Improved error messages in case of empty file-name strings
45! Improved routine naming
46!
47! 3183 2018-07-27 14:25:55Z suehring
48! Introduced new PALM grid stretching
49! Updated variable names and metadata for PIDS v1.9 compatibility
50! Improved handling of the start date string
51! Better compatibility with older Intel compilers:
52! - avoiding implicit array allocation with new get_netcdf_variable()
53!   subroutine instead of function
54! Improved command line interface:
55! - Added configuration validation
56! - New options to configure input file prefixes
57! - GNU-style short and long option names
58! - Added version and copyright output
59!
60!
61! 3182 2018-07-27 13:36:03Z suehring
62! Initial revision
63!
64!
65!
66! Authors:
67! --------
68! @author Eckhard Kadasch
69!
70! Description:
71! ------------
72!> The io module contains the functions needed to read and write netCDF data in
73!> INIFOR.
74!------------------------------------------------------------------------------!
75 MODULE io
76
77    USE control
78    USE defs,                                                                  &
79        ONLY:  DATE, SNAME, PATH, PI, dp, hp, TO_RADIANS, TO_DEGREES, VERSION
80    USE netcdf
81    USE types
82    USE util,                                                                  &
83        ONLY:  reverse, str, real_to_str
84
85    IMPLICIT NONE
86
87    INTERFACE get_netcdf_variable
88        MODULE PROCEDURE get_netcdf_variable_int
89        MODULE PROCEDURE get_netcdf_variable_real
90    END INTERFACE get_netcdf_variable
91
92    PRIVATE ::  get_netcdf_variable_int, get_netcdf_variable_real
93
94 CONTAINS
95
96    SUBROUTINE get_netcdf_variable_int(in_file, in_var, buffer)
97
98       CHARACTER(LEN=PATH), INTENT(IN)         ::  in_file
99       TYPE(nc_var), INTENT(INOUT)             ::  in_var
100       INTEGER(hp), ALLOCATABLE, INTENT(INOUT) ::  buffer(:,:,:)
101
102       INTEGER               ::  ncid
103       INTEGER, DIMENSION(3) ::  start, count
104
105       IF ( nf90_open( TRIM(in_file), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
106            nf90_inq_varid( ncid, in_var % name, in_var % varid ) .EQ. NF90_NOERR )  THEN
107
108          CALL get_input_dimensions(in_var, ncid)
109
110          CALL get_netcdf_start_and_count(in_var, start, count)
111 CALL run_control('time', 'read')
112
113          ALLOCATE( buffer( count(1), count(2), count(3) ) )
114 CALL run_control('time', 'alloc')
115
116          CALL check(nf90_get_var( ncid, in_var % varid, buffer,                  &
117                                   start = start,                                 &
118                                   count = count ))
119
120       ELSE
121
122          message = "Failed to read '" // TRIM(in_var % name) // &
123             "' from file '" // TRIM(in_file) // "'."
124          CALL abort('get_netcdf_variable', message)
125
126       END IF
127
128       CALL check(nf90_close(ncid))
129 CALL run_control('time', 'read')
130
131    END SUBROUTINE get_netcdf_variable_int
132
133
134    SUBROUTINE get_netcdf_variable_real(in_file, in_var, buffer)
135
136       CHARACTER(LEN=PATH), INTENT(IN)      ::  in_file
137       TYPE(nc_var), INTENT(INOUT)          ::  in_var
138       REAL(dp), ALLOCATABLE, INTENT(INOUT) ::  buffer(:,:,:)
139
140       INTEGER               ::  ncid
141       INTEGER, DIMENSION(3) ::  start, count
142
143       IF ( nf90_open( TRIM(in_file), NF90_NOWRITE, ncid ) .EQ. NF90_NOERR .AND. &
144            nf90_inq_varid( ncid, in_var % name, in_var % varid ) .EQ. NF90_NOERR )  THEN
145
146          CALL get_input_dimensions(in_var, ncid)
147
148          CALL get_netcdf_start_and_count(in_var, start, count)
149 CALL run_control('time', 'read')
150
151          ALLOCATE( buffer( count(1), count(2), count(3) ) )
152 CALL run_control('time', 'alloc')
153
154          CALL check(nf90_get_var( ncid, in_var % varid, buffer,                  &
155                                   start = start,                                 &
156                                   count = count ))
157
158       ELSE
159
160          message = "Failed to read '" // TRIM(in_var % name) // &
161             "' from file '" // TRIM(in_file) // "'."
162          CALL abort('get_netcdf_variable', message)
163
164       END IF
165
166       CALL check(nf90_close(ncid))
167 CALL run_control('time', 'read')
168
169    END SUBROUTINE get_netcdf_variable_real
170
171
172    SUBROUTINE get_input_dimensions(in_var, ncid)
173
174       TYPE(nc_var), INTENT(INOUT)     ::  in_var
175       INTEGER, INTENT(OUT)            ::  ncid
176
177       INTEGER ::  i
178
179       CALL check(nf90_get_att( ncid, in_var % varid, "long_name",             &
180                                in_var % long_name))
181
182       CALL check(nf90_get_att( ncid, in_var % varid, "units",                 &
183                                in_var % units ))
184
185       CALL check(nf90_inquire_variable( ncid, in_var % varid,                 &
186                                         ndims  = in_var % ndim,               &
187                                         dimids = in_var % dimids ))
188
189       DO i = 1, in_var % ndim
190          CALL check(nf90_inquire_dimension( ncid, in_var % dimids(i),         &
191                                             name = in_var % dimname(i),       &
192                                             len  = in_var % dimlen(i) ))
193       END DO
194
195    END SUBROUTINE get_input_dimensions
196
197
198    SUBROUTINE get_netcdf_start_and_count(in_var, start, count)
199
200       TYPE(nc_var), INTENT(INOUT)        ::  in_var
201       INTEGER, DIMENSION(3), INTENT(OUT) ::  start, count
202
203       INTEGER ::  ndim
204
205       IF ( in_var % ndim .LT. 2  .OR.  in_var % ndim .GT. 4 )  THEN
206
207          message = "Failed reading NetCDF variable " //                       &
208             TRIM(in_var % name) // " with " // TRIM(str(in_var%ndim)) //      &
209             " dimensions because only two- and and three-dimensional" //      &
210             " variables are supported."
211          CALL abort('get_netcdf_start_and_count', message)
212
213       END IF
214
215       start = (/ 1, 1, 1 /)
216       IF ( TRIM(in_var % name) .EQ. 'T_SO' )  THEN
217          ! Skip depth = 0.0 for T_SO and reduce number of depths from 9 to 8
218          in_var % dimlen(3) = in_var % dimlen(3) - 1
219
220          ! Start reading from second level, e.g. depth = 0.005 instead of 0.0
221          start(3) = 2
222       END IF
223
224       IF (in_var % ndim .EQ. 2)  THEN
225          in_var % dimlen(3) = 1
226       ENDIF
227
228       ndim = MIN(in_var % ndim, 3)
229       count = (/ 1, 1, 1 /)
230       count(1:ndim) = in_var % dimlen(1:ndim)
231
232    END SUBROUTINE get_netcdf_start_and_count
233
234
235    SUBROUTINE netcdf_define_variable(var, ncid)
236
237        TYPE(nc_var), INTENT(INOUT) ::  var
238        INTEGER, INTENT(IN)         ::  ncid
239
240        CALL check(nf90_def_var(ncid, var % name, NF90_FLOAT,       var % dimids(1:var % ndim), var % varid))
241        CALL check(nf90_put_att(ncid, var % varid, "long_name",     var % long_name))
242        CALL check(nf90_put_att(ncid, var % varid, "units",         var % units))
243        IF ( var % lod .GE. 0 )  THEN
244           CALL check(nf90_put_att(ncid, var % varid, "lod",           var % lod))
245        END IF
246        CALL check(nf90_put_att(ncid, var % varid, "source",        var % source))
247        CALL check(nf90_put_att(ncid, var % varid, "_FillValue",    NF90_FILL_REAL))
248
249    END SUBROUTINE netcdf_define_variable
250   
251
252    SUBROUTINE netcdf_get_dimensions(var, ncid)
253
254        TYPE(nc_var), INTENT(INOUT) ::  var
255        INTEGER, INTENT(IN)         ::  ncid
256        INTEGER                     ::  i
257        CHARACTER(SNAME)            ::  null
258
259        ! Remember dimension lenghts for NetCDF writing routine
260        DO i = 1, var % ndim
261           CALL check(nf90_inquire_dimension(ncid, var % dimids(i), &
262                                             name = null, &
263                                             len  = var % dimlen(i)  ) )
264        END DO
265
266    END SUBROUTINE netcdf_get_dimensions
267
268
269!------------------------------------------------------------------------------!
270! Description:
271! ------------
272!> This routine initializes Inifor. This includes parsing command-line
273!> arguments, setting the names of the input and output file names as well as
274!> the name of the input namelist and, subsequently, reading in and setting grid
275!> parameters for the PALM-4U computational grid.
276!------------------------------------------------------------------------------!
277    SUBROUTINE parse_command_line_arguments( cfg )
278
279       TYPE(inifor_config), INTENT(INOUT) ::  cfg
280
281       CHARACTER(LEN=PATH)                ::  option, arg
282       INTEGER                            ::  arg_count, i
283
284       cfg % p0_is_set = .FALSE.
285       cfg % ug_is_set = .FALSE.
286       cfg % vg_is_set = .FALSE.
287       cfg % flow_prefix_is_set = .FALSE.
288       cfg % input_prefix_is_set = .FALSE.
289       cfg % radiation_prefix_is_set = .FALSE.
290       cfg % soil_prefix_is_set = .FALSE.
291       cfg % soilmoisture_prefix_is_set = .FALSE.
292
293       arg_count = COMMAND_ARGUMENT_COUNT()
294       IF (arg_count .GT. 0)  THEN
295
296          ! Every option should have an argument.
297          !IF ( MOD(arg_count, 2) .NE. 0 )  THEN
298          !   message = "Syntax error in command line."
299          !   CALL abort('parse_command_line_arguments', message)
300          !END IF
301         
302          message = "The -clon and -clat command line options are depricated. " // &
303             "Please remove them form your inifor command and specify the " // &
304             "location of the PALM-4U origin either" // NEW_LINE(' ') // &
305             "   - by setting the namelist parameters 'longitude' and 'latitude', or" // NEW_LINE(' ') // &
306             "   - by providing a static driver netCDF file via the -static command-line option."
307
308          i = 1
309          DO WHILE (i .LE. arg_count)
310
311             CALL GET_COMMAND_ARGUMENT( i, option )
312
313             SELECT CASE( TRIM(option) )
314
315             CASE( '--averaging-mode' )
316                CALL get_option_argument( i, arg )
317                cfg % averaging_mode = TRIM(arg)
318
319             CASE( '-date', '-d', '--date' )
320                CALL get_option_argument( i, arg )
321                cfg % start_date = TRIM(arg)
322
323             CASE( '--debug' )
324                cfg % debug = .TRUE.
325
326             ! Elevation of the PALM-4U domain above sea level
327             CASE( '-z0', '-z', '--elevation' )
328                CALL get_option_argument( i, arg )
329                READ(arg, *) cfg % z0
330
331             ! surface pressure, at z0
332             CASE( '-p0', '-r', '--surface-pressure' )
333                cfg % p0_is_set = .TRUE.
334                CALL get_option_argument( i, arg )
335                READ(arg, *) cfg % p0
336
337             ! geostrophic wind in x direction
338             CASE( '-ug', '-u', '--geostrophic-u' )
339                cfg % ug_is_set = .TRUE.
340                CALL get_option_argument( i, arg )
341                READ(arg, *) cfg % ug
342
343             ! geostrophic wind in y direction
344             CASE( '-vg', '-v', '--geostrophic-v' )
345                cfg % vg_is_set = .TRUE.
346                CALL get_option_argument( i, arg )
347                READ(arg, *) cfg % vg
348
349             ! domain centre geographical longitude and latitude
350             CASE( '-clon', '-clat' )
351                CALL abort('parse_command_line_arguments', message)         
352                !READ(arg, *) lambda_cg
353                !lambda_cg = lambda_cg * TO_RADIANS
354                !READ(arg, *) phi_cg
355                !phi_cg = phi_cg * TO_RADIANS
356
357             CASE( '-path', '-p', '--path' )
358                CALL get_option_argument( i, arg )
359                 cfg % input_path = TRIM(arg)
360
361             CASE( '-hhl', '-l', '--hhl-file' )
362                CALL get_option_argument( i, arg )
363                cfg % hhl_file = TRIM(arg)
364
365             CASE( '--input-prefix')
366                CALL get_option_argument( i, arg )
367                cfg % input_prefix = TRIM(arg)
368                cfg % input_prefix_is_set = .TRUE.
369   
370             CASE( '-a', '--averaging-angle' )
371                CALL get_option_argument( i, arg )
372                READ(arg, *) cfg % averaging_angle
373
374             CASE( '-static', '-t', '--static-driver' )
375                CALL get_option_argument( i, arg )
376                cfg % static_driver_file = TRIM(arg)
377
378             CASE( '-soil', '-s', '--soil-file')
379                CALL get_option_argument( i, arg )
380                cfg % soiltyp_file = TRIM(arg)
381
382             CASE( '--flow-prefix')
383                CALL get_option_argument( i, arg )
384                cfg % flow_prefix = TRIM(arg)
385                cfg % flow_prefix_is_set = .TRUE.
386   
387             CASE( '--radiation-prefix')
388                CALL get_option_argument( i, arg )
389                cfg % radiation_prefix = TRIM(arg)
390                cfg % radiation_prefix_is_set = .TRUE.
391   
392             CASE( '--soil-prefix')
393                CALL get_option_argument( i, arg )
394                cfg % soil_prefix = TRIM(arg)
395                cfg % soil_prefix_is_set = .TRUE.
396   
397             CASE( '--soilmoisture-prefix')
398                CALL get_option_argument( i, arg )
399                cfg % soilmoisture_prefix = TRIM(arg)
400                cfg % soilmoisture_prefix_is_set = .TRUE.
401
402             CASE( '-o', '--output' )
403                CALL get_option_argument( i, arg )
404                cfg % output_file = TRIM(arg)
405
406             CASE( '-n', '--namelist' )
407                CALL get_option_argument( i, arg )
408                cfg % namelist_file = TRIM(arg)
409
410             ! initial condition mode: 'profile' / 'volume'
411             CASE( '-mode', '-i', '--init-mode' )
412                CALL get_option_argument( i, arg )
413                cfg % ic_mode = TRIM(arg)
414
415             ! boundary conditions / forcing mode: 'ideal' / 'real'
416             CASE( '-f', '--forcing-mode' )
417                CALL get_option_argument( i, arg )
418                cfg % bc_mode = TRIM(arg)
419
420             CASE( '--version' )
421                CALL print_version()
422                STOP
423
424             CASE( '--help' )
425                CALL print_version()
426                PRINT *, ""
427                PRINT *, "For a list of command-line options have a look at the README file."
428                STOP
429
430             CASE DEFAULT
431                message = "unknown option '" // TRIM(option) // "'."
432                CALL abort('parse_command_line_arguments', message)
433
434             END SELECT
435
436             i = i + 1
437
438          END DO
439
440       ELSE
441           
442          message = "No arguments present, using default input and output files"
443          CALL report('parse_command_line_arguments', message)
444
445       END IF
446
447   END SUBROUTINE parse_command_line_arguments
448
449   
450   SUBROUTINE get_option_argument(i, arg)
451      CHARACTER(LEN=PATH), INTENT(INOUT) ::  arg
452      INTEGER, INTENT(INOUT)             ::  i
453
454      i = i + 1
455      CALL GET_COMMAND_ARGUMENT(i, arg)
456
457   END SUBROUTINE
458
459
460   SUBROUTINE validate_config(cfg)
461      TYPE(inifor_config), INTENT(IN) ::  cfg
462      LOGICAL                         ::  all_files_present
463
464      all_files_present = .TRUE.
465      all_files_present = all_files_present .AND. file_present(cfg % hhl_file, 'HHL')
466      all_files_present = all_files_present .AND. file_present(cfg % namelist_file, 'NAMELIST')
467      all_files_present = all_files_present .AND. file_present(cfg % soiltyp_file, 'SOILTYP')
468
469      ! Only check optional static driver file name, if it has been given.
470      IF (TRIM(cfg % static_driver_file) .NE. '')  THEN
471         all_files_present = all_files_present .AND. file_present(cfg % static_driver_file, 'static driver')
472      END IF
473
474      IF (.NOT. all_files_present)  THEN
475         message = "INIFOR configuration invalid; some input files are missing."
476         CALL abort( 'validate_config', message ) 
477      END IF
478     
479     
480      SELECT CASE( TRIM(cfg % ic_mode) )
481      CASE( 'profile', 'volume')
482      CASE DEFAULT
483         message = "Initialization mode '" // TRIM(cfg % ic_mode) //&
484                   "' is not supported. " //&
485                   "Please select either 'profile' or 'volume', " //&
486                   "or omit the -i/--init-mode/-mode option entirely, which corresponds "//&
487                   "to the latter."
488         CALL abort( 'validate_config', message ) 
489      END SELECT
490
491
492      SELECT CASE( TRIM(cfg % bc_mode) )
493      CASE( 'real', 'ideal')
494      CASE DEFAULT
495         message = "Forcing mode '" // TRIM(cfg % bc_mode) //& 
496                   "' is not supported. " //&
497                   "Please select either 'real' or 'ideal', " //&
498                   "or omit the -f/--forcing-mode option entirely, which corresponds "//&
499                   "to the latter."
500         CALL abort( 'validate_config', message ) 
501      END SELECT
502
503      SELECT CASE( TRIM(cfg % averaging_mode) )
504      CASE( 'level', 'height')
505      CASE DEFAULT
506         message = "Averaging mode '" // TRIM(cfg % averaging_mode) //&
507                   "' is not supported. " //&
508                   "Please select either 'height' or 'level', " //&
509                   "or omit the --averaging-mode option entirely, which corresponds "//&
510                   "to the latter."
511         CALL abort( 'validate_config', message ) 
512      END SELECT
513
514      IF ( cfg % ug_is_set .NEQV. cfg % vg_is_set )  THEN
515         message = "You specified only one component of the geostrophic " // &
516                   "wind. Please specify either both or none."
517         CALL abort( 'validate_config', message )
518      END IF
519
520   END SUBROUTINE validate_config
521
522
523   LOGICAL FUNCTION file_present(filename, kind)
524      CHARACTER(LEN=PATH), INTENT(IN) ::  filename
525      CHARACTER(LEN=*), INTENT(IN)    ::  kind
526
527      IF (LEN(TRIM(filename))==0)  THEN
528
529         file_present = .FALSE.
530         message = "No name was given for the " // TRIM(kind) // " file."
531         CALL report('file_present', message)
532
533      ELSE
534
535         INQUIRE(FILE=filename, EXIST=file_present)
536
537         IF (.NOT. file_present)  THEN
538            message = "The given " // TRIM(kind) // " file '" //               &
539                      TRIM(filename) // "' does not exist."
540            CALL report('file_present', message)
541         END IF
542
543      END IF
544
545   END FUNCTION file_present
546
547
548!------------------------------------------------------------------------------!
549! Description:
550! ------------
551!> This routine initializes the Inifor output file, i.e. the PALM-4U
552!> initializing and forcing data as a NetCDF file.
553!>
554!> Besides writing metadata, such as global attributes, coordinates, variables,
555!> in the NetCDF file, various NetCDF IDs are saved for later, when Inifor
556!> writes the actual data.
557!------------------------------------------------------------------------------!
558   SUBROUTINE setup_netcdf_dimensions(output_file, palm_grid,                  &
559                                      start_date_string, origin_lon, origin_lat)
560
561       TYPE(nc_file), INTENT(INOUT)      ::  output_file
562       TYPE(grid_definition), INTENT(IN) ::  palm_grid
563       CHARACTER (LEN=DATE), INTENT(IN)  ::  start_date_string
564       REAL(dp), INTENT(IN)              ::  origin_lon, origin_lat
565
566       CHARACTER (LEN=8)     ::  date_string
567       CHARACTER (LEN=10)    ::  time_string
568       CHARACTER (LEN=5)     ::  zone_string
569       CHARACTER (LEN=SNAME) ::  history_string
570       INTEGER               ::  ncid, nx, ny, nz, nt, dimids(3), dimvarids(3)
571       REAL(dp)              ::  z0
572
573       message = "Initializing PALM-4U dynamic driver file '" //               &
574                 TRIM(output_file % name) // "' and setting up dimensions."
575       CALL report('setup_netcdf_dimensions', message)
576
577       ! Create the NetCDF file. NF90_CLOBBER selects overwrite mode.
578#if defined( __netcdf4 )
579       CALL check(nf90_create(TRIM(output_file % name), OR(NF90_CLOBBER, NF90_HDF5), ncid))
580#else
581       CALL check(nf90_create(TRIM(output_file % name), NF90_CLOBBER, ncid))
582#endif
583
584!------------------------------------------------------------------------------
585!- Section 1: Define NetCDF dimensions and coordinates
586!------------------------------------------------------------------------------
587       nt = SIZE(output_file % time)
588       nx = palm_grid % nx
589       ny = palm_grid % ny
590       nz = palm_grid % nz
591       z0 = palm_grid % z0
592
593
594!
595!------------------------------------------------------------------------------
596!- Section 2: Write global NetCDF attributes
597!------------------------------------------------------------------------------
598       CALL date_and_time(DATE=date_string, TIME=time_string, ZONE=zone_string)
599       history_string =                                                        &
600           'Created on '// date_string      //                                 &
601           ' at '       // time_string(1:2) // ':' // time_string(3:4) //      &
602           ' (UTC'      // zone_string // ')'
603
604       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'title',          'PALM input file for scenario ...'))
605       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'institution',    'Deutscher Wetterdienst, Offenbach'))
606       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'author',         'Eckhard Kadasch, eckhard.kadasch@dwd.de'))
607       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'history',        TRIM(history_string)))
608       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'references',     '--'))
609       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'comment',        '--'))
610       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_lat',     TRIM(real_to_str(origin_lat*TO_DEGREES, '(F18.13)'))))
611       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_lon',     TRIM(real_to_str(origin_lon*TO_DEGREES, '(F18.13)'))))
612       ! FIXME: This is the elevation relative to COSMO-DE/D2 sea level and does
613       ! FIXME: not necessarily comply with DHHN2016 (c.f. PALM Input Data
614       ! FIXME: Standard v1.9., origin_z)
615       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'origin_z',       TRIM(real_to_str(z0, '(F18.13)'))))
616       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'inifor_version', TRIM(VERSION)))
617       CALL check(nf90_put_att(ncid, NF90_GLOBAL, 'palm_version',   '--'))
618
619!
620!
621!------------------------------------------------------------------------------
622!- Section 2a: Define dimensions for cell centers (scalars in soil and atmosph.)
623!------------------------------------------------------------------------------
624       dimids = (/0, 0, 0/) ! reset dimids
625          CALL check( nf90_def_dim(ncid, "x", nx+1, dimids(1)) )
626          CALL check( nf90_def_dim(ncid, "y", ny+1, dimids(2)) )
627          CALL check( nf90_def_dim(ncid, "z", nz, dimids(3)) )
628          output_file % dimids_scl = dimids ! save dimids for later
629
630       dimvarids = (/0, 0, 0/) ! reset dimvarids
631          CALL check(nf90_def_var(ncid, "x", NF90_FLOAT, dimids(1), dimvarids(1)))
632          CALL check(nf90_put_att(ncid, dimvarids(1), "standard_name", "x coordinate of cell centers"))
633          CALL check(nf90_put_att(ncid, dimvarids(1), "units", "m"))
634
635          CALL check(nf90_def_var(ncid, "y", NF90_FLOAT, dimids(2), dimvarids(2)))
636          CALL check(nf90_put_att(ncid, dimvarids(2), "standard_name", "y coordinate of cell centers"))
637          CALL check(nf90_put_att(ncid, dimvarids(2), "units", "m"))
638
639          CALL check(nf90_def_var(ncid, "z", NF90_FLOAT, dimids(3), dimvarids(3)))
640          CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "z coordinate of cell centers"))
641          CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
642       output_file % dimvarids_scl = dimvarids ! save dimvarids for later
643
644       ! overwrite third dimid with the one of depth
645       CALL check(nf90_def_dim(ncid, "zsoil", SIZE(palm_grid % depths), dimids(3)) )
646       output_file % dimids_soil = dimids ! save dimids for later
647
648       ! overwrite third dimvarid with the one of depth
649       CALL check(nf90_def_var(ncid, "zsoil", NF90_FLOAT, output_file % dimids_soil(3), dimvarids(3)))
650       CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "depth_below_land"))
651       CALL check(nf90_put_att(ncid, dimvarids(3), "positive", "down"))
652       CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
653       output_file % dimvarids_soil = dimvarids ! save dimvarids for later
654!
655!------------------------------------------------------------------------------
656!- Section 2b: Define dimensions for cell faces/velocities
657!------------------------------------------------------------------------------
658       dimids = (/0, 0, 0/) ! reset dimids
659          CALL check(nf90_def_dim(ncid, "xu", nx, dimids(1)) )
660          CALL check(nf90_def_dim(ncid, "yv", ny, dimids(2)) )
661          CALL check(nf90_def_dim(ncid, "zw", nz-1, dimids(3)) )
662       output_file % dimids_vel = dimids ! save dimids for later
663
664       dimvarids = (/0, 0, 0/) ! reset dimvarids
665          CALL check(nf90_def_var(ncid, "xu", NF90_FLOAT, dimids(1), dimvarids(1)))
666          CALL check(nf90_put_att(ncid, dimvarids(1), "standard_name", "x coordinate of cell faces"))
667          CALL check(nf90_put_att(ncid, dimvarids(1), "units", "m"))
668
669          CALL check(nf90_def_var(ncid, "yv", NF90_FLOAT, dimids(2), dimvarids(2)))
670          CALL check(nf90_put_att(ncid, dimvarids(2), "standard_name", "y coordinate of cell faces"))
671          CALL check(nf90_put_att(ncid, dimvarids(2), "units", "m"))
672
673          CALL check(nf90_def_var(ncid, "zw", NF90_FLOAT, dimids(3), dimvarids(3)))
674          CALL check(nf90_put_att(ncid, dimvarids(3), "standard_name", "z coordinate of cell faces"))
675          CALL check(nf90_put_att(ncid, dimvarids(3), "units", "m"))
676       output_file % dimvarids_vel = dimvarids ! save dimvarids for later
677
678!
679!------------------------------------------------------------------------------
680!- Section 2c: Define time dimension
681!------------------------------------------------------------------------------
682       CALL check(nf90_def_dim(ncid, "time", nt, output_file % dimid_time) )
683       CALL check(nf90_def_var(ncid, "time", NF90_FLOAT, &
684                                             output_file % dimid_time, &
685                                             output_file % dimvarid_time))
686       CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "standard_name", "time"))
687       CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "long_name", "time"))
688       CALL check(nf90_put_att(ncid, output_file % dimvarid_time, "units",     &
689                               "seconds since " // start_date_string // " UTC"))
690
691       CALL check(nf90_enddef(ncid))
692
693!
694!------------------------------------------------------------------------------
695!- Section 3: Write grid coordinates
696!------------------------------------------------------------------------------
697       CALL check(nf90_put_var(ncid, output_file % dimvarids_scl(1), palm_grid%x))
698       CALL check(nf90_put_var(ncid, output_file % dimvarids_scl(2), palm_grid%y))
699       CALL check(nf90_put_var(ncid, output_file % dimvarids_scl(3), palm_grid%z))
700
701       CALL check(nf90_put_var(ncid, output_file % dimvarids_vel(1), palm_grid%xu))
702       CALL check(nf90_put_var(ncid, output_file % dimvarids_vel(2), palm_grid%yv))
703       CALL check(nf90_put_var(ncid, output_file % dimvarids_vel(3), palm_grid%zw))
704
705       ! TODO Read in soil depths from input file before this.
706       CALL check(nf90_put_var(ncid, output_file % dimvarids_soil(3), palm_grid%depths))
707
708       ! Write time vector
709       CALL check(nf90_put_var(ncid, output_file % dimvarid_time, output_file % time))
710
711       ! Close the file
712       CALL check(nf90_close(ncid))
713
714    END SUBROUTINE setup_netcdf_dimensions
715
716
717    SUBROUTINE setup_netcdf_variables(filename, output_variable_table, debug)
718
719       CHARACTER (LEN=*), INTENT(IN)        ::  filename
720       TYPE(nc_var), INTENT(INOUT), TARGET  ::  output_variable_table(:)
721       LOGICAL, INTENT(IN)                  ::  debug
722
723       TYPE(nc_var), POINTER                ::  var
724       INTEGER                              ::  i, ncid
725       LOGICAL                              ::  to_be_written
726
727       message = "Defining variables in dynamic driver '" // TRIM(filename) // "'."
728       CALL report('setup_netcdf_variables', message)
729
730       CALL check(nf90_open(TRIM(filename), NF90_WRITE, ncid))
731       CALL check(nf90_redef(ncid))
732
733       DO i = 1, SIZE(output_variable_table)
734
735          var => output_variable_table(i)
736
737          to_be_written = ( var % to_be_processed  .AND. .NOT. var % is_internal) .OR.                        &
738                          ( var % is_internal  .AND.  debug )
739
740          IF ( to_be_written )  THEN
741             message = "  variable #" // TRIM(str(i)) // " '" // TRIM(var%name) // "'."
742             CALL report('setup_netcdf_variables', message)
743
744             CALL netcdf_define_variable(var, ncid)
745             CALL netcdf_get_dimensions(var, ncid)
746          END IF
747           
748       END DO
749
750       CALL check(nf90_enddef(ncid))
751       CALL check(nf90_close(ncid))
752
753       message = "Dynamic driver '" // TRIM(filename) // "' initialized successfully."
754       CALL report('setup_netcdf_variables', message)
755
756    END SUBROUTINE setup_netcdf_variables
757
758
759!------------------------------------------------------------------------------!
760! Description:
761! ------------
762!> This routine reads and returns all input variables of the given IO group
763!> It accomodates the data by allocating a container variable that represents a
764!> list of arrays of the same length as the groups variable list. (This list
765!> will typically contain one or two items.) After the container, its members
766!> are allocated one by one with the appropriate, possibly different,
767!> dimensions.
768!>
769!> The 'group' is an INTENT(INOUT) variable so that 'get_netcdf_variable()' can
770!> record netCDF IDs in the 'in_var_list()' member variable.
771!------------------------------------------------------------------------------!
772    SUBROUTINE read_input_variables(group, iter, buffer)
773       TYPE(io_group), INTENT(INOUT), TARGET       ::  group
774       INTEGER, INTENT(IN)                         ::  iter
775       TYPE(container), ALLOCATABLE, INTENT(INOUT) ::  buffer(:)
776       INTEGER                                     ::  hour, buf_id
777       TYPE(nc_var), POINTER                       ::  input_var
778       CHARACTER(LEN=PATH), POINTER                ::  input_file
779       INTEGER                                     ::  ivar, nbuffers
780
781       message = "Reading data for I/O group '" // TRIM(group % in_var_list(1) % name) // "'."
782       CALL report('read_input_variables', message)
783
784       input_file => group % in_files(iter)
785
786!
787!------------------------------------------------------------------------------
788!- Section 1: Load input buffers for accumulated variables
789!------------------------------------------------------------------------------
790       IF (group % kind == 'running average' .OR.                              &
791           group % kind == 'accumulated')  THEN ! radiation budgets, precipitation
792
793          IF (SIZE(group % in_var_list) .GT. 1 ) THEN
794             message = "I/O groups may not contain more than one " // & 
795                       "accumulated variable. Group '" // TRIM(group % kind) //&
796                       "' contains " //                                        &
797                       TRIM( str(SIZE(group % in_var_list)) ) // "."
798             CALL abort('read_input_variables | accumulation', message)
799          END IF
800
801          ! use two buffer arrays
802          nbuffers = 2
803          IF ( .NOT. ALLOCATED( buffer ) )  ALLOCATE( buffer(nbuffers) )
804
805          ! chose correct buffer array
806          hour = iter - 1! hour of the day
807          buf_id = select_buffer(hour)
808
809 CALL run_control('time', 'read')
810          IF ( ALLOCATED(buffer(buf_id) % array) )  DEALLOCATE(buffer(buf_id) % array)
811 CALL run_control('time', 'alloc')
812
813          input_var => group % in_var_list(1)
814          CALL get_netcdf_variable(input_file, input_var, buffer(buf_id) % array)
815          CALL report('read_input_variables', "Read accumulated " // TRIM(group % in_var_list(1) % name)) 
816
817          IF ( input_var % is_upside_down )  CALL reverse(buffer(buf_id) % array)
818 CALL run_control('time', 'comp')
819         
820!------------------------------------------------------------------------------
821!- Section 2: Load input buffers for normal I/O groups
822!------------------------------------------------------------------------------
823       ELSE
824
825          ! Allocate one input buffer per input_variable. If more quantities
826          ! have to be computed than input variables exist in this group,
827          ! allocate more buffers. For instance, in the thermodynamics group,
828          ! there are three input variabels (PP, T, Qv) and four quantities
829          ! necessart (P, Theta, Rho, qv) for the corresponding output fields
830          ! (p0, Theta, qv, ug, and vg)
831          nbuffers = MAX( group % n_inputs, group % n_output_quantities )
832          ALLOCATE( buffer(nbuffers) )
833 CALL run_control('time', 'alloc')
834         
835          ! Read in all input variables, leave extra buffers-if any-untouched.
836          DO ivar = 1, group % n_inputs
837
838             input_var => group % in_var_list(ivar)
839
840             ! Check wheather P or PP is present in input file
841             IF (input_var % name == 'P')  THEN
842                input_var % name = TRIM( get_pressure_varname(input_file) )
843 CALL run_control('time', 'read')
844             END IF
845
846             CALL get_netcdf_variable(input_file, input_var, buffer(ivar) % array)
847
848             IF ( input_var % is_upside_down )  CALL reverse(buffer(ivar) % array)
849 CALL run_control('time', 'comp')
850
851          END DO
852       END IF
853
854    END SUBROUTINE read_input_variables
855
856
857    INTEGER FUNCTION select_buffer(hour)
858       INTEGER, INTENT(IN) ::  hour
859       INTEGER             ::  step
860
861       select_buffer = 0
862       step = MODULO(hour, 3) + 1
863
864       SELECT CASE(step)
865       CASE(1, 3)
866           select_buffer = 1
867       CASE(2)
868           select_buffer = 2
869       CASE DEFAULT
870           message = "Invalid step '" // TRIM(str(step))
871           CALL abort('select_buffer', message)
872       END SELECT
873    END FUNCTION select_buffer
874
875
876!------------------------------------------------------------------------------!
877! Description:
878! ------------
879!> Checks if the input_file contains the absolute pressure, 'P', or the pressure
880!> perturbation, 'PP', and returns the appropriate string.
881!------------------------------------------------------------------------------!
882    CHARACTER(LEN=2) FUNCTION get_pressure_varname(input_file) RESULT(var)
883       CHARACTER(LEN=*) ::  input_file
884       INTEGER          ::  ncid, varid
885
886       CALL check(nf90_open( TRIM(input_file), NF90_NOWRITE, ncid ))
887       IF ( nf90_inq_varid( ncid, 'P', varid ) .EQ. NF90_NOERR )  THEN
888
889          var = 'P'
890
891       ELSE IF ( nf90_inq_varid( ncid, 'PP', varid ) .EQ. NF90_NOERR )  THEN
892
893          var = 'PP'
894          CALL report('get_pressure_var', 'Using PP instead of P')
895
896       ELSE
897
898          message = "Failed to read '" // TRIM(var) // &
899                    "' from file '" // TRIM(input_file) // "'."
900          CALL abort('get_pressure_var', message)
901
902       END IF
903
904       CALL check(nf90_close(ncid))
905
906    END FUNCTION get_pressure_varname
907
908
909    FUNCTION get_netcdf_attribute(filename, attribute) RESULT(attribute_value)
910
911       CHARACTER(LEN=*), INTENT(IN) ::  filename, attribute
912       REAL(dp)                     ::  attribute_value
913
914       INTEGER                      :: ncid
915
916       IF ( nf90_open( TRIM(filename), NF90_NOWRITE, ncid ) == NF90_NOERR )  THEN
917
918          CALL check(nf90_get_att(ncid, NF90_GLOBAL, TRIM(attribute), attribute_value))
919          CALL check(nf90_close(ncid))
920
921       ELSE
922
923          message = "Failed to read '" // TRIM(attribute) // &
924                    "' from file '" // TRIM(filename) // "'."
925          CALL abort('get_netcdf_attribute', message)
926
927       END IF
928
929    END FUNCTION get_netcdf_attribute
930
931
932    SUBROUTINE update_output(var, array, iter, output_file, cfg)
933       TYPE(nc_var), INTENT(IN)  ::  var
934       REAL(dp), INTENT(IN)      ::  array(:,:,:)
935       INTEGER, INTENT(IN)       ::  iter
936       TYPE(nc_file), INTENT(IN) ::  output_file
937       TYPE(inifor_config)       ::  cfg
938
939       INTEGER ::  ncid, ndim, start(4), count(4)
940       LOGICAL ::  var_is_time_dependent
941
942       var_is_time_dependent = (                                               &
943          var % dimids( var % ndim ) == output_file % dimid_time               &
944       )
945
946       ! Skip time dimension for output
947       ndim = var % ndim
948       IF ( var_is_time_dependent )  ndim = var % ndim - 1
949
950       start(:)      = (/1,1,1,1/)
951       start(ndim+1) = iter
952       count(1:ndim) = var%dimlen(1:ndim)
953
954       CALL check(nf90_open(output_file % name, NF90_WRITE, ncid))
955
956       ! Reduce dimension of output array according to variable kind
957       SELECT CASE (TRIM(var % kind))
958       
959       CASE ( 'init scalar profile', 'init u profile', 'init v profile',       &
960              'init w profile' )
961
962          CALL check(nf90_put_var( ncid, var%varid, array(1,1,:) ) )
963
964       CASE ( 'init soil', 'init scalar', 'init u', 'init v', 'init w' )
965
966          CALL check(nf90_put_var( ncid, var%varid, array(:,:,:) ) )
967
968       CASE( 'left scalar', 'right scalar', 'left w', 'right w' ) 
969
970          CALL check(nf90_put_var( ncid, var%varid, array(1,:,:),              &
971                                   start=start(1:ndim+1),                      &
972                                   count=count(1:ndim) ) )
973         
974
975          IF (.NOT. SIZE(array, 2) .EQ. var % dimlen(1))  THEN
976             PRINT *, "inifor: update_output: Dimension ", 1, " of variable ", &
977                 TRIM(var % name), " (", var % dimlen(1),                      &
978                 ") does not match the dimension of the output array (",       &
979                 SIZE(array, 2), ")."
980             STOP
981          END IF
982         
983
984       CASE( 'north scalar', 'south scalar', 'north w', 'south w' )
985
986          CALL check(nf90_put_var( ncid, var%varid, array(:,1,:),              &
987                                   start=start(1:ndim+1),                      &
988                                   count=count(1:ndim) ) )
989         
990
991       CASE( 'surface forcing', 'top scalar', 'top w' )
992
993          CALL check(nf90_put_var( ncid, var%varid, array(:,:,1),              &
994                                   start=start(1:ndim+1),                      &
995                                   count=count(1:ndim) ) )
996         
997       CASE ( 'left u', 'right u', 'left v', 'right v' )
998
999          CALL check(nf90_put_var( ncid, var%varid, array(1,:,:),              &
1000                                   start=start(1:ndim+1),                      &
1001                                   count=count(1:ndim) ) )
1002
1003       CASE ( 'north u', 'south u', 'north v', 'south v' )
1004
1005          CALL check(nf90_put_var( ncid, var%varid, array(:,1,:),              &
1006                                   start=start(1:ndim+1),                      &
1007                                   count=count(1:ndim) ) )
1008
1009       CASE ( 'top u', 'top v' )
1010
1011          CALL check(nf90_put_var( ncid, var%varid, array(:,:,1),              &
1012                                   start=start(1:ndim+1),                      &
1013                                   count=count(1:ndim) ) )
1014
1015       CASE ( 'time series' )
1016
1017          CALL check(nf90_put_var( ncid, var%varid, array(1,1,1),              &
1018                                   start=start(1:ndim+1) ) )
1019
1020       CASE ( 'constant scalar profile', 'geostrophic' )
1021
1022          CALL check(nf90_put_var( ncid, var%varid, array(1,1,:),              &
1023                                   start=start(1:ndim+1),                      &
1024                                   count=count(1:ndim) ) )
1025
1026       CASE ( 'internal profile' )
1027
1028          IF ( cfg % debug )  THEN
1029             CALL check(nf90_put_var( ncid, var%varid, array(1,1,:),           &
1030                                      start=start(1:ndim+1),                   &
1031                                      count=count(1:ndim) ) )
1032          END IF
1033
1034       CASE ( 'large-scale scalar forcing', 'large-scale w forcing' )
1035
1036           message = "Doing nothing in terms of writing large-scale forings."
1037           CALL report('update_output', message)
1038
1039       CASE DEFAULT
1040
1041           message = "Variable kind '" // TRIM(var % kind) //                  &
1042                    "' not recognized."
1043           CALL abort('update_output', message)
1044
1045       END SELECT
1046
1047       CALL check(nf90_close(ncid))
1048
1049    END SUBROUTINE update_output
1050
1051
1052    SUBROUTINE write_netcdf_variable_2d(var, iter, output_file, buffer)
1053       TYPE(nc_var), INTENT(IN)          ::  var
1054       INTEGER, INTENT(IN)               ::  iter
1055       TYPE(nc_file), INTENT(IN)         ::  output_file
1056       REAL(dp), INTENT(IN)              ::  buffer(:,:,:)
1057
1058       INTEGER ::  ncid, ndim_out, start(4), count(4)
1059       LOGICAL ::  last_dimension_is_time
1060
1061       ndim_out = var % ndim
1062
1063       last_dimension_is_time = var % dimids( var % ndim ) == output_file % dimid_time
1064       IF ( last_dimension_is_time )  THEN
1065          ndim_out = ndim_out - 1
1066       END IF
1067
1068       start(:)      = (/1,1,1,iter/)
1069       count(1:ndim_out) = var%dimlen(1:ndim_out)
1070
1071       CALL check(nf90_open(output_file % name, NF90_WRITE, ncid))
1072
1073       IF (TRIM(var % kind) .EQ. 'left/right scalar')  THEN
1074
1075          CALL check(nf90_put_var( ncid, var%varid, buffer(1,:,:) ) )
1076
1077       ELSE IF (TRIM(var % kind) .EQ. 'north/south scalar')  THEN
1078
1079          CALL check(nf90_put_var( ncid, var%varid, buffer(:,1,:) ) )
1080
1081       ELSE IF (TRIM(var % kind) .EQ. 'top scalar')  THEN
1082
1083          CALL check(nf90_put_var( ncid, var%varid, buffer(:,:,1) ) )
1084       ELSE
1085
1086          CALL check(nf90_put_var( ncid, var%varid, buffer ) )
1087
1088       END IF
1089       CALL check(nf90_close(ncid))
1090
1091    END SUBROUTINE write_netcdf_variable_2d
1092
1093
1094    SUBROUTINE check(status)
1095
1096       INTEGER, INTENT(IN) ::  status
1097
1098       IF (status /= nf90_noerr)  THEN
1099          message = "NetCDF API call failed with error: " //                     &
1100                    TRIM( nf90_strerror(status) )
1101          CALL abort('io.check', message) 
1102       END IF
1103
1104    END SUBROUTINE check
1105
1106 END MODULE io
Note: See TracBrowser for help on using the repository browser.