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

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

inifor: Prefixed all INIFOR modules with inifor_ and removed unused variables

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