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

Last change on this file since 3615 was 3615, checked in by raasch, 3 years ago

bugfix for last commit: abort replaced by inifor_abort

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