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

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

inifor: bugfix: avoid empty averaging regions, check if all input files are present

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