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

Last change on this file since 3779 was 3779, checked in by eckhard, 3 years ago

inifor: bugfix: Fixes issue #815 with geostrophic wind profiles

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