source: palm/trunk/SOURCE/data_output_netcdf4_module.f90 @ 4690

Last change on this file since 4690 was 4629, checked in by raasch, 4 years ago

support for MPI Fortran77 interface (mpif.h) removed

  • Property svn:keywords set to Id
File size: 50.2 KB
Line 
1!> @file data_output_netcdf4_module.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 terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 2019-2020 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! ------------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: data_output_netcdf4_module.f90 4629 2020-07-29 09:37:56Z suehring $
26! support for MPI Fortran77 interface (mpif.h) removed
27!
28! 4599 2020-07-10 12:42:02Z gronemeier
29! bugfix: set no-fill mode per variable
30!
31! 4597 2020-07-09 19:21:53Z gronemeier
32! bugfix: - allow writing of unlimited dimensions in parallel mode
33!         - prevent unused-variable warning if preprocessor directives are not given
34! change: - set parallel access mode to independent per default
35! new   : - dimension variables can be written by every PE
36!
37! 4579 2020-06-25 20:05:07Z gronemeier
38! corrected formatting to follow PALM coding standard
39!
40! 4577 2020-06-25 09:53:58Z raasch
41! file re-formatted to follow the PALM coding standard
42!
43! 4481 2020-03-31 18:55:54Z maronga
44! bugfix: cpp-directive moved to avoid compile error due to unused dummy argument
45!
46! 4408 2020-02-14 10:04:39Z gronemeier
47! Enable character-array output
48!
49! 4232 2019-09-20 09:34:22Z knoop
50! Bugfix: INCLUDE "mpif.h" must be placed after IMPLICIT NONE statement
51!
52! 4147 2019-08-07 09:42:31Z gronemeier
53! corrected indentation according to coding standard
54!
55! 4141 2019-08-05 12:24:51Z gronemeier
56! Initial revision
57!
58!
59! Authors:
60! --------
61!> @author: Tobias Gronemeier
62!
63! Description:
64! ------------
65!> NetCDF output module to write data to NetCDF files.
66!> This is either done in parallel mode via parallel NetCDF4 I/O or in serial mode only by PE0.
67!>
68!> @bug 'mode' is not always checked. If a routine is called with an unknown mode (e.g. a typo),
69!>      this does not throw any error.
70!--------------------------------------------------------------------------------------------------!
71 MODULE data_output_netcdf4_module
72
73    USE kinds
74
75#if defined( __parallel )
76    USE MPI
77#endif
78
79#if defined( __netcdf4 )
80    USE NETCDF
81#endif
82
83    IMPLICIT NONE
84
85
86    CHARACTER(LEN=*), PARAMETER ::  mode_parallel = 'parallel'  !< string selecting netcdf4 parallel mode
87    CHARACTER(LEN=*), PARAMETER ::  mode_serial   = 'serial'    !< string selecting netcdf4 serial mode
88
89    CHARACTER(LEN=100) ::  file_suffix = ''             !< file suffix added to each file name
90    CHARACTER(LEN=800) ::  internal_error_message = ''  !< string containing the last error message
91    CHARACTER(LEN=800) ::  temp_string                  !< dummy string
92
93    INTEGER ::  debug_output_unit       !< Fortran Unit Number of the debug-output file
94    INTEGER ::  global_id_in_file = -1  !< value of global ID within a file
95    INTEGER ::  master_rank             !< master rank for tasks to be executed by single PE only
96    INTEGER ::  my_rank                 !< MPI rank of processor
97    INTEGER ::  output_group_comm       !< MPI communicator addressing all MPI ranks which participate in output
98
99    LOGICAL ::  print_debug_output = .FALSE.  !< if true, debug output is printed
100
101    SAVE
102
103    PRIVATE
104
105    INTERFACE netcdf4_init_module
106       MODULE PROCEDURE netcdf4_init_module
107    END INTERFACE netcdf4_init_module
108
109    INTERFACE netcdf4_open_file
110       MODULE PROCEDURE netcdf4_open_file
111    END INTERFACE netcdf4_open_file
112
113    INTERFACE netcdf4_init_dimension
114       MODULE PROCEDURE netcdf4_init_dimension
115    END INTERFACE netcdf4_init_dimension
116
117    INTERFACE netcdf4_init_variable
118       MODULE PROCEDURE netcdf4_init_variable
119    END INTERFACE netcdf4_init_variable
120
121    INTERFACE netcdf4_write_attribute
122       MODULE PROCEDURE netcdf4_write_attribute
123    END INTERFACE netcdf4_write_attribute
124
125    INTERFACE netcdf4_stop_file_header_definition
126       MODULE PROCEDURE netcdf4_stop_file_header_definition
127    END INTERFACE netcdf4_stop_file_header_definition
128
129    INTERFACE netcdf4_write_variable
130       MODULE PROCEDURE netcdf4_write_variable
131    END INTERFACE netcdf4_write_variable
132
133    INTERFACE netcdf4_finalize
134       MODULE PROCEDURE netcdf4_finalize
135    END INTERFACE netcdf4_finalize
136
137    INTERFACE netcdf4_get_error_message
138       MODULE PROCEDURE netcdf4_get_error_message
139    END INTERFACE netcdf4_get_error_message
140
141    PUBLIC                                                                                         &
142       netcdf4_finalize,                                                                           &
143       netcdf4_get_error_message,                                                                  &
144       netcdf4_init_dimension,                                                                     &
145       netcdf4_init_module,                                                                        &
146       netcdf4_init_variable,                                                                      &
147       netcdf4_open_file,                                                                          &
148       netcdf4_stop_file_header_definition,                                                        &
149       netcdf4_write_attribute,                                                                    &
150       netcdf4_write_variable
151
152
153 CONTAINS
154
155
156!--------------------------------------------------------------------------------------------------!
157! Description:
158! ------------
159!> Initialize data-output module.
160!--------------------------------------------------------------------------------------------------!
161 SUBROUTINE netcdf4_init_module( file_suffix_of_output_group, mpi_comm_of_output_group,            &
162                                 master_output_rank,                                               &
163                                 program_debug_output_unit, debug_output, dom_global_id )
164
165    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_module'  !< name of this routine
166
167    CHARACTER(LEN=*), INTENT(IN) ::  file_suffix_of_output_group  !> file-name suffix added to each file;
168                                                                  !> must be unique for each output group
169
170    INTEGER, INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
171    INTEGER, INTENT(IN) ::  master_output_rank         !< MPI rank executing tasks which must be executed by a single PE
172    INTEGER, INTENT(IN) ::  mpi_comm_of_output_group   !< MPI communicator specifying the rank group participating in output
173    INTEGER, INTENT(IN) ::  program_debug_output_unit  !< file unit number for debug output
174    INTEGER             ::  return_value               !< return value
175
176    LOGICAL, INTENT(IN) ::  debug_output  !< if true, debug output is printed
177
178
179    file_suffix = file_suffix_of_output_group
180    output_group_comm = mpi_comm_of_output_group
181    master_rank = master_output_rank
182
183#if defined( __parallel )
184    CALL MPI_COMM_RANK( output_group_comm, my_rank, return_value )
185    IF ( return_value /= 0 )  THEN
186       CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
187    ENDIF
188#else
189    my_rank = master_rank
190    return_value = 0
191!
192!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
193    IF ( .FALSE. )  CALL internal_message( 'debug', routine_name // ': dummy message' )
194#endif
195
196    debug_output_unit = program_debug_output_unit
197    print_debug_output = debug_output
198
199    global_id_in_file = dom_global_id
200
201 END SUBROUTINE netcdf4_init_module
202
203!--------------------------------------------------------------------------------------------------!
204! Description:
205! ------------
206!> Open netcdf file.
207!--------------------------------------------------------------------------------------------------!
208 SUBROUTINE netcdf4_open_file( mode, file_name, file_id, return_value )
209
210    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_open_file'  !< name of this routine
211
212    CHARACTER(LEN=*), INTENT(IN) ::  file_name  !< name of file
213    CHARACTER(LEN=*), INTENT(IN) ::  mode       !< operation mode (either parallel or serial)
214
215    INTEGER, INTENT(OUT) ::  file_id       !< file ID
216    INTEGER              ::  nc_stat       !< netcdf return value
217    INTEGER, INTENT(OUT) ::  return_value  !< return value
218
219
220    return_value = 0
221    file_id = -1
222!
223!-- Open new file
224    CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( file_name ) // '"' )
225
226    IF ( TRIM( mode ) == mode_serial )  THEN
227
228#if defined( __netcdf4 )
229
230       IF ( return_value == 0 )  THEN
231          IF ( my_rank == master_rank )  THEN
232             nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ),                      &
233                                    IOR( NF90_NOCLOBBER, NF90_NETCDF4 ),                           &
234                                    file_id )
235          ELSE
236             nc_stat = 0
237          ENDIF
238       ENDIF
239#else
240       nc_stat = 0
241       return_value = 1
242       CALL internal_message( 'error', routine_name //                                             &
243                              ': pre-processor directive "__netcdf4" not given. ' //               &
244                              'Using NetCDF4 output not possible' )
245#endif
246
247    ELSEIF ( TRIM( mode ) == mode_parallel )  THEN
248
249#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
250       nc_stat = NF90_CREATE( TRIM( file_name ) // TRIM( file_suffix ),                            &
251                              IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ),              &
252                              file_id, COMM = output_group_comm, INFO = MPI_INFO_NULL )
253#else
254       nc_stat = 0
255       return_value = 1
256       CALL internal_message( 'error', routine_name //                                             &
257                              ': pre-processor directives "__parallel" and/or ' //                 &
258                              '"__netcdf4" and/or "__netcdf4_parallel" not given. ' //             &
259                              'Using parallel NetCDF4 output not possible' )
260#endif
261
262    ELSE
263       nc_stat = 0
264       return_value = 1
265       CALL internal_message( 'error', routine_name //                                             &
266                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
267                              mode_serial // '" or "' // mode_parallel // '"' )
268    ENDIF
269
270#if defined( __netcdf4 )
271    IF ( nc_stat /= NF90_NOERR  .AND.  return_value == 0 )  THEN
272       return_value = 1
273       CALL internal_message( 'error', routine_name //                                             &
274                              ': NetCDF error while opening file "' //                             &
275                              TRIM( file_name ) // '": ' // NF90_STRERROR( nc_stat ) )
276    ENDIF
277#endif
278
279 END SUBROUTINE netcdf4_open_file
280
281!--------------------------------------------------------------------------------------------------!
282! Description:
283! ------------
284!> Write attribute to netcdf file.
285!--------------------------------------------------------------------------------------------------!
286 SUBROUTINE netcdf4_write_attribute( mode, file_id, variable_id, attribute_name,                   &
287                                     value_char, value_int8, value_int16, value_int32,             &
288                                     value_real32, value_real64, return_value )
289
290    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_attribute'  !< name of this routine
291
292    CHARACTER(LEN=*), INTENT(IN)           ::  attribute_name  !< name of attribute
293    CHARACTER(LEN=*), INTENT(IN)           ::  mode            !< operation mode (either parallel or serial)
294    CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  value_char      !< value of attribute
295
296    INTEGER, INTENT(IN)  ::  file_id       !< file ID
297    INTEGER              ::  nc_stat       !< netcdf return value
298    INTEGER, INTENT(OUT) ::  return_value  !< return value
299    INTEGER              ::  target_id     !< ID of target which gets attribute (either global or variable_id)
300    INTEGER, INTENT(IN)  ::  variable_id   !< variable ID
301
302    INTEGER(KIND=1), INTENT(IN), OPTIONAL ::  value_int8   !< value of attribute
303    INTEGER(KIND=2), INTENT(IN), OPTIONAL ::  value_int16  !< value of attribute
304    INTEGER(KIND=4), INTENT(IN), OPTIONAL ::  value_int32  !< value of attribute
305
306    REAL(KIND=4), INTENT(IN), OPTIONAL ::  value_real32  !< value of attribute
307    REAL(KIND=8), INTENT(IN), OPTIONAL ::  value_real64  !< value of attribute
308
309
310#if defined( __netcdf4 )
311    return_value = 0
312
313    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
314
315       IF ( variable_id == global_id_in_file )  THEN
316          target_id = NF90_GLOBAL
317       ELSE
318          target_id = variable_id
319       ENDIF
320
321       CALL internal_message( 'debug', routine_name //                                             &
322                              ': write attribute "' // TRIM( attribute_name ) // '"' )
323
324       IF ( PRESENT( value_char ) )  THEN
325          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), TRIM( value_char ) )
326       ELSEIF ( PRESENT( value_int8 ) )  THEN
327          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int8 )
328       ELSEIF ( PRESENT( value_int16 ) )  THEN
329          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int16 )
330       ELSEIF ( PRESENT( value_int32 ) )  THEN
331          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_int32 )
332       ELSEIF ( PRESENT( value_real32 ) )  THEN
333          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real32 )
334       ELSEIF ( PRESENT( value_real64 ) )  THEN
335          nc_stat = NF90_PUT_ATT( file_id, target_id, TRIM( attribute_name ), value_real64 )
336       ELSE
337          return_value = 1
338          CALL internal_message( 'error', routine_name //                                          &
339                                 ': no value given for attribute "' // TRIM( attribute_name ) //   &
340                                 '"' )
341       ENDIF
342
343       IF ( return_value == 0 )  THEN
344          IF ( nc_stat /= NF90_NOERR )  THEN
345             return_value = 1
346             CALL internal_message( 'error', routine_name //                                       &
347                                    ': NetCDF error while writing attribute "' //                  &
348                                    TRIM( attribute_name ) // '": ' // NF90_STRERROR( nc_stat ) )
349          ENDIF
350       ENDIF
351
352    ENDIF
353#else
354    return_value = 1
355!
356!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
357    IF ( .FALSE. )  THEN
358       nc_stat = LEN( routine_name )
359       target_id = 0
360    ENDIF
361#endif
362
363 END SUBROUTINE netcdf4_write_attribute
364
365!--------------------------------------------------------------------------------------------------!
366! Description:
367! ------------
368!> Initialize dimension.
369!--------------------------------------------------------------------------------------------------!
370 SUBROUTINE netcdf4_init_dimension( mode, file_id, dimension_id, variable_id,                      &
371                                    dimension_name, dimension_type, dimension_length,              &
372                                    write_only_by_master_rank, return_value )
373
374    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_dimension'  !< name of this routine
375
376    CHARACTER(LEN=*), INTENT(IN) ::  dimension_name  !< name of dimension
377    CHARACTER(LEN=*), INTENT(IN) ::  dimension_type  !< data type of dimension
378    CHARACTER(LEN=*), INTENT(IN) ::  mode            !< operation mode (either parallel or serial)
379
380    INTEGER, INTENT(OUT) ::  dimension_id         !< dimension ID
381    INTEGER, INTENT(IN)  ::  dimension_length     !< length of dimension
382    INTEGER, INTENT(IN)  ::  file_id              !< file ID
383    INTEGER              ::  nc_dimension_length  !< length of dimension
384    INTEGER              ::  nc_stat              !< netcdf return value
385    INTEGER, INTENT(OUT) ::  return_value         !< return value
386    INTEGER, INTENT(OUT) ::  variable_id          !< variable ID
387
388    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
389
390
391#if defined( __netcdf4 )
392    return_value = 0
393    variable_id = -1
394    dimension_id = -1
395
396    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
397
398       CALL internal_message( 'debug', routine_name //                                             &
399                              ': init dimension "' // TRIM( dimension_name ) // '"' )
400!
401!--    Check if dimension is unlimited
402       IF ( dimension_length < 0 )  THEN
403          nc_dimension_length = NF90_UNLIMITED
404       ELSE
405          nc_dimension_length = dimension_length
406       ENDIF
407!
408!--    Define dimension in file
409       nc_stat = NF90_DEF_DIM( file_id, dimension_name, nc_dimension_length, dimension_id )
410
411       IF ( nc_stat == NF90_NOERR )  THEN
412!
413!--       Define variable holding dimension values in file
414          CALL netcdf4_init_variable( mode, file_id, variable_id, dimension_name, dimension_type,  &
415                                      (/ dimension_id /),                                          &
416                                      write_only_by_master_rank=write_only_by_master_rank,         &
417                                      return_value=return_value )
418
419       ELSE
420          return_value = 1
421          CALL internal_message( 'error', routine_name //                                          &
422                                 ': NetCDF error while initializing dimension "' //                &
423                                 TRIM( dimension_name ) // '": ' // NF90_STRERROR( nc_stat ) )
424       ENDIF
425
426    ENDIF
427#else
428    return_value = 1
429    variable_id = -1
430    dimension_id = -1
431!
432!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
433    IF ( .FALSE. )  THEN
434       nc_stat = LEN( routine_name )
435       nc_dimension_length = 0
436    ENDIF
437#endif
438
439 END SUBROUTINE netcdf4_init_dimension
440
441!--------------------------------------------------------------------------------------------------!
442! Description:
443! ------------
444!> Initialize variable.
445!--------------------------------------------------------------------------------------------------!
446 SUBROUTINE netcdf4_init_variable( mode, file_id, variable_id, variable_name, variable_type,       &
447                                   dimension_ids, write_only_by_master_rank, return_value )
448
449    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_variable'  !< name of this routine
450
451    CHARACTER(LEN=*), INTENT(IN) ::  mode           !< operation mode (either parallel or serial)
452    CHARACTER(LEN=*), INTENT(IN) ::  variable_name  !< name of variable
453    CHARACTER(LEN=*), INTENT(IN) ::  variable_type  !< data type of variable
454
455    INTEGER, INTENT(IN)  ::  file_id                 !< file ID
456    INTEGER              ::  nc_stat                 !< netcdf return value
457    INTEGER              ::  nc_variable_type        !< netcdf data type
458    INTEGER, INTENT(OUT) ::  return_value            !< return value
459    INTEGER, INTENT(OUT) ::  variable_id             !< variable ID
460#if defined( __netcdf4_parallel )
461    INTEGER              ::  parallel_access_mode    !< either NF90_INDEPENDENT or NF90_COLLECTIVE
462    INTEGER              ::  unlimited_dimension_id  !< ID of unlimited dimension in file
463#endif
464    INTEGER, DIMENSION(:), INTENT(IN) ::  dimension_ids  !< list of dimension IDs used by variable
465
466    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
467
468
469#if defined( __netcdf4 )
470    return_value = 0
471    variable_id = -1
472
473    IF ( ( TRIM( mode ) == mode_serial  .AND.  my_rank == master_rank )                            &
474         .OR.  TRIM( mode ) == mode_parallel )  THEN
475
476       WRITE( temp_string, * ) write_only_by_master_rank
477       CALL internal_message( 'debug', routine_name //                                             &
478                              ': init variable "' // TRIM( variable_name ) //                      &
479                              '" ( write_only_by_master_rank = ' // TRIM( temp_string ) // ')' )
480
481       nc_variable_type = get_netcdf_data_type( variable_type )
482
483       IF ( nc_variable_type /= -1 )  THEN
484!
485!--       Define variable in file
486          nc_stat = NF90_DEF_VAR( file_id, variable_name, nc_variable_type,                        &
487                                  dimension_ids, variable_id )
488!
489!--       Set no-fill mode
490          IF ( nc_stat == NF90_NOERR )  &
491             nc_stat = NF90_DEF_VAR_FILL( file_id, variable_id, NF90_NOFILL, NF90_FILL_BYTE )
492
493#if defined( __netcdf4_parallel )
494!
495!--       Define how variable can be accessed by PEs in parallel netcdf file
496          IF ( nc_stat == NF90_NOERR  .AND.  TRIM( mode ) == mode_parallel )  THEN
497!
498!--          If the variable uses an unlimited dimension, its access mode must be 'collective',
499!--          otherwise it can be set to independent.
500!--          Hence, get ID of unlimited dimension in file (if any) and check if it is used by
501!--          the variable.
502             nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id )
503
504             IF ( nc_stat == NF90_NOERR )  THEN
505                IF ( ANY( dimension_ids == unlimited_dimension_id ) )  THEN
506                   parallel_access_mode = NF90_COLLECTIVE
507                ELSE
508                   parallel_access_mode = NF90_INDEPENDENT
509                ENDIF
510
511                nc_stat = NF90_VAR_PAR_ACCESS( file_id, variable_id, parallel_access_mode )
512             ENDIF
513          ENDIF
514#endif
515
516          IF ( nc_stat /= NF90_NOERR )  THEN
517             return_value = 1
518             CALL internal_message( 'error', routine_name //                                       &
519                                    ': NetCDF error while initializing variable "' //              &
520                                    TRIM( variable_name ) // '": ' // NF90_STRERROR( nc_stat ) )
521          ENDIF
522
523       ELSE
524          return_value = 1
525       ENDIF
526
527    ELSEIF ( TRIM( mode ) /= mode_serial  .AND.  TRIM( mode ) /= mode_parallel )  THEN
528       return_value = 1
529       CALL internal_message( 'error', routine_name //                                             &
530                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
531                              mode_serial // '" or "' // mode_parallel // '"' )
532    ENDIF
533
534#else
535    return_value = 1
536    variable_id = -1
537!
538!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
539    IF ( .FALSE. )  THEN
540       nc_stat = LEN( routine_name )
541       nc_variable_type = get_netcdf_data_type( '' )
542    ENDIF
543#endif
544
545 END SUBROUTINE netcdf4_init_variable
546
547!--------------------------------------------------------------------------------------------------!
548! Description:
549! ------------
550!> Leave file definition state.
551!--------------------------------------------------------------------------------------------------!
552 SUBROUTINE netcdf4_stop_file_header_definition( mode, file_id, return_value )
553
554    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_stop_file_header_definition'  !< name of this routine
555
556    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
557
558    INTEGER, INTENT(IN)  ::  file_id        !< file ID
559    INTEGER              ::  nc_stat        !< netcdf return value
560    INTEGER              ::  old_fill_mode  !< previous netcdf fill mode
561    INTEGER, INTENT(OUT) ::  return_value   !< return value
562
563
564#if defined( __netcdf4 )
565    return_value = 0
566
567    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
568
569       WRITE( temp_string, * ) file_id
570       CALL internal_message( 'debug', routine_name //                                             &
571                              ': finalize file definition (file_id=' // TRIM( temp_string ) // ')' )
572!
573!--    Set general no fill, otherwise the performance drops significantly
574       nc_stat = NF90_SET_FILL( file_id, NF90_NOFILL, old_fill_mode )
575
576       IF ( nc_stat == NF90_NOERR )  THEN
577          nc_stat = NF90_ENDDEF( file_id )
578       ENDIF
579
580       IF ( nc_stat /= NF90_NOERR )  THEN
581          return_value = 1
582          CALL internal_message( 'error', routine_name //                                          &
583                                 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
584       ENDIF
585
586    ENDIF
587#else
588    return_value = 1
589!
590!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
591    IF ( .FALSE. )  THEN
592       nc_stat = LEN( routine_name )
593       old_fill_mode = 0
594    ENDIF
595#endif
596
597 END SUBROUTINE netcdf4_stop_file_header_definition
598
599!--------------------------------------------------------------------------------------------------!
600! Description:
601! ------------
602!> Write variable of different kind into netcdf file.
603!--------------------------------------------------------------------------------------------------!
604 SUBROUTINE netcdf4_write_variable(                                                                &
605               mode, file_id, variable_id, bounds_start, value_counts, bounds_origin,              &
606               write_only_by_master_rank,                                                          &
607               values_char_0d,   values_char_1d,   values_char_2d,   values_char_3d,               &
608               values_int8_0d,   values_int8_1d,   values_int8_2d,   values_int8_3d,               &
609               values_int16_0d,  values_int16_1d,  values_int16_2d,  values_int16_3d,              &
610               values_int32_0d,  values_int32_1d,  values_int32_2d,  values_int32_3d,              &
611               values_intwp_0d,  values_intwp_1d,  values_intwp_2d,  values_intwp_3d,              &
612               values_real32_0d, values_real32_1d, values_real32_2d, values_real32_3d,             &
613               values_real64_0d, values_real64_1d, values_real64_2d, values_real64_3d,             &
614               values_realwp_0d, values_realwp_1d, values_realwp_2d, values_realwp_3d,             &
615               return_value )
616
617    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_variable'  !< name of this routine
618
619    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
620
621    CHARACTER(LEN=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_char_0d  !< output variable
622    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_char_1d  !< output variable
623    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_char_2d  !< output variable
624    CHARACTER(LEN=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_char_3d  !< output variable
625
626    INTEGER              ::  d                       !< loop index
627    INTEGER, INTENT(IN)  ::  file_id                 !< file ID
628    INTEGER              ::  nc_stat                 !< netcdf return value
629    INTEGER              ::  ndims                   !< number of dimensions of variable in file
630    INTEGER, INTENT(OUT) ::  return_value            !< return value
631    INTEGER              ::  unlimited_dimension_id  !< ID of unlimited dimension in file
632    INTEGER, INTENT(IN)  ::  variable_id             !< variable ID
633
634    INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_origin      !< starting index of each dimension
635    INTEGER, DIMENSION(:),              INTENT(IN)  ::  bounds_start       !< starting index of variable
636    INTEGER, DIMENSION(:), ALLOCATABLE              ::  dimension_ids      !< IDs of dimensions of variable in file
637    INTEGER, DIMENSION(:), ALLOCATABLE              ::  dimension_lengths  !< length of dimensions of variable in file
638    INTEGER, DIMENSION(:),              INTENT(IN)  ::  value_counts       !< count of values along each dimension to be written
639
640    INTEGER(KIND=1), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int8_0d   !< output variable
641    INTEGER(KIND=2), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int16_0d  !< output variable
642    INTEGER(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_int32_0d  !< output variable
643    INTEGER(iwp),    POINTER,             INTENT(IN), OPTIONAL                   ::  values_intwp_0d  !< output variable
644    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int8_1d   !< output variable
645    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int16_1d  !< output variable
646    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_int32_1d  !< output variable
647    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_intwp_1d  !< output variable
648    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int8_2d   !< output variable
649    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int16_2d  !< output variable
650    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_int32_2d  !< output variable
651    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_intwp_2d  !< output variable
652    INTEGER(KIND=1), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int8_3d   !< output variable
653    INTEGER(KIND=2), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int16_3d  !< output variable
654    INTEGER(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_int32_3d  !< output variable
655    INTEGER(iwp),    POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_intwp_3d  !< output variable
656
657    LOGICAL, INTENT(IN) ::  write_only_by_master_rank  !< true if only master rank shall write variable
658    LOGICAL             ::  write_data                 !< true if variable shall be written to file
659
660    REAL(KIND=4), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real32_0d  !< output variable
661    REAL(KIND=8), POINTER,             INTENT(IN), OPTIONAL                   ::  values_real64_0d  !< output variable
662    REAL(wp),     POINTER,             INTENT(IN), OPTIONAL                   ::  values_realwp_0d  !< output variable
663    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real32_1d  !< output variable
664    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_real64_1d  !< output variable
665    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:)     ::  values_realwp_1d  !< output variable
666    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real32_2d  !< output variable
667    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_real64_2d  !< output variable
668    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:)   ::  values_realwp_2d  !< output variable
669    REAL(KIND=4), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real32_3d  !< output variable
670    REAL(KIND=8), POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_real64_3d  !< output variable
671    REAL(wp),     POINTER, CONTIGUOUS, INTENT(IN), OPTIONAL, DIMENSION(:,:,:) ::  values_realwp_3d  !< output variable
672
673
674#if defined( __netcdf4 )
675    return_value = 0
676    write_data = .FALSE.
677!
678!-- Check whether this PE write any data to file
679    IF ( TRIM( mode ) == mode_serial )  THEN
680
681       IF ( my_rank == master_rank )  write_data = .TRUE.
682
683    ELSEIF ( TRIM( mode ) == mode_parallel )  THEN
684!
685!--    Check for collective access mode.
686!--    This cannot be checked directly but indirect via the presence of any unlimited dimensions
687!--    If any dimension is unlimited, variable access must be collective and all PEs must
688!--    participate in writing
689       ndims = SIZE( bounds_start )
690       ALLOCATE( dimension_ids(ndims) )
691
692       nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, DIMIDS=dimension_ids )
693       nc_stat = NF90_INQUIRE( file_id, UNLIMITEDDIMID=unlimited_dimension_id )
694
695       IF ( ANY( dimension_ids == unlimited_dimension_id ) )  THEN
696          write_data = .TRUE.
697!
698!--    If access is independent, check if only master rank shall write
699       ELSEIF ( write_only_by_master_rank )  THEN
700          IF ( my_rank == master_rank )  write_data = .TRUE.
701!
702!--    If all PEs can write, check if there are any data to be written
703       ELSEIF ( ALL( value_counts > 0, DIM=1 ) )  THEN
704          write_data = .TRUE.
705       ENDIF
706
707    ELSE
708       return_value = 1
709       CALL internal_message( 'error', routine_name //                                             &
710                              ': selected mode "' // TRIM( mode ) // '" must be either "' //       &
711                              mode_serial // '" or "' // mode_parallel // '"' )
712    ENDIF
713
714    IF ( write_data )  THEN
715
716       WRITE( temp_string, * ) variable_id
717       CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
718
719       ndims = SIZE( bounds_start )
720!
721!--    Character output
722       IF ( PRESENT( values_char_0d ) )  THEN
723          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_char_0d /),                      &
724                                  start = bounds_start - bounds_origin + 1,                        &
725                                  count = value_counts )
726       ELSEIF ( PRESENT( values_char_1d ) )  THEN
727          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_1d,                            &
728                                  start = bounds_start - bounds_origin + 1,                        &
729                                  count = value_counts )
730       ELSEIF ( PRESENT( values_char_2d ) )  THEN
731          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_2d,                            &
732                                  start = bounds_start - bounds_origin + 1,                        &
733                                  count = value_counts )
734       ELSEIF ( PRESENT( values_char_3d ) )  THEN
735          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_char_3d,                            &
736                                  start = bounds_start - bounds_origin + 1,                        &
737                                  count = value_counts )
738!
739!--    8bit integer output
740       ELSEIF ( PRESENT( values_int8_0d ) )  THEN
741          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int8_0d /),                      &
742                                  start = bounds_start - bounds_origin + 1,                        &
743                                  count = value_counts )
744       ELSEIF ( PRESENT( values_int8_1d ) )  THEN
745          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_1d,                            &
746                                  start = bounds_start - bounds_origin + 1,                        &
747                                  count = value_counts )
748       ELSEIF ( PRESENT( values_int8_2d ) )  THEN
749          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_2d,                            &
750                                  start = bounds_start - bounds_origin + 1,                        &
751                                  count = value_counts )
752       ELSEIF ( PRESENT( values_int8_3d ) )  THEN
753          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int8_3d,                            &
754                                  start = bounds_start - bounds_origin + 1,                        &
755                                  count = value_counts )
756!
757!--    16bit integer output
758       ELSEIF ( PRESENT( values_int16_0d ) )  THEN
759          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int16_0d /),                     &
760                                  start = bounds_start - bounds_origin + 1,                        &
761                                  count = value_counts )
762       ELSEIF ( PRESENT( values_int16_1d ) )  THEN
763          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_1d,                           &
764                                  start = bounds_start - bounds_origin + 1,                        &
765                                  count = value_counts )
766       ELSEIF ( PRESENT( values_int16_2d ) )  THEN
767          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_2d,                           &
768                                  start = bounds_start - bounds_origin + 1,                        &
769                                  count = value_counts )
770       ELSEIF ( PRESENT( values_int16_3d ) )  THEN
771          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int16_3d,                           &
772                                  start = bounds_start - bounds_origin + 1,                        &
773                                  count = value_counts )
774!
775!--    32bit integer output
776       ELSEIF ( PRESENT( values_int32_0d ) )  THEN
777          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_int32_0d /),                     &
778                                  start = bounds_start - bounds_origin + 1,                        &
779                                  count = value_counts )
780       ELSEIF ( PRESENT( values_int32_1d ) )  THEN
781          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_1d,                           &
782                                  start = bounds_start - bounds_origin + 1,                        &
783                                  count = value_counts )
784       ELSEIF ( PRESENT( values_int32_2d ) )  THEN
785          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_2d,                           &
786                                  start = bounds_start - bounds_origin + 1,                        &
787                                  count = value_counts )
788       ELSEIF ( PRESENT( values_int32_3d ) )  THEN
789          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_int32_3d,                           &
790                                  start = bounds_start - bounds_origin + 1,                        &
791                                  count = value_counts )
792!
793!--    Working-precision integer output
794       ELSEIF ( PRESENT( values_intwp_0d ) )  THEN
795          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_intwp_0d /),                     &
796                                  start = bounds_start - bounds_origin + 1,                        &
797                                  count = value_counts )
798       ELSEIF ( PRESENT( values_intwp_1d ) )  THEN
799          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_1d,                           &
800                                  start = bounds_start - bounds_origin + 1,                        &
801                                  count = value_counts )
802       ELSEIF ( PRESENT( values_intwp_2d ) )  THEN
803          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_2d,                           &
804                                  start = bounds_start - bounds_origin + 1,                        &
805                                  count = value_counts )
806       ELSEIF ( PRESENT( values_intwp_3d ) )  THEN
807          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_intwp_3d,                           &
808                                  start = bounds_start - bounds_origin + 1,                        &
809                                  count = value_counts )
810!
811!--    32bit real output
812       ELSEIF ( PRESENT( values_real32_0d ) )  THEN
813          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real32_0d /),                    &
814                                  start = bounds_start - bounds_origin + 1,                        &
815                                  count = value_counts )
816       ELSEIF ( PRESENT( values_real32_1d ) )  THEN
817          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_1d,                          &
818                                  start = bounds_start - bounds_origin + 1,                        &
819                                  count = value_counts )
820       ELSEIF ( PRESENT( values_real32_2d ) )  THEN
821          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_2d,                          &
822                                  start = bounds_start - bounds_origin + 1,                        &
823                                  count = value_counts )
824       ELSEIF ( PRESENT( values_real32_3d ) )  THEN
825          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real32_3d,                          &
826                                  start = bounds_start - bounds_origin + 1,                        &
827                                  count = value_counts )
828!
829!--    64bit real output
830       ELSEIF ( PRESENT( values_real64_0d ) )  THEN
831          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_real64_0d /),                    &
832                                  start = bounds_start - bounds_origin + 1,                        &
833                                  count = value_counts )
834       ELSEIF ( PRESENT( values_real64_1d ) )  THEN
835          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_1d,                          &
836                                  start = bounds_start - bounds_origin + 1,                        &
837                                  count = value_counts )
838       ELSEIF ( PRESENT( values_real64_2d ) )  THEN
839          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_2d,                          &
840                                  start = bounds_start - bounds_origin + 1,                        &
841                                  count = value_counts )
842       ELSEIF ( PRESENT( values_real64_3d ) )  THEN
843          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_real64_3d,                          &
844                                  start = bounds_start - bounds_origin + 1,                        &
845                                  count = value_counts )
846!
847!--    Working-precision real output
848       ELSEIF ( PRESENT( values_realwp_0d ) )  THEN
849          nc_stat = NF90_PUT_VAR( file_id, variable_id, (/ values_realwp_0d /),                    &
850                                  start = bounds_start - bounds_origin + 1,                        &
851                                  count = value_counts )
852       ELSEIF ( PRESENT( values_realwp_1d ) )  THEN
853          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_1d,                          &
854                                  start = bounds_start - bounds_origin + 1,                        &
855                                  count = value_counts )
856       ELSEIF ( PRESENT( values_realwp_2d ) )  THEN
857          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_2d,                          &
858                                  start = bounds_start - bounds_origin + 1,                        &
859                                  count = value_counts )
860       ELSEIF ( PRESENT( values_realwp_3d ) )  THEN
861          nc_stat = NF90_PUT_VAR( file_id, variable_id, values_realwp_3d,                          &
862                                  start = bounds_start - bounds_origin + 1,                        &
863                                  count = value_counts )
864       ELSE
865          return_value = 1
866          nc_stat = NF90_NOERR
867          WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) variable_id, file_id
868          CALL internal_message( 'error', routine_name //                                          &
869                                 ': no output values given ' // TRIM( temp_string ) )
870       ENDIF
871!
872!--    Check for errors
873       IF ( nc_stat /= NF90_NOERR )  THEN
874          return_value = 1
875
876          IF ( nc_stat == NF90_EEDGE .OR. nc_stat == NF90_EINVALCOORDS )  THEN
877!
878!--          If given bounds exceed dimension bounds, get information of bounds in file
879             WRITE( temp_string, * )  NF90_STRERROR( nc_stat )
880
881             IF ( .NOT. ALLOCATED( dimension_ids ) )  ALLOCATE( dimension_ids(ndims) )
882             ALLOCATE( dimension_lengths(ndims) )
883
884             nc_stat = NF90_INQUIRE_VARIABLE( file_id, variable_id, dimids=dimension_ids )
885
886             d = 1
887             DO WHILE ( d <= ndims .AND. nc_stat == NF90_NOERR )
888                nc_stat = NF90_INQUIRE_DIMENSION( file_id, dimension_ids(d),                       &
889                                                  LEN=dimension_lengths(d) )
890                d = d + 1
891             ENDDO
892
893             IF ( nc_stat == NF90_NOERR )  THEN
894                WRITE( temp_string, * )  TRIM( temp_string ) // '; given variable bounds: ' //     &
895                   'start=', bounds_start, ', count=', value_counts, ', origin=', bounds_origin
896                CALL internal_message( 'error', routine_name //                                    &
897                                       ': error while writing: ' // TRIM( temp_string ) )
898             ELSE
899!
900!--             Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
901                CALL internal_message( 'error', routine_name //                                    &
902                                       ': error while accessing file: ' //                         &
903                                        NF90_STRERROR( nc_stat ) )
904             ENDIF
905
906          ELSE
907!
908!--          Other NetCDF error
909             CALL internal_message( 'error', routine_name //                                       &
910                                    ': error while writing: ' // NF90_STRERROR( nc_stat ) )
911          ENDIF
912       ENDIF
913
914    ENDIF
915#else
916    return_value = 1
917!
918!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
919    IF ( .FALSE. )  THEN
920       nc_stat = LEN( routine_name )
921       IF ( write_data )  unlimited_dimension_id = 0
922       IF ( ALLOCATED( dimension_ids ) )  d = 0
923       IF ( ALLOCATED( dimension_lengths ) )  ndims = 0
924    ENDIF
925#endif
926
927 END SUBROUTINE netcdf4_write_variable
928
929!--------------------------------------------------------------------------------------------------!
930! Description:
931! ------------
932!> Close netcdf file.
933!--------------------------------------------------------------------------------------------------!
934 SUBROUTINE netcdf4_finalize( mode, file_id, return_value )
935
936    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_finalize'  !< name of routine
937
938    CHARACTER(LEN=*), INTENT(IN) ::  mode  !< operation mode (either parallel or serial)
939
940    INTEGER, INTENT(IN)  ::  file_id       !< file ID
941    INTEGER              ::  nc_stat       !< netcdf return value
942    INTEGER, INTENT(OUT) ::  return_value  !< return value
943
944
945#if defined( __netcdf4 )
946    return_value = 0
947
948    IF ( .NOT. ( TRIM( mode ) == mode_serial  .AND.  my_rank /= master_rank ) )  THEN
949
950       WRITE( temp_string, * ) file_id
951       CALL internal_message( 'debug', routine_name //                                             &
952                              ': close file (file_id=' // TRIM( temp_string ) // ')' )
953
954       nc_stat = NF90_CLOSE( file_id )
955       IF ( nc_stat == NF90_NOERR )  THEN
956          return_value = 0
957       ELSE
958          return_value = 1
959          CALL internal_message( 'error', routine_name //                                          &
960                                 ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
961       ENDIF
962
963    ENDIF
964#else
965    return_value = 1
966!
967!-- Dummy commands to prevent "unused-variable" warning if preprocessor is not set
968    IF ( .FALSE. )  THEN
969       nc_stat = 0
970       temp_string = routine_name
971    ENDIF
972#endif
973
974 END SUBROUTINE netcdf4_finalize
975
976!--------------------------------------------------------------------------------------------------!
977! Description:
978! ------------
979!> Convert data_type string into netcdf data type value.
980!--------------------------------------------------------------------------------------------------!
981 FUNCTION get_netcdf_data_type( data_type ) RESULT( return_value )
982
983    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'get_netcdf_data_type'  !< name of this routine
984
985    CHARACTER(LEN=*), INTENT(IN) ::  data_type  !< requested data type
986
987    INTEGER ::  return_value  !< netcdf data type
988
989
990    SELECT CASE ( TRIM( data_type ) )
991
992#if defined( __netcdf4 )
993       CASE ( 'char' )
994          return_value = NF90_CHAR
995
996       CASE ( 'int8' )
997          return_value = NF90_BYTE
998
999       CASE ( 'int16' )
1000          return_value = NF90_SHORT
1001
1002       CASE ( 'int32' )
1003          return_value = NF90_INT
1004
1005       CASE ( 'real32' )
1006          return_value = NF90_FLOAT
1007
1008       CASE ( 'real64' )
1009          return_value = NF90_DOUBLE
1010#endif
1011
1012       CASE DEFAULT
1013          CALL internal_message( 'error', routine_name //                                          &
1014                                 ': data type unknown (' // TRIM( data_type ) // ')' )
1015          return_value = -1
1016
1017    END SELECT
1018
1019 END FUNCTION get_netcdf_data_type
1020
1021!--------------------------------------------------------------------------------------------------!
1022! Description:
1023! ------------
1024!> Message routine writing debug information into the debug file or creating the error message
1025!> string.
1026!--------------------------------------------------------------------------------------------------!
1027 SUBROUTINE internal_message( level, string )
1028
1029    CHARACTER(LEN=*), INTENT(IN) ::  level   !< message importance level
1030    CHARACTER(LEN=*), INTENT(IN) ::  string  !< message string
1031
1032
1033    IF ( TRIM( level ) == 'error' )  THEN
1034
1035       WRITE( internal_error_message, '(A,A)' ) ': ', string
1036
1037    ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
1038
1039       WRITE( debug_output_unit, '(A,A)' ) 'DOM DEBUG: ', string
1040       FLUSH( debug_output_unit )
1041
1042    ENDIF
1043
1044 END SUBROUTINE internal_message
1045
1046!--------------------------------------------------------------------------------------------------!
1047! Description:
1048! ------------
1049!> Return the last created error message.
1050!--------------------------------------------------------------------------------------------------!
1051 FUNCTION netcdf4_get_error_message() RESULT( error_message )
1052
1053    CHARACTER(LEN=800) ::  error_message  !< return error message to main program
1054
1055
1056    error_message = TRIM( internal_error_message )
1057
1058    internal_error_message = ''
1059
1060 END FUNCTION netcdf4_get_error_message
1061
1062
1063 END MODULE data_output_netcdf4_module
Note: See TracBrowser for help on using the repository browser.