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

Last change on this file since 3570 was 3557, checked in by eckhard, 6 years ago

inifor: Updated documentation

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