Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 4106 for palm/trunk/SOURCE


Ignore:
Timestamp:
Jul 19, 2019 8:54:42 AM (5 years ago)
Author:
gronemeier
Message:

combine new netcdf4 output modules into a single module; improvements of DOM error messages; check initialization state of file before defining/writing anything; improvements in binary output

Location:
palm/trunk/SOURCE
Files:
1 deleted
3 edited
1 moved

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/Makefile

    r4102 r4106  
    605605        data_output_binary_module.f90 \
    606606        data_output_module.f90 \
    607         data_output_netcdf4_parallel_module.f90 \
    608         data_output_netcdf4_serial_module.f90 \
     607        data_output_netcdf4_module.f90 \
    609608        data_output_2d.f90 \
    610609        data_output_3d.f90 \
    … …  
    915914data_output_module.o: \
    916915        data_output_binary_module.o \
    917         data_output_netcdf4_parallel_module.o \
    918         data_output_netcdf4_serial_module.o \
     916        data_output_netcdf4_module.o \
    919917        mod_kinds.o
    920918data_output_mask.o: \
    … …  
    930928        salsa_mod.o \
    931929        surface_mod.o
    932 data_output_netcdf4_parallel_module.o: \
    933         mod_kinds.o
    934 data_output_netcdf4_serial_module.o: \
     930data_output_netcdf4_module.o: \
    935931        mod_kinds.o
    936932data_output_profiles.o: \

  • palm/trunk/SOURCE/data_output_binary_module.f90

    r4070 r4106  
    2020! Current revisions:
    2121! ------------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    … …  
    3636!> Binary output module to write output data into binary files.
    3737!>
    38 !> @todo Think of removing 'is_init' as its value can be derived from the return
    39 !>       value of 'return_value'.
    40 !> @todo Get return value of write statements.
     38!> @todo Get iostat value of write statements.
    4139!--------------------------------------------------------------------------------------------------!
    4240MODULE data_output_binary_module
    … …  
    5755
    5856   CHARACTER(LEN=*), PARAMETER ::  config_file_name = 'BINARY_TO_NETCDF_CONFIG'  !< name of config file
     57   CHARACTER(LEN=*), PARAMETER ::  mode_binary = 'binary'                        !< string to select operation mode of module
    5958   CHARACTER(LEN=*), PARAMETER ::  prefix = 'BIN_'                               !< file prefix for binary files
    6059
    … …  
    156155!> Open binary file.
    157156!--------------------------------------------------------------------------------------------------!
    158 SUBROUTINE binary_open_file( filename, file_id, return_value )
     157SUBROUTINE binary_open_file( mode, filename, file_id, return_value )
    159158
    160159   CHARACTER(LEN=charlen)             ::  bin_filename = ''  !< actual name of binary file
    161160   CHARACTER(LEN=charlen), INTENT(IN) ::  filename           !< name of file
    162161   CHARACTER(LEN=7)                   ::  myid_char          !< string containing value of myid with leading zeros
     162   CHARACTER(LEN=*),       INTENT(IN) ::  mode               !< operation mode
    163163
    164164   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_open_file'  !< name of this routine
    … …  
    180180      WRITE( myid_char, '("_",I6.6)' )  myid
    181181   ELSE
    182       CALL internal_message( 'debug', routine_name // 'MPI_COMM_RANK error' )
     182      CALL internal_message( 'debug', routine_name // ': MPI_COMM_RANK error' )
    183183   ENDIF
    184184#else
    … …  
    186186   myid_char = '_' // REPEAT('0', 6)
    187187#endif
     188
     189   !-- Check mode (not required, added for compatibility reasons)
     190   IF ( TRIM( mode ) == mode_binary )  CONTINUE
    188191
    189192   !-- Open binary config file for combining script
    … …  
    356359      return_value = 1
    357360      CALL internal_message( 'error', TRIM( routine_name ) // &
    358                                       ': attribute "' // TRIM( att_name ) // '": no value given' )
     361                             ': attribute "' // TRIM( att_name ) // '": no value given' )
    359362   ENDIF
    360363
    … …  
    367370!> values to be later written to file.
    368371!--------------------------------------------------------------------------------------------------!
    369 SUBROUTINE binary_init_dimension( file_id, dim_id, var_id, &
    370               dim_name, dim_type, dim_length, is_init, return_value )
     372SUBROUTINE binary_init_dimension( mode, file_id, dim_id, var_id, &
     373              dim_name, dim_type, dim_length, return_value )
    371374
    372375   CHARACTER(LEN=charlen), INTENT(IN) ::  dim_name  !< name of dimension
    373376   CHARACTER(LEN=charlen), INTENT(IN) ::  dim_type  !< data type of dimension
    374377   CHARACTER(LEN=charlen)             ::  out_str   !< output string
     378   CHARACTER(LEN=*),       INTENT(IN) ::  mode      !< operation mode
    375379
    376380   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_dimension'  !< name of this routine
    … …  
    382386   INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
    383387
    384    LOGICAL, INTENT(OUT) ::  is_init  !< true if dimension is initialized
    385 
    386388
    387389   return_value = 0
    388390
    389391   CALL internal_message( 'debug', routine_name // ': init dimension ' // TRIM( dim_name ) )
     392
     393   !-- Check mode (not required, added for compatibility reasons only)
     394   IF ( TRIM( mode ) == mode_binary )  CONTINUE
    390395
    391396   !-- Assign dimension ID
    … …  
    402407
    403408   !-- Define variable associated with dimension
    404    CALL binary_init_variable( file_id, var_id, dim_name, dim_type, &
    405                               (/dim_id/), is_init, .TRUE., return_value )
     409   CALL binary_init_variable( mode, file_id, var_id, dim_name, dim_type, (/dim_id/), &
     410                              is_global=.TRUE., return_value=return_value )
    406411   IF ( return_value /= 0 )  THEN
    407       is_init = .FALSE.
    408412      CALL internal_message( 'error', routine_name // &
    409413                                      ': init dimension "' // TRIM( dim_name ) // '"' )
    … …  
    417421!> Initialize variable. Write information of variable into file header.
    418422!--------------------------------------------------------------------------------------------------!
    419 SUBROUTINE binary_init_variable( file_id, var_id, var_name, var_type, &
    420                                  var_dim_ids, is_init, is_global, return_value )
     423SUBROUTINE binary_init_variable( mode, file_id, var_id, var_name, var_type, &
     424                                 var_dim_ids, is_global, return_value )
    421425
    422426   CHARACTER(LEN=charlen)             ::  out_str   !< output string
    423427   CHARACTER(LEN=charlen), INTENT(IN) ::  var_name  !< name of variable
    424428   CHARACTER(LEN=charlen), INTENT(IN) ::  var_type  !< data type of variable
     429   CHARACTER(LEN=*),       INTENT(IN) ::  mode      !< operation mode
    425430
    426431   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_init_variable'  !< name of this routine
    … …  
    433438
    434439   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
    435    LOGICAL, INTENT(OUT) ::  is_init    !< true if variable is initialized
    436440
    437441
    … …  
    440444   CALL internal_message( 'debug', routine_name // ': init variable ' // TRIM( var_name ) )
    441445
    442    IF ( is_global )  CONTINUE  ! reqired to prevent compiler warning
     446   !-- Check mode (not required, added for compatibility reasons only)
     447   IF ( TRIM( mode ) == mode_binary )  CONTINUE
     448
     449   !-- Check if variable is global (not required, added for compatibility reasons only)
     450   IF ( is_global )  CONTINUE
    443451
    444452   !-- Assign variable ID
    … …  
    454462   WRITE( file_id )  SIZE( var_dim_ids )
    455463   WRITE( file_id )  var_dim_ids
    456 
    457    !-- Variable is initialised
    458    is_init = return_value == 0
    459464
    460465END SUBROUTINE binary_init_variable
    … …  
    504509              return_value )
    505510
     511   CHARACTER(LEN=charlen) ::  out_str  !< output string
     512
    506513   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'binary_write_variable'  !< name of this routine
    507514
    … …  
    567574      !-- 8bit integer output
    568575      IF ( PRESENT( var_int8_0d ) )  THEN
     576         out_str = 'int8'
     577         WRITE( file_id )  out_str
    569578         WRITE( file_id )  var_int8_0d
    570579      ELSEIF ( PRESENT( var_int8_1d ) )  THEN
     580         out_str = 'int8'
     581         WRITE( file_id )  out_str
    571582         WRITE( file_id )  var_int8_1d
    572583      ELSEIF ( PRESENT( var_int8_2d ) )  THEN
     584         out_str = 'int8'
     585         WRITE( file_id )  out_str
    573586         WRITE( file_id )  var_int8_2d
    574587      ELSEIF ( PRESENT( var_int8_3d ) )  THEN
     588         out_str = 'int8'
     589         WRITE( file_id )  out_str
    575590         WRITE( file_id )  var_int8_3d
    576591      !-- 16bit integer output
    577592      ELSEIF ( PRESENT( var_int16_0d ) )  THEN
     593         out_str = 'int16'
     594         WRITE( file_id )  out_str
    578595         WRITE( file_id )  var_int16_0d
    579596      ELSEIF ( PRESENT( var_int16_1d ) )  THEN
     597         out_str = 'int16'
     598         WRITE( file_id )  out_str
    580599         WRITE( file_id )  var_int16_1d
    581600      ELSEIF ( PRESENT( var_int16_2d ) )  THEN
     601         out_str = 'int16'
     602         WRITE( file_id )  out_str
    582603         WRITE( file_id )  var_int16_2d
    583604      ELSEIF ( PRESENT( var_int16_3d ) )  THEN
     605         out_str = 'int16'
     606         WRITE( file_id )  out_str
    584607         WRITE( file_id )  var_int16_3d
    585608      !-- 32bit integer output
    586609      ELSEIF ( PRESENT( var_int32_0d ) )  THEN
     610         out_str = 'int32'
     611         WRITE( file_id )  out_str
    587612         WRITE( file_id )  var_int32_0d
    588613      ELSEIF ( PRESENT( var_int32_1d ) )  THEN
     614         out_str = 'int32'
     615         WRITE( file_id )  out_str
    589616         WRITE( file_id )  var_int32_1d
    590617      ELSEIF ( PRESENT( var_int32_2d ) )  THEN
     618         out_str = 'int32'
     619         WRITE( file_id )  out_str
    591620         WRITE( file_id )  var_int32_2d
    592621      ELSEIF ( PRESENT( var_int32_3d ) )  THEN
     622         out_str = 'int32'
     623         WRITE( file_id )  out_str
    593624         WRITE( file_id )  var_int32_3d
    594625      !-- working-precision integer output
    595626      ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
     627         out_str = 'intwp'
     628         WRITE( file_id )  out_str
    596629         WRITE( file_id )  var_intwp_0d
    597630      ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
     631         out_str = 'intwp'
     632         WRITE( file_id )  out_str
    598633         WRITE( file_id )  var_intwp_1d
    599634      ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
     635         out_str = 'intwp'
     636         WRITE( file_id )  out_str
    600637         WRITE( file_id )  var_intwp_2d
    601638      ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
     639         out_str = 'intwp'
     640         WRITE( file_id )  out_str
    602641         WRITE( file_id )  var_intwp_3d
    603642      !-- 32bit real output
    604643      ELSEIF ( PRESENT( var_real32_0d ) )  THEN
     644         out_str = 'real32'
     645         WRITE( file_id )  out_str
    605646         WRITE( file_id )  var_real32_0d
    606647      ELSEIF ( PRESENT( var_real32_1d ) )  THEN
     648         out_str = 'real32'
     649         WRITE( file_id )  out_str
    607650         WRITE( file_id )  var_real32_1d
    608651      ELSEIF ( PRESENT( var_real32_2d ) )  THEN
     652         out_str = 'real32'
     653         WRITE( file_id )  out_str
    609654         WRITE( file_id )  var_real32_2d
    610655      ELSEIF ( PRESENT( var_real32_3d ) )  THEN
     656         out_str = 'real32'
     657         WRITE( file_id )  out_str
    611658         WRITE( file_id )  var_real32_3d
    612659      !-- 64bit real output
    613660      ELSEIF ( PRESENT( var_real64_0d ) )  THEN
     661         out_str = 'real64'
     662         WRITE( file_id )  out_str
    614663         WRITE( file_id )  var_real64_0d
    615664      ELSEIF ( PRESENT( var_real64_1d ) )  THEN
     665         out_str = 'real64'
     666         WRITE( file_id )  out_str
    616667         WRITE( file_id )  var_real64_1d
    617668      ELSEIF ( PRESENT( var_real64_2d ) )  THEN
     669         out_str = 'real64'
     670         WRITE( file_id )  out_str
    618671         WRITE( file_id )  var_real64_2d
    619672      ELSEIF ( PRESENT( var_real64_3d ) )  THEN
     673         out_str = 'real64'
     674         WRITE( file_id )  out_str
    620675         WRITE( file_id )  var_real64_3d
    621676      !-- working-precision real output
    622677      ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
     678         out_str = 'realwp'
     679         WRITE( file_id )  out_str
    623680         WRITE( file_id )  var_realwp_0d
    624681      ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
     682         out_str = 'realwp'
     683         WRITE( file_id )  out_str
    625684         WRITE( file_id )  var_realwp_1d
    626685      ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
     686         out_str = 'realwp'
     687         WRITE( file_id )  out_str
    627688         WRITE( file_id )  var_realwp_2d
    628689      ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
     690         out_str = 'realwp'
     691         WRITE( file_id )  out_str
    629692         WRITE( file_id )  var_realwp_3d
    630693      ELSE
    631694         return_value = 1
    632          WRITE( temp_string, '(": variable_id=",I6,", file_id=",I6)' ) var_id, file_id
    633          CALL internal_message( 'error', routine_name // &
    634                                          TRIM( temp_string ) // ': no values given' )
     695         CALL internal_message( 'error', routine_name // ': no values given' )
    635696      ENDIF
    636697
    … …  
    706767   IF ( TRIM( level ) == 'error' )  THEN
    707768
    708       WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
     769      WRITE( internal_error_message, '(A,A)' ) ': ', string
    709770
    710771   ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN

  • palm/trunk/SOURCE/data_output_module.f90

    r4070 r4106  
    2020! Current revisions:
    2121! ------------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    … …  
    4343!>
    4444!> @todo Convert variable if type of given values do not fit specified type.
    45 !> @todo Remove unused variables
    46 !> @todo How to deal with definition calls after dom_start_output is called? Should it be allowed
    47 !>       to define new files after that (which is technically possible)?
    4845!> @todo Remove iwp from index (and similar) variables.
    4946!--------------------------------------------------------------------------------------------------!
    … …  
    5249   USE kinds
    5350
    54    USE data_output_netcdf4_serial_module, &
    55       ONLY: netcdf4_serial_init_dimension, &
    56             netcdf4_serial_get_error_message, &
    57             netcdf4_serial_init_end, &
    58             netcdf4_serial_init_module, &
    59             netcdf4_serial_init_variable, &
    60             netcdf4_serial_finalize, &
    61             netcdf4_serial_open_file, &
    62             netcdf4_serial_write_attribute, &
    63             netcdf4_serial_write_variable
    64 
    65    USE data_output_netcdf4_parallel_module, &
    66       ONLY: netcdf4_parallel_init_dimension, &
    67             netcdf4_parallel_get_error_message, &
    68             netcdf4_parallel_init_end, &
    69             netcdf4_parallel_init_module, &
    70             netcdf4_parallel_init_variable, &
    71             netcdf4_parallel_finalize, &
    72             netcdf4_parallel_open_file, &
    73             netcdf4_parallel_write_attribute, &
    74             netcdf4_parallel_write_variable
     51   USE data_output_netcdf4_module, &
     52      ONLY: netcdf4_init_dimension, &
     53            netcdf4_get_error_message, &
     54            netcdf4_init_end, &
     55            netcdf4_init_module, &
     56            netcdf4_init_variable, &
     57            netcdf4_finalize, &
     58            netcdf4_open_file, &
     59            netcdf4_write_attribute, &
     60            netcdf4_write_variable
    7561
    7662   USE data_output_binary_module, &
    … …  
    10591      INTEGER(iwp)           ::  id = 0               !< id within file
    10692      LOGICAL                ::  is_global = .FALSE.  !< true if global variable
    107       LOGICAL                ::  is_init = .FALSE.    !< true if initialized
    10893      CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE ::  dimension_names  !< list of dimension names
    10994      INTEGER(iwp),           DIMENSION(:), ALLOCATABLE ::  dimension_ids    !< list of dimension ids
    … …  
    118103      INTEGER(iwp)           ::  length_mask          !< length of masked dimension
    119104      INTEGER(iwp)           ::  var_id = 0           !< associated variable id within file
    120       LOGICAL                ::  is_init = .FALSE.    !< true if initialized
    121105      LOGICAL                ::  is_masked = .FALSE.  !< true if masked
    122106      INTEGER(iwp),    DIMENSION(2)              ::  bounds                !< lower and upper bound of dimension
    … …  
    125109      INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  masked_values_int16   !< masked dimension values if 16bit integer
    126110      INTEGER(KIND=4), DIMENSION(:), ALLOCATABLE ::  masked_values_int32   !< masked dimension values if 32bit integer
    127       INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  masked_values_intwp   !< masked dimension values if working-precision integer
     111      INTEGER(iwp),    DIMENSION(:), ALLOCATABLE ::  masked_values_intwp   !< masked dimension values if working-precision int
    128112      INTEGER(KIND=1), DIMENSION(:), ALLOCATABLE ::  values_int8           !< dimension values if 16bit integer
    129113      INTEGER(KIND=2), DIMENSION(:), ALLOCATABLE ::  values_int16          !< dimension values if 16bit integer
    … …  
    252236   CALL binary_init_module( debug_output_unit, debug_output, no_var_id )
    253237
    254    CALL netcdf4_serial_init_module( debug_output_unit, debug_output, no_var_id )
    255 
    256    CALL netcdf4_parallel_init_module( debug_output_unit, debug_output, no_var_id )
     238   CALL netcdf4_init_module( debug_output_unit, debug_output, no_var_id )
    257239
    258240END SUBROUTINE dom_init
    … …  
    310292   !             WRITE(*,'(10X,5(I5,1X),A)') files(f)%dimensions(d)%values_int32(0:MIN(4,files(f)%dimensions(d)%length)), '...'
    311293   !          ELSE
    312    !             WRITE(*,'(10X,5(F8.2,1X),A)') files(f)%dimensions(d)%values_real64(0:MIN(4,files(f)%dimensions(d)%length)), '...'
     294   !             WRITE(*,'(10X,5(F8.2,1X),A)')  &
     295   !                files(f)%dimensions(d)%values_real64(0:MIN(4,files(f)%dimensions(d)%length)), '...'
    313296   !          ENDIF
    314297   !          IF ( ALLOCATED(files(f)%dimensions(d)%mask) )  THEN
    … …  
    716699
    717700      return_value = 1
    718       CALL internal_message( 'error', routine_name //                   &
    719                                       ': dimension ' // TRIM( name ) // &
    720                                       ': At least one but no more than two bounds must be given' )
     701      CALL internal_message( 'error', routine_name //          &
     702                             ': dimension ' // TRIM( name ) // &
     703                             ': At least one but no more than two bounds must be given' )
    721704
    722705   ENDIF
    … …  
    729712         IF ( TRIM( filename ) == files(f)%name )  THEN
    730713
    731             IF ( .NOT. ALLOCATED( files(f)%dimensions ) )  THEN
     714            IF ( files(f)%is_init )  THEN
     715
     716               return_value = 1
     717               CALL internal_message( 'error',                           &
     718                       routine_name // ': file "' // TRIM( filename ) // &
     719                       '" is already initialized. No further dimension definition allowed!' )
     720               EXIT
     721
     722            ELSEIF ( .NOT. ALLOCATED( files(f)%dimensions ) )  THEN
    732723
    733724               ndim = 1
    … …  
    736727            ELSE
    737728
    738                ndim = SIZE( files(f)%dimensions )
    739 
    740                !-- Check if dimension already exists in file
    741                DO  d = 1, ndim
    742                   IF ( files(f)%dimensions(d)%name == dimension%name )  THEN
    743                      return_value = 1
    744                      CALL internal_message( 'error',            &
    745                              routine_name //                    &
    746                              ': dimension "' // TRIM( name ) // &
    747                              '" already exists in file "' // TRIM( filename ) // '"' )
    748                      EXIT
     729               !-- Check if any variable of the same name as the new dimension is already defined
     730               IF ( ALLOCATED( files(f)%variables ) )  THEN
     731                  DO  i = 1, SIZE( files(f)%variables )
     732                     IF ( files(f)%variables(i)%name == dimension%name )  THEN
     733                        return_value = 1
     734                        CALL internal_message( 'error', routine_name //                   &
     735                                               ': file "' // TRIM( filename ) //          &
     736                                               '" already has a variable of name "' //    &
     737                                               TRIM( dimension%name ) // '" defined. ' // &
     738                                               'Defining a dimension of the same ' //     &
     739                                               'name is not allowed.' )
     740                        EXIT
     741                     ENDIF
     742                  ENDDO
     743               ENDIF
     744
     745               IF ( return_value == 0 )  THEN
     746                  !-- Check if dimension already exists in file
     747                  ndim = SIZE( files(f)%dimensions )
     748
     749                  DO  d = 1, ndim
     750                     IF ( files(f)%dimensions(d)%name == dimension%name )  THEN
     751                        return_value = 1
     752                        CALL internal_message( 'error',            &
     753                                routine_name //                    &
     754                                ': dimension "' // TRIM( name ) // &
     755                                '" already exists in file "' // TRIM( filename ) // '"' )
     756                        EXIT
     757                     ENDIF
     758                  ENDDO
     759
     760                  !-- Extend dimension list
     761                  IF ( return_value == 0 )  THEN
     762                     ALLOCATE( dims_tmp(ndim) )
     763                     dims_tmp = files(f)%dimensions
     764                     DEALLOCATE( files(f)%dimensions )
     765                     ndim = ndim + 1
     766                     ALLOCATE( files(f)%dimensions(ndim) )
     767                     files(f)%dimensions(:ndim-1) = dims_tmp
     768                     DEALLOCATE( dims_tmp )
    749769                  ENDIF
    750                ENDDO
    751 
    752                !-- Extend dimension list
    753                IF ( return_value == 0 )  THEN
    754                   ALLOCATE( dims_tmp(ndim) )
    755                   dims_tmp = files(f)%dimensions
    756                   DEALLOCATE( files(f)%dimensions )
    757                   ndim = ndim + 1
    758                   ALLOCATE( files(f)%dimensions(ndim) )
    759                   files(f)%dimensions(:ndim-1) = dims_tmp
    760                   DEALLOCATE( dims_tmp )
    761770               ENDIF
    762771
    … …  
    832841      IF ( TRIM( filename ) == files(f)%name )  THEN
    833842
    834          !-- Check if dimensions assigned to variable are defined within file
    835          IF ( ALLOCATED( files(f)%dimensions ) )  THEN
    836 
    837             DO  i = 1, SIZE( variable%dimension_names )
    838                found = .FALSE.
    839                DO  d = 1, SIZE( files(f)%dimensions )
    840                   IF ( files(f)%dimensions(d)%name == variable%dimension_names(i) )  THEN
    841                      found = .TRUE.
     843         IF ( files(f)%is_init )  THEN
     844
     845            return_value = 1
     846            CALL internal_message( 'error', routine_name // ': file "' // TRIM( filename ) // &
     847                    '" is already initialized. No further variable definition allowed!' )
     848            EXIT
     849
     850         ELSEIF ( ALLOCATED( files(f)%dimensions ) )  THEN
     851
     852            !-- Check if any dimension of the same name as the new variable is already defined
     853            DO  d = 1, SIZE( files(f)%dimensions )
     854               IF ( files(f)%dimensions(d)%name == variable%name )  THEN
     855                  return_value = 1
     856                  CALL internal_message( 'error', routine_name //                  &
     857                                         ': file "' // TRIM( filename ) //         &
     858                                         '" already has a dimension of name "' //  &
     859                                         TRIM( variable%name ) // '" defined. ' // &
     860                                         'Defining a variable of the same name is not allowed.' )
     861                  EXIT
     862               ENDIF
     863            ENDDO
     864
     865            !-- Check if dimensions assigned to variable are defined within file
     866            IF ( return_value == 0 )  THEN
     867               DO  i = 1, SIZE( variable%dimension_names )
     868                  found = .FALSE.
     869                  DO  d = 1, SIZE( files(f)%dimensions )
     870                     IF ( files(f)%dimensions(d)%name == variable%dimension_names(i) )  THEN
     871                        found = .TRUE.
     872                        EXIT
     873                     ENDIF
     874                  ENDDO
     875                  IF ( .NOT. found )  THEN
     876                     return_value = 1
     877                     CALL internal_message( 'error',                               &
     878                                            routine_name //                        &
     879                                            ': variable "' // TRIM( name ) //      &
     880                                            '" in file "' // TRIM( filename ) //   &
     881                                            '": required dimension "' //           &
     882                                            TRIM( variable%dimension_names(i) ) // &
     883                                            '" not defined' )
    842884                     EXIT
    843885                  ENDIF
    844886               ENDDO
    845                IF ( .NOT. found )  THEN
    846                   return_value = 1
    847                   CALL internal_message( 'error', &
    848                                          routine_name //                      &
    849                                          ': variable "' // TRIM( name ) //    &
    850                                          '" in file "' // TRIM( filename ) // &
    851                                          '": required dimension "' //         &
    852                                          TRIM( variable%dimension_names(i) ) // '" not defined' )
    853                   EXIT
    854                ENDIF
    855             ENDDO
     887            ENDIF
    856888
    857889         ELSE
    … …  
    12631295
    12641296      IF ( TRIM( filename ) == files(f)%name )  THEN
     1297
     1298         IF ( files(f)%is_init )  THEN
     1299            return_value = 1
     1300            CALL internal_message( 'error', routine_name // ': file "' // TRIM( filename ) // &
     1301                    '" is already initialized. No further attribute definition allowed!' )
     1302            EXIT
     1303         ENDIF
    12651304
    12661305         !-- Add attribute to file
    … …  
    13281367                        !-- Check if attribute already exists
    13291368                        DO  a = 1, natt
    1330                            IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name )  THEN
     1369                           IF ( files(f)%dimensions(d)%attributes(a)%name == attribute%name ) &
     1370                           THEN
    13311371                              IF ( append )  THEN
    13321372                                 !-- Append existing character attribute
    … …  
    13851425                        !-- Check if attribute already exists
    13861426                        DO  a = 1, natt
    1387                            IF ( files(f)%variables(d)%attributes(a)%name == attribute%name )  THEN
     1427                           IF ( files(f)%variables(d)%attributes(a)%name == attribute%name )  &
     1428                           THEN
    13881429                              IF ( append )  THEN
    13891430                                 !-- Append existing character attribute
    … …  
    14971538      DO  f = 1, nf
    14981539
     1540         !-- Skip initialization if file is already initialized
     1541         IF ( files(f)%is_init )  CYCLE
     1542
     1543         CALL internal_message( 'debug', routine_name // ': initialize file "' // &
     1544                                TRIM( files(f)%name ) // '"' )
     1545
    14991546         !-- Open file
    15001547         CALL open_output_file( files(f)%format, files(f)%name, files(f)%id, &
    1501                                 files(f)%is_init, return_value=return_value )
     1548                                return_value=return_value )
    15021549
    15031550         !-- Initialize file header:
    … …  
    15081555         !-- End file definition
    15091556         IF ( return_value == 0 )  &
    1510             CALL dom_init_end( files(f)%format, files(f)%id, return_value=return_value )
    1511 
    1512          !-- Write dimension values into file
     1557            CALL dom_init_end( files(f)%format, files(f)%id, files(f)%name, return_value )
     1558
    15131559         IF ( return_value == 0 )  THEN
    15141560
     1561            !-- Flag file as initialized
     1562            files(f)%is_init = .TRUE.
     1563
     1564            !-- Write dimension values into file
    15151565            DO  d = 1, SIZE( files(f)%dimensions )
    15161566               IF ( ALLOCATED( files(f)%dimensions(d)%values_int8 ) )  THEN
    … …  
    16281678   return_value = 0
    16291679
    1630    !-- Set flag for files to be initialized
     1680   !-- Flag files which contain output variables as used
    16311681   file_is_used(:) = .FALSE.
    16321682   DO  f = 1, nf
    … …  
    16571707   DO  f = 1, nf
    16581708
     1709      !-- If a file is already initialized, it was already checked previously
     1710      IF ( files(f)%is_init )  CYCLE
     1711
    16591712      !-- Get number of defined dimensions
    16601713      ndim = SIZE( files(f)%dimensions )
    … …  
    16991752!> Open requested output file.
    17001753!--------------------------------------------------------------------------------------------------!
    1701 SUBROUTINE open_output_file( file_format, filename, file_id, is_init, return_value )
     1754SUBROUTINE open_output_file( file_format, filename, file_id, return_value )
    17021755
    17031756   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
    … …  
    17061759   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'open_output_file'  !< name of routine
    17071760
    1708    INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
    1709    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    1710 
    1711    LOGICAL, INTENT(OUT) ::  is_init  !< true if file is opened
    1712 
     1761   INTEGER(iwp), INTENT(OUT) ::  file_id              !< file ID
     1762   INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
     1763   INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
     1764
     1765
     1766   return_value = 0
     1767   output_return_value = 0
    17131768
    17141769   SELECT CASE ( TRIM( file_format ) )
    17151770
    17161771      CASE ( 'binary' )
    1717          CALL binary_open_file( filename, file_id, return_value )
     1772         CALL binary_open_file( 'binary', filename, file_id, output_return_value )
    17181773
    17191774      CASE ( 'netcdf4-serial' )
    1720          CALL netcdf4_serial_open_file( filename, file_id, return_value )
     1775         CALL netcdf4_open_file( 'serial', filename, file_id, output_return_value )
    17211776
    17221777      CASE ( 'netcdf4-parallel' )
    1723          CALL netcdf4_parallel_open_file( filename, file_id, return_value )
     1778         CALL netcdf4_open_file( 'parallel', filename, file_id, output_return_value )
    17241779
    17251780      CASE DEFAULT
    17261781         return_value = 1
    1727          CALL internal_message( 'error', routine_name //                              &
    1728                                          ': file "' // TRIM( filename ) //            &
    1729                                          '": file format "' // TRIM( file_format ) // &
    1730                                          '" not supported' )
    17311782
    17321783   END SELECT
    17331784
    1734    is_init = return_value == 0
     1785   IF ( output_return_value /= 0 )  THEN
     1786      return_value = output_return_value
     1787      CALL internal_message( 'error', routine_name // &
     1788                             ': error while opening file "' // TRIM( filename ) // '"' )
     1789   ELSEIF ( return_value /= 0 )  THEN
     1790      CALL internal_message( 'error', routine_name //                              &
     1791                                      ': file "' // TRIM( filename ) //            &
     1792                                      '": file format "' // TRIM( file_format ) // &
     1793                                      '" not supported' )
     1794   ENDIF
    17351795
    17361796END SUBROUTINE open_output_file
    … …  
    17571817   IF ( ALLOCATED( file%attributes ) )  THEN
    17581818      DO  a = 1, SIZE( file%attributes )
    1759          return_value = write_attribute( file%format, file%id, var_id=no_var_id, &
    1760                                 attribute=file%attributes(a) )
     1819         return_value = write_attribute( file%format, file%id, file%name, var_id=no_var_id, &
     1820                                         attribute=file%attributes(a) )
    17611821         IF ( return_value /= 0 )  EXIT
    17621822      ENDDO
    … …  
    17711831
    17721832            !-- Initialize non-masked dimension
    1773             CALL init_file_dimension( file%format,                             &
    1774                     file%id, file%dimensions(d)%id, file%dimensions(d)%var_id, &
    1775                     file%dimensions(d)%name, file%dimensions(d)%data_type,     &
    1776                     file%dimensions(d)%length, file%dimensions(d)%is_init, return_value )
     1833            CALL init_file_dimension( file%format, file%id, file%name,     &
     1834                    file%dimensions(d)%id, file%dimensions(d)%var_id,      &
     1835                    file%dimensions(d)%name, file%dimensions(d)%data_type, &
     1836                    file%dimensions(d)%length, return_value )
    17771837
    17781838         ELSE
    17791839
    17801840            !-- Initialize masked dimension
    1781             CALL init_file_dimension( file%format,                             &
    1782                     file%id, file%dimensions(d)%id, file%dimensions(d)%var_id, &
    1783                     file%dimensions(d)%name, file%dimensions(d)%data_type,     &
    1784                     file%dimensions(d)%length_mask, file%dimensions(d)%is_init, return_value )
     1841            CALL init_file_dimension( file%format, file%id, file%name,     &
     1842                    file%dimensions(d)%id, file%dimensions(d)%var_id,      &
     1843                    file%dimensions(d)%name, file%dimensions(d)%data_type, &
     1844                    file%dimensions(d)%length_mask, return_value )
    17851845
    17861846         ENDIF
    … …  
    17891849            !-- Write dimension attributes
    17901850            DO  a = 1, SIZE( file%dimensions(d)%attributes )
    1791                return_value = write_attribute( file%format, file%id, file%dimensions(d)%var_id, &
     1851               return_value = write_attribute( file%format, file%id, file%name, &
     1852                                 var_id=file%dimensions(d)%var_id,              &
     1853                                 var_name=file%dimensions(d)%name,              &
    17921854                                 attribute=file%dimensions(d)%attributes(a) )
    17931855               IF ( return_value /= 0 )  EXIT
    … …  
    18071869         DO  d = 1, SIZE( file%variables )
    18081870
    1809             CALL init_file_variable( file%format, file%id, file%variables(d)%id, &
    1810                     file%variables(d)%name, file%variables(d)%data_type,        &
    1811                     file%variables(d)%dimension_ids,                             &
    1812                     file%variables(d)%is_init, file%variables(d)%is_global, return_value )
     1871            CALL init_file_variable( file%format, file%id, file%name,                          &
     1872                    file%variables(d)%id, file%variables(d)%name, file%variables(d)%data_type, &
     1873                    file%variables(d)%dimension_ids,                                           &
     1874                    file%variables(d)%is_global, return_value )
    18131875
    18141876            IF ( return_value == 0  .AND.  ALLOCATED( file%variables(d)%attributes ) )  THEN
    18151877               !-- Write variable attribures
    18161878               DO  a = 1, SIZE( file%variables(d)%attributes )
    1817                   return_value = write_attribute( file%format, file%id, file%variables(d)%id, &
     1879                  return_value = write_attribute( file%format, file%id, file%name, &
     1880                                    var_id=file%variables(d)%id,                   &
     1881                                    var_name=file%variables(d)%name,               &
    18181882                                    attribute=file%variables(d)%attributes(a) )
    18191883                  IF ( return_value /= 0 )  EXIT
    … …  
    18351899!> Write attribute to file.
    18361900!--------------------------------------------------------------------------------------------------!
    1837 FUNCTION write_attribute( file_format, file_id, var_id, attribute ) RESULT( return_value )
     1901FUNCTION write_attribute( file_format, file_id, file_name, var_id, var_name, attribute ) RESULT( return_value )
    18381902
    18391903   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
     1904   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
     1905   CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  var_name     !< variable name
    18401906
    18411907   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'write_attribute'  !< file format chosen for file
    18421908
    1843    INTEGER(iwp) ::  file_id       !< file ID
    1844    INTEGER(iwp) ::  return_value  !< return value
    1845    INTEGER(iwp) ::  var_id        !< variable ID
     1909   INTEGER(iwp), INTENT(IN) ::  file_id              !< file ID
     1910   INTEGER(iwp)             ::  return_value         !< return value
     1911   INTEGER(iwp)             ::  output_return_value  !< return value of a called output routine
     1912   INTEGER(iwp), INTENT(IN) ::  var_id               !< variable ID
    18461913
    18471914   TYPE(attribute_type), INTENT(IN) ::  attribute  !< attribute to be written
    18481915
    18491916
     1917   return_value = 0
     1918   output_return_value = 0
     1919
     1920   !-- Prepare for possible error message
     1921   IF ( PRESENT( var_name ) )  THEN
     1922      temp_string = '(file "' // TRIM( file_name ) //      &
     1923                    '", variable "' // TRIM( var_name ) // &
     1924                    '", attribute "' // TRIM( attribute%name ) // '")'
     1925   ELSE
     1926      temp_string = '(file "' // TRIM( file_name ) // &
     1927                    '", attribute "' // TRIM( attribute%name ) // '")'
     1928   ENDIF
     1929
     1930   !-- Write attribute to file
    18501931   SELECT CASE ( TRIM( file_format ) )
    18511932
    … …  
    18571938               CALL binary_write_attribute( file_id=file_id, var_id=var_id,          &
    18581939                       att_name=attribute%name, att_value_char=attribute%value_char, &
    1859                        return_value=return_value )
     1940                       return_value=output_return_value )
    18601941
    18611942            CASE( 'int8' )
    18621943               CALL binary_write_attribute( file_id=file_id, var_id=var_id,          &
    18631944                       att_name=attribute%name, att_value_int8=attribute%value_int8, &
    1864                        return_value=return_value )
     1945                       return_value=output_return_value )
    18651946
    18661947            CASE( 'int16' )
    18671948               CALL binary_write_attribute( file_id=file_id, var_id=var_id,            &
    18681949                       att_name=attribute%name, att_value_int16=attribute%value_int16, &
    1869                        return_value=return_value )
     1950                       return_value=output_return_value )
    18701951
    18711952            CASE( 'int32' )
    18721953               CALL binary_write_attribute( file_id=file_id, var_id=var_id,            &
    18731954                       att_name=attribute%name, att_value_int32=attribute%value_int32, &
    1874                        return_value=return_value )
     1955                       return_value=output_return_value )
    18751956
    18761957            CASE( 'real32' )
    18771958               CALL binary_write_attribute( file_id=file_id, var_id=var_id,              &
    18781959                       att_name=attribute%name, att_value_real32=attribute%value_real32, &
    1879                        return_value=return_value )
     1960                       return_value=output_return_value )
    18801961
    18811962            CASE( 'real64' )
    18821963               CALL binary_write_attribute( file_id=file_id, var_id=var_id,              &
    18831964                       att_name=attribute%name, att_value_real64=attribute%value_real64, &
    1884                        return_value=return_value )
     1965                       return_value=output_return_value )
    18851966
    18861967            CASE DEFAULT
    18871968               return_value = 1
    1888                CALL internal_message( 'error',                                          &
    1889                                       routine_name //                                   &
    1890                                       ': attribute "' // TRIM( attribute%name ) //      &
    1891                                       '": data type "'// TRIM( attribute%data_type ) // &
    1892                                       '" not supported for file format "binary".' )
     1969               CALL internal_message( 'error', routine_name //                     &
     1970                                      ': file format "' // TRIM( file_format ) //  &
     1971                                      '" does not support attribute data type "'// &
     1972                                      TRIM( attribute%data_type ) //              &
     1973                                      '" ' // TRIM( temp_string ) )
    18931974
    18941975         END SELECT
    18951976
    1896       CASE ( 'netcdf4-serial' )
     1977      CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    18971978
    18981979         SELECT CASE ( TRIM( attribute%data_type ) )
    18991980
    19001981            CASE( 'char' )
    1901                CALL netcdf4_serial_write_attribute( file_id=file_id, var_id=var_id,  &
     1982               CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,  &
    19021983                       att_name=attribute%name, att_value_char=attribute%value_char, &
    1903                        return_value=return_value )
     1984                       return_value=output_return_value )
    19041985
    19051986            CASE( 'int8' )
    1906                CALL netcdf4_serial_write_attribute( file_id=file_id, var_id=var_id,  &
     1987               CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,  &
    19071988                       att_name=attribute%name, att_value_int8=attribute%value_int8, &
    1908                        return_value=return_value )
     1989                       return_value=output_return_value )
    19091990
    19101991            CASE( 'int16' )
    1911                CALL netcdf4_serial_write_attribute( file_id=file_id, var_id=var_id,    &
     1992               CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,    &
    19121993                       att_name=attribute%name, att_value_int16=attribute%value_int16, &
    1913                        return_value=return_value )
     1994                       return_value=output_return_value )
    19141995
    19151996            CASE( 'int32' )
    1916                CALL netcdf4_serial_write_attribute( file_id=file_id, var_id=var_id,    &
     1997               CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,    &
    19171998                       att_name=attribute%name, att_value_int32=attribute%value_int32, &
    1918                        return_value=return_value )
     1999                       return_value=output_return_value )
    19192000
    19202001            CASE( 'real32' )
    1921                CALL netcdf4_serial_write_attribute( file_id=file_id, var_id=var_id,      &
     2002               CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,      &
    19222003                       att_name=attribute%name, att_value_real32=attribute%value_real32, &
    1923                        return_value=return_value )
     2004                       return_value=output_return_value )
    19242005
    19252006            CASE( 'real64' )
    1926                CALL netcdf4_serial_write_attribute( file_id=file_id, var_id=var_id,      &
     2007               CALL netcdf4_write_attribute( file_id=file_id, var_id=var_id,      &
    19272008                       att_name=attribute%name, att_value_real64=attribute%value_real64, &
    1928                        return_value=return_value )
     2009                       return_value=output_return_value )
    19292010
    19302011            CASE DEFAULT
    19312012               return_value = 1
    1932                CALL internal_message( 'error',                                          &
    1933                                       routine_name //                                   &
    1934                                       ': attribute "' // TRIM( attribute%name ) //      &
    1935                                       '": data type "'// TRIM( attribute%data_type ) // &
    1936                                       '" not supported for file format "netcdf4-serial".' )
    1937 
    1938          END SELECT
    1939 
    1940       CASE ( 'netcdf4-parallel' )
    1941 
    1942          SELECT CASE ( TRIM( attribute%data_type ) )
    1943 
    1944             CASE( 'char' )
    1945                CALL netcdf4_parallel_write_attribute( file_id=file_id, var_id=var_id, &
    1946                        att_name=attribute%name, att_value_char=attribute%value_char,  &
    1947                        return_value=return_value )
    1948 
    1949             CASE( 'int8' )
    1950                CALL netcdf4_parallel_write_attribute( file_id=file_id, var_id=var_id, &
    1951                        att_name=attribute%name, att_value_int8=attribute%value_int8,  &
    1952                        return_value=return_value )
    1953 
    1954             CASE( 'int16' )
    1955                CALL netcdf4_parallel_write_attribute( file_id=file_id, var_id=var_id,  &
    1956                        att_name=attribute%name, att_value_int16=attribute%value_int16, &
    1957                        return_value=return_value )
    1958 
    1959             CASE( 'int32' )
    1960                CALL netcdf4_parallel_write_attribute( file_id=file_id, var_id=var_id,  &
    1961                        att_name=attribute%name, att_value_int32=attribute%value_int32, &
    1962                        return_value=return_value )
    1963 
    1964             CASE( 'real32' )
    1965                CALL netcdf4_parallel_write_attribute( file_id=file_id, var_id=var_id,    &
    1966                        att_name=attribute%name, att_value_real32=attribute%value_real32, &
    1967                        return_value=return_value )
    1968 
    1969             CASE( 'real64' )
    1970                CALL netcdf4_parallel_write_attribute( file_id=file_id, var_id=var_id,    &
    1971                        att_name=attribute%name, att_value_real64=attribute%value_real64, &
    1972                        return_value=return_value )
    1973 
    1974             CASE DEFAULT
    1975                return_value = 1
    1976                CALL internal_message( 'error',                                          &
    1977                                       routine_name //                                   &
    1978                                       ': attribute "' // TRIM( attribute%name ) //      &
    1979                                       '": data type "'// TRIM( attribute%data_type ) // &
    1980                                       '" not supported for file format "netcdf4-parallel".' )
     2013               CALL internal_message( 'error', routine_name //                     &
     2014                                      ': file format "' // TRIM( file_format ) //  &
     2015                                      '" does not support attribute data type "'// &
     2016                                      TRIM( attribute%data_type ) //               &
     2017                                      '" ' // TRIM( temp_string ) )
    19812018
    19822019         END SELECT
    … …  
    19862023         CALL internal_message( 'error',        &
    19872024                                routine_name // &
    1988                                 ': unsupported file format "' // TRIM( file_format ) // '"' )
     2025                                ': unsupported file format "' // TRIM( file_format ) // &
     2026                                '" ' // TRIM( temp_string ) )
    19892027
    19902028   END SELECT
     2029   
     2030   IF ( output_return_value /= 0 )  THEN
     2031      return_value = output_return_value
     2032      CALL internal_message( 'error',        &
     2033                             routine_name // &
     2034                             ': error while writing attribute ' // TRIM( temp_string ) )
     2035   ENDIF
    19912036
    19922037END FUNCTION write_attribute
    … …  
    19972042!> Initialize dimension in file.
    19982043!--------------------------------------------------------------------------------------------------!
    1999 SUBROUTINE init_file_dimension( file_format, file_id, dim_id, var_id,        &
    2000                                 dim_name, dim_type, dim_length, is_init, return_value )
     2044SUBROUTINE init_file_dimension( file_format, file_id, file_name, dim_id, var_id, &
     2045                                dim_name, dim_type, dim_length, return_value )
    20012046
    20022047   CHARACTER(LEN=*), INTENT(IN) ::  dim_name     !< name of dimension
    20032048   CHARACTER(LEN=*), INTENT(IN) ::  dim_type     !< data type of dimension
    20042049   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
     2050   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< name of file
    20052051
    20062052   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_dimension'  !< file format chosen for file
    20072053
    2008    INTEGER(iwp), INTENT(OUT) ::  dim_id        !< dimension ID
    2009    INTEGER(iwp), INTENT(IN)  ::  dim_length    !< length of dimension
    2010    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    2011    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    2012    INTEGER(iwp), INTENT(OUT) ::  var_id        !< associated variable ID
    2013 
    2014    LOGICAL, INTENT(OUT) ::  is_init  !< true if dimension is initialized
    2015 
     2054   INTEGER(iwp), INTENT(OUT) ::  dim_id               !< dimension ID
     2055   INTEGER(iwp), INTENT(IN)  ::  dim_length           !< length of dimension
     2056   INTEGER(iwp), INTENT(IN)  ::  file_id              !< file ID
     2057   INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
     2058   INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
     2059   INTEGER(iwp), INTENT(OUT) ::  var_id               !< associated variable ID
     2060
     2061
     2062   return_value = 0
     2063   output_return_value = 0
     2064
     2065   temp_string = '(file "' // TRIM( file_name ) // &
     2066                 '", dimension "' // TRIM( dim_name ) // '")'
    20162067
    20172068   SELECT CASE ( TRIM( file_format ) )
    20182069
    20192070      CASE ( 'binary' )
    2020          CALL binary_init_dimension( file_id, dim_id, var_id, &
    2021                  dim_name, dim_type, dim_length, is_init, return_value )
     2071         CALL binary_init_dimension( 'binary', file_id, dim_id, var_id, &
     2072                 dim_name, dim_type, dim_length, return_value=output_return_value )
    20222073
    20232074      CASE ( 'netcdf4-serial' )
    2024          CALL netcdf4_serial_init_dimension( file_id, dim_id, var_id, &
    2025                  dim_name, dim_type, dim_length, is_init, return_value )
     2075         CALL netcdf4_init_dimension( 'serial', file_id, dim_id, var_id, &
     2076                 dim_name, dim_type, dim_length, return_value=output_return_value )
    20262077
    20272078      CASE ( 'netcdf4-parallel' )
    2028          CALL netcdf4_parallel_init_dimension( file_id, dim_id, var_id, &
    2029                  dim_name, dim_type, dim_length, is_init, return_value )
     2079         CALL netcdf4_init_dimension( 'parallel', file_id, dim_id, var_id, &
     2080                 dim_name, dim_type, dim_length, return_value=output_return_value )
    20302081
    20312082      CASE DEFAULT
    20322083         return_value = 1
    2033          WRITE( temp_string, * ) file_id
    2034          CALL internal_message( 'error', routine_name //                              &
    2035                                          ': file id = ' // TRIM( temp_string ) //     &
    2036                                          '": file format "' // TRIM( file_format ) // &
    2037                                          '" not supported' )
     2084         CALL internal_message( 'error', routine_name //                    &
     2085                                ': file format "' // TRIM( file_format ) // &
     2086                                '" not supported ' // TRIM( temp_string ) )
    20382087
    20392088   END SELECT
     2089
     2090   IF ( output_return_value /= 0 )  THEN
     2091      return_value = output_return_value
     2092      CALL internal_message( 'error', routine_name // &
     2093                             ': error while defining dimension ' // TRIM( temp_string ) )
     2094   ENDIF
    20402095
    20412096END SUBROUTINE init_file_dimension
    … …  
    20972152!> Initialize variable.
    20982153!--------------------------------------------------------------------------------------------------!
    2099 SUBROUTINE init_file_variable( file_format, file_id, var_id,   &
    2100                                var_name, var_type, var_dim_id, &
    2101                                is_init, is_global, return_value )
     2154SUBROUTINE init_file_variable( file_format, file_id, file_name,        &
     2155                               var_id, var_name, var_type, var_dim_id, &
     2156                               is_global, return_value )
    21022157
    21032158   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format chosen for file
     2159   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    21042160   CHARACTER(LEN=*), INTENT(IN) ::  var_name     !< name of variable
    21052161   CHARACTER(LEN=*), INTENT(IN) ::  var_type     !< data type of variable
    … …  
    21072163   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'init_file_variable'  !< file format chosen for file
    21082164
    2109    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    2110    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    2111    INTEGER(iwp), INTENT(OUT) ::  var_id        !< variable ID
     2165   INTEGER(iwp), INTENT(IN)  ::  file_id              !< file ID
     2166   INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
     2167   INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
     2168   INTEGER(iwp), INTENT(OUT) ::  var_id               !< variable ID
    21122169
    21132170   INTEGER(iwp), DIMENSION(:), INTENT(IN) ::  var_dim_id  !< list of dimension IDs used by variable
    21142171
    21152172   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global
    2116    LOGICAL, INTENT(OUT) ::  is_init    !< true if variable is initialized
    2117 
     2173
     2174
     2175   return_value = 0
     2176   output_return_value = 0
     2177
     2178   temp_string = '(file "' // TRIM( file_name ) // &
     2179                 '", variable "' // TRIM( var_name ) // '")'
    21182180
    21192181   SELECT CASE ( TRIM( file_format ) )
    21202182
    21212183      CASE ( 'binary' )
    2122          CALL binary_init_variable( file_id, var_id, var_name, var_type, var_dim_id, &
    2123                                     is_init, is_global, return_value )
     2184         CALL binary_init_variable( 'binary', file_id, var_id, var_name, var_type, &
     2185                                    var_dim_id, is_global, return_value=output_return_value )
    21242186
    21252187      CASE ( 'netcdf4-serial' )
    2126          CALL netcdf4_serial_init_variable( file_id, var_id, var_name, var_type, var_dim_id, &
    2127                                             is_init, is_global, return_value )
     2188         CALL netcdf4_init_variable( 'serial', file_id, var_id, var_name, var_type, &
     2189                                     var_dim_id, is_global, return_value=output_return_value )
    21282190
    21292191      CASE ( 'netcdf4-parallel' )
    2130          CALL netcdf4_parallel_init_variable( file_id, var_id, var_name, var_type, var_dim_id, &
    2131                                               is_init, is_global, return_value )
     2192         CALL netcdf4_init_variable( 'parallel', file_id, var_id, var_name, var_type, &
     2193                                     var_dim_id, is_global, return_value=output_return_value )
    21322194
    21332195      CASE DEFAULT
    21342196         return_value = 1
    2135          is_init = .FALSE.
    2136          CALL internal_message( 'error', routine_name // &
    2137                                 ': unsupported file format "' // TRIM( file_format ) )
     2197         CALL internal_message( 'error', routine_name //                    &
     2198                                ': file format "' // TRIM( file_format ) // &
     2199                                '" not supported ' // TRIM( temp_string ) )
    21382200
    21392201   END SELECT
     2202
     2203   IF ( output_return_value /= 0 )  THEN
     2204      return_value = output_return_value
     2205      CALL internal_message( 'error', routine_name // &
     2206                             ': error while defining variable ' // TRIM( temp_string ) )
     2207   ENDIF
    21402208
    21412209END SUBROUTINE init_file_variable
    … …  
    21482216!> @todo Do we need an MPI barrier at the end?
    21492217!--------------------------------------------------------------------------------------------------!
    2150 SUBROUTINE dom_init_end( file_format, file_id, return_value )
     2218SUBROUTINE dom_init_end( file_format, file_id, file_name, return_value )
    21512219
    21522220   CHARACTER(LEN=*), INTENT(IN) ::  file_format  !< file format
     2221   CHARACTER(LEN=*), INTENT(IN) ::  file_name    !< file name
    21532222
    21542223   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_init_end'  !< name of routine
    21552224
    2156    INTEGER(iwp), INTENT(IN)  ::  file_id       !< file id
    2157    INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    2158 
     2225   INTEGER(iwp), INTENT(IN)  ::  file_id              !< file id
     2226   INTEGER(iwp)              ::  output_return_value  !< return value of a called output routine
     2227   INTEGER(iwp), INTENT(OUT) ::  return_value         !< return value
     2228
     2229
     2230   return_value = 0
     2231   output_return_value = 0
     2232
     2233   temp_string = '(file "' // TRIM( file_name ) // '")'
    21592234
    21602235   SELECT CASE ( TRIM( file_format ) )
    21612236
    21622237      CASE ( 'binary' )
    2163          CALL binary_init_end( file_id, return_value )
    2164 
    2165       CASE ( 'netcdf4-serial' )
    2166          CALL netcdf4_serial_init_end( file_id, return_value )
    2167 
    2168       CASE ( 'netcdf4-parallel' )
    2169          CALL netcdf4_parallel_init_end( file_id, return_value )
     2238         CALL binary_init_end( file_id, output_return_value )
     2239
     2240      CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
     2241         CALL netcdf4_init_end( file_id, output_return_value )
    21702242
    21712243      CASE DEFAULT
    21722244         return_value = 1
    2173          WRITE( temp_string, * ) file_id
    2174          CALL internal_message( 'error', routine_name //                             &
    2175                                          ': file id = ' // TRIM( temp_string ) //    &
    2176                                          ': file format "' // TRIM( file_format ) // &
    2177                                          '" not supported' )
     2245         CALL internal_message( 'error', routine_name //                    &
     2246                                ': file format "' // TRIM( file_format ) // &
     2247                                '" not supported ' // TRIM( temp_string ) )
    21782248
    21792249   END SELECT
     2250
     2251   IF ( output_return_value /= 0 )  THEN
     2252      return_value = output_return_value
     2253      CALL internal_message( 'error', routine_name // &
     2254                             ': error while leaving file-definition state ' // &
     2255                             TRIM( temp_string ) )
     2256   ENDIF
    21802257
    21812258   ! CALL MPI_Barrier( MPI_COMM_WORLD, return_value )
    … …  
    22112288   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_write_var'  !< name of routine
    22122289
    2213    INTEGER(iwp) ::  d             !< loop index
    2214    INTEGER(iwp) ::  file_id       !< file ID
    2215    INTEGER(iwp) ::  i             !< loop index
    2216    INTEGER(iwp) ::  j             !< loop index
    2217    INTEGER(iwp) ::  k             !< loop index
    2218    INTEGER(iwp) ::  return_value  !< return value
    2219    INTEGER(iwp) ::  var_id        !< variable ID
     2290   INTEGER(iwp) ::  d                    !< loop index
     2291   INTEGER(iwp) ::  file_id              !< file ID
     2292   INTEGER(iwp) ::  i                    !< loop index
     2293   INTEGER(iwp) ::  j                    !< loop index
     2294   INTEGER(iwp) ::  k                    !< loop index
     2295   INTEGER(iwp) ::  output_return_value  !< return value of a called output routine
     2296   INTEGER(iwp) ::  return_value         !< return value
     2297   INTEGER(iwp) ::  var_id               !< variable ID
    22202298
    22212299   INTEGER(iwp), DIMENSION(:),   INTENT(IN)  ::  bounds_end        !< end index (upper bound) of variable at each dimension
    22222300   INTEGER(iwp), DIMENSION(:),   INTENT(IN)  ::  bounds_start      !< start index (lower bound) of variable at each dimension
    22232301   INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_dim_start  !< start index (lower bound) of each dimension of variable
    2224    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_end_new    !< start index (upper bound) of masked variable at each dimension
    2225    INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_start_new  !< start index (lower bound) of masked variable at each dimension
     2302   INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_end_new    !< start index (upper bound) of msked var at each dim
     2303   INTEGER(iwp), DIMENSION(:),   ALLOCATABLE ::  bounds_start_new  !< start index (lower bound) of msked var at each dim
    22262304   INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  masked_indices    !< dummy list holding all masked indices along a dimension
    22272305
    … …  
    23302408
    23312409
     2410   return_value = 0
     2411   output_return_value = 0
     2412
    23322413   CALL internal_message( 'debug', routine_name // ': write ' // TRIM( name ) // &
    23332414                                   ' into file ' // TRIM( filename ) )
    … …  
    23432424           SIZE( bounds_end ) /= SIZE( dimension_list ) )  THEN
    23442425         return_value = 1
    2345          CALL internal_message( 'error', routine_name //                      &
    2346                                          ': variable "' // TRIM( name ) //    &
    2347                                          '" in file "' // TRIM( filename ) // &
    2348                                          '": given bounds do not match with number of dimensions' )
     2426         CALL internal_message( 'error', routine_name //             &
     2427                                ': variable "' // TRIM( name ) //    &
     2428                                '" in file "' // TRIM( filename ) // &
     2429                                '": given bounds do not match with number of dimensions' )
    23492430      ENDIF
    23502431
    … …  
    28192900               CALL binary_write_variable( file_id, var_id,                                      &
    28202901                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2821                        var_int8_0d=var_int8_0d_pointer, return_value=return_value )
     2902                       var_int8_0d=var_int8_0d_pointer, return_value=output_return_value )
    28222903            ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    28232904               CALL binary_write_variable( file_id, var_id,                                      &
    28242905                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2825                        var_int8_1d=var_int8_1d_pointer, return_value=return_value )
     2906                       var_int8_1d=var_int8_1d_pointer, return_value=output_return_value )
    28262907            ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    28272908               CALL binary_write_variable( file_id, var_id,                                      &
    28282909                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2829                        var_int8_2d=var_int8_2d_pointer, return_value=return_value )
     2910                       var_int8_2d=var_int8_2d_pointer, return_value=output_return_value )
    28302911            ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    28312912               CALL binary_write_variable( file_id, var_id,                                      &
    28322913                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2833                        var_int8_3d=var_int8_3d_pointer, return_value=return_value )
     2914                       var_int8_3d=var_int8_3d_pointer, return_value=output_return_value )
    28342915            !-- 16bit integer output
    28352916            ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    28362917               CALL binary_write_variable( file_id, var_id,                                      &
    28372918                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2838                        var_int16_0d=var_int16_0d_pointer, return_value=return_value )
     2919                       var_int16_0d=var_int16_0d_pointer, return_value=output_return_value )
    28392920            ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    28402921               CALL binary_write_variable( file_id, var_id,                                      &
    28412922                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2842                        var_int16_1d=var_int16_1d_pointer, return_value=return_value )
     2923                       var_int16_1d=var_int16_1d_pointer, return_value=output_return_value )
    28432924            ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    28442925               CALL binary_write_variable( file_id, var_id,                                      &
    28452926                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2846                        var_int16_2d=var_int16_2d_pointer, return_value=return_value )
     2927                       var_int16_2d=var_int16_2d_pointer, return_value=output_return_value )
    28472928            ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    28482929               CALL binary_write_variable( file_id, var_id,                                      &
    28492930                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2850                        var_int16_3d=var_int16_3d_pointer, return_value=return_value )
     2931                       var_int16_3d=var_int16_3d_pointer, return_value=output_return_value )
    28512932            !-- 32bit integer output
    28522933            ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    28532934               CALL binary_write_variable( file_id, var_id,                                      &
    28542935                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2855                        var_int32_0d=var_int32_0d_pointer, return_value=return_value )
     2936                       var_int32_0d=var_int32_0d_pointer, return_value=output_return_value )
    28562937            ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    28572938               CALL binary_write_variable( file_id, var_id,                                      &
    28582939                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2859                        var_int32_1d=var_int32_1d_pointer, return_value=return_value )
     2940                       var_int32_1d=var_int32_1d_pointer, return_value=output_return_value )
    28602941            ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    28612942               CALL binary_write_variable( file_id, var_id,                                      &
    28622943                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2863                        var_int32_2d=var_int32_2d_pointer, return_value=return_value )
     2944                       var_int32_2d=var_int32_2d_pointer, return_value=output_return_value )
    28642945            ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    28652946               CALL binary_write_variable( file_id, var_id,                                      &
    28662947                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2867                        var_int32_3d=var_int32_3d_pointer, return_value=return_value )
     2948                       var_int32_3d=var_int32_3d_pointer, return_value=output_return_value )
    28682949            !-- working-precision integer output
    28692950            ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    28702951               CALL binary_write_variable( file_id, var_id,                                      &
    28712952                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2872                        var_intwp_0d=var_intwp_0d_pointer, return_value=return_value )
     2953                       var_intwp_0d=var_intwp_0d_pointer, return_value=output_return_value )
    28732954            ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    28742955               CALL binary_write_variable( file_id, var_id,                                      &
    28752956                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2876                        var_intwp_1d=var_intwp_1d_pointer, return_value=return_value )
     2957                       var_intwp_1d=var_intwp_1d_pointer, return_value=output_return_value )
    28772958            ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    28782959               CALL binary_write_variable( file_id, var_id,                                      &
    28792960                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2880                        var_intwp_2d=var_intwp_2d_pointer, return_value=return_value )
     2961                       var_intwp_2d=var_intwp_2d_pointer, return_value=output_return_value )
    28812962            ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    28822963               CALL binary_write_variable( file_id, var_id,                                      &
    28832964                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2884                        var_intwp_3d=var_intwp_3d_pointer, return_value=return_value )
     2965                       var_intwp_3d=var_intwp_3d_pointer, return_value=output_return_value )
    28852966            !-- 32bit real output
    28862967            ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    28872968               CALL binary_write_variable( file_id, var_id,                                      &
    28882969                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2889                        var_real32_0d=var_real32_0d_pointer, return_value=return_value )
     2970                       var_real32_0d=var_real32_0d_pointer, return_value=output_return_value )
    28902971            ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    28912972               CALL binary_write_variable( file_id, var_id,                                      &
    28922973                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2893                        var_real32_1d=var_real32_1d_pointer, return_value=return_value )
     2974                       var_real32_1d=var_real32_1d_pointer, return_value=output_return_value )
    28942975            ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    28952976               CALL binary_write_variable( file_id, var_id,                                      &
    28962977                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2897                        var_real32_2d=var_real32_2d_pointer, return_value=return_value )
     2978                       var_real32_2d=var_real32_2d_pointer, return_value=output_return_value )
    28982979            ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    28992980               CALL binary_write_variable( file_id, var_id,                                      &
    29002981                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2901                        var_real32_3d=var_real32_3d_pointer, return_value=return_value )
     2982                       var_real32_3d=var_real32_3d_pointer, return_value=output_return_value )
    29022983            !-- 64bit real output
    29032984            ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    29042985               CALL binary_write_variable( file_id, var_id,                                      &
    29052986                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2906                        var_real64_0d=var_real64_0d_pointer, return_value=return_value )
     2987                       var_real64_0d=var_real64_0d_pointer, return_value=output_return_value )
    29072988            ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    29082989               CALL binary_write_variable( file_id, var_id,                                      &
    29092990                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2910                        var_real64_1d=var_real64_1d_pointer, return_value=return_value )
     2991                       var_real64_1d=var_real64_1d_pointer, return_value=output_return_value )
    29112992            ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    29122993               CALL binary_write_variable( file_id, var_id,                                      &
    29132994                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2914                        var_real64_2d=var_real64_2d_pointer, return_value=return_value )
     2995                       var_real64_2d=var_real64_2d_pointer, return_value=output_return_value )
    29152996            ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    29162997               CALL binary_write_variable( file_id, var_id,                                      &
    29172998                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2918                        var_real64_3d=var_real64_3d_pointer, return_value=return_value )
     2999                       var_real64_3d=var_real64_3d_pointer, return_value=output_return_value )
    29193000            !-- working-precision real output
    29203001            ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    29213002               CALL binary_write_variable( file_id, var_id,                                      &
    29223003                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2923                        var_realwp_0d=var_realwp_0d_pointer, return_value=return_value )
     3004                       var_realwp_0d=var_realwp_0d_pointer, return_value=output_return_value )
    29243005            ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    29253006               CALL binary_write_variable( file_id, var_id,                                      &
    29263007                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2927                        var_realwp_1d=var_realwp_1d_pointer, return_value=return_value )
     3008                       var_realwp_1d=var_realwp_1d_pointer, return_value=output_return_value )
    29283009            ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    29293010               CALL binary_write_variable( file_id, var_id,                                      &
    29303011                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2931                        var_realwp_2d=var_realwp_2d_pointer, return_value=return_value )
     3012                       var_realwp_2d=var_realwp_2d_pointer, return_value=output_return_value )
    29323013            ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    29333014               CALL binary_write_variable( file_id, var_id,                                      &
    29343015                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2935                        var_realwp_3d=var_realwp_3d_pointer, return_value=return_value )
     3016                       var_realwp_3d=var_realwp_3d_pointer, return_value=output_return_value )
    29363017            ELSE
    29373018               return_value = 1
    2938                CALL internal_message( 'error', routine_name //                                    &
    2939                                                ': variable "' // TRIM( name ) //                  &
    2940                                                '" in file "' // TRIM( filename ) //               &
    2941                                                '": output_type not supported by file format "' // &
    2942                                                TRIM( file_format ) // '"' )
     3019               CALL internal_message( 'error', routine_name //                           &
     3020                                      ': variable "' // TRIM( name ) //                  &
     3021                                      '" in file "' // TRIM( filename ) //               &
     3022                                      '": output_type not supported by file format "' // &
     3023                                      TRIM( file_format ) // '"' )
    29433024            ENDIF
    29443025
    2945          CASE ( 'netcdf4-serial' )
     3026         CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
    29463027            !-- 8bit integer output
    29473028            IF ( PRESENT( var_int8_0d ) )  THEN
    2948                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2949                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2950                        var_int8_0d=var_int8_0d_pointer, return_value=return_value )
     3029               CALL netcdf4_write_variable( file_id, var_id,                              &
     3030                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3031                       var_int8_0d=var_int8_0d_pointer, return_value=output_return_value )
    29513032            ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    2952                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2953                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2954                        var_int8_1d=var_int8_1d_pointer, return_value=return_value )
     3033               CALL netcdf4_write_variable( file_id, var_id,                              &
     3034                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3035                       var_int8_1d=var_int8_1d_pointer, return_value=output_return_value )
    29553036            ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    2956                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2957                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2958                        var_int8_2d=var_int8_2d_pointer, return_value=return_value )
     3037               CALL netcdf4_write_variable( file_id, var_id,                              &
     3038                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3039                       var_int8_2d=var_int8_2d_pointer, return_value=output_return_value )
    29593040            ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    2960                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2961                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2962                        var_int8_3d=var_int8_3d_pointer, return_value=return_value )
     3041               CALL netcdf4_write_variable( file_id, var_id,                              &
     3042                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3043                       var_int8_3d=var_int8_3d_pointer, return_value=output_return_value )
    29633044            !-- 16bit integer output
    29643045            ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    2965                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2966                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2967                        var_int16_0d=var_int16_0d_pointer, return_value=return_value )
     3046               CALL netcdf4_write_variable( file_id, var_id,                              &
     3047                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3048                       var_int16_0d=var_int16_0d_pointer, return_value=output_return_value )
    29683049            ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    2969                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2970                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2971                        var_int16_1d=var_int16_1d_pointer, return_value=return_value )
     3050               CALL netcdf4_write_variable( file_id, var_id,                              &
     3051                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3052                       var_int16_1d=var_int16_1d_pointer, return_value=output_return_value )
    29723053            ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    2973                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2974                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2975                        var_int16_2d=var_int16_2d_pointer, return_value=return_value )
     3054               CALL netcdf4_write_variable( file_id, var_id,                              &
     3055                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3056                       var_int16_2d=var_int16_2d_pointer, return_value=output_return_value )
    29763057            ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    2977                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2978                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2979                        var_int16_3d=var_int16_3d_pointer, return_value=return_value )
     3058               CALL netcdf4_write_variable( file_id, var_id,                              &
     3059                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3060                       var_int16_3d=var_int16_3d_pointer, return_value=output_return_value )
    29803061            !-- 32bit integer output
    29813062            ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    2982                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2983                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2984                        var_int32_0d=var_int32_0d_pointer, return_value=return_value )
     3063               CALL netcdf4_write_variable( file_id, var_id,                              &
     3064                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3065                       var_int32_0d=var_int32_0d_pointer, return_value=output_return_value )
    29853066            ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    2986                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2987                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2988                        var_int32_1d=var_int32_1d_pointer, return_value=return_value )
     3067               CALL netcdf4_write_variable( file_id, var_id,                              &
     3068                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3069                       var_int32_1d=var_int32_1d_pointer, return_value=output_return_value )
    29893070            ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    2990                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2991                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2992                        var_int32_2d=var_int32_2d_pointer, return_value=return_value )
     3071               CALL netcdf4_write_variable( file_id, var_id,                              &
     3072                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3073                       var_int32_2d=var_int32_2d_pointer, return_value=output_return_value )
    29933074            ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    2994                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    2995                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    2996                        var_int32_3d=var_int32_3d_pointer, return_value=return_value )
     3075               CALL netcdf4_write_variable( file_id, var_id,                              &
     3076                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3077                       var_int32_3d=var_int32_3d_pointer, return_value=output_return_value )
    29973078            !-- working-precision integer output
    29983079            ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    2999                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3000                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3001                        var_intwp_0d=var_intwp_0d_pointer, return_value=return_value )
     3080               CALL netcdf4_write_variable( file_id, var_id,                              &
     3081                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3082                       var_intwp_0d=var_intwp_0d_pointer, return_value=output_return_value )
    30023083            ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    3003                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3004                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3005                        var_intwp_1d=var_intwp_1d_pointer, return_value=return_value )
     3084               CALL netcdf4_write_variable( file_id, var_id,                              &
     3085                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3086                       var_intwp_1d=var_intwp_1d_pointer, return_value=output_return_value )
    30063087            ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    3007                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3008                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3009                        var_intwp_2d=var_intwp_2d_pointer, return_value=return_value )
     3088               CALL netcdf4_write_variable( file_id, var_id,                              &
     3089                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3090                       var_intwp_2d=var_intwp_2d_pointer, return_value=output_return_value )
    30103091            ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    3011                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3012                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3013                        var_intwp_3d=var_intwp_3d_pointer, return_value=return_value )
     3092               CALL netcdf4_write_variable( file_id, var_id,                              &
     3093                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3094                       var_intwp_3d=var_intwp_3d_pointer, return_value=output_return_value )
    30143095            !-- 32bit real output
    30153096            ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    3016                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3017                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3018                        var_real32_0d=var_real32_0d_pointer, return_value=return_value )
     3097               CALL netcdf4_write_variable( file_id, var_id,                              &
     3098                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3099                       var_real32_0d=var_real32_0d_pointer, return_value=output_return_value )
    30193100            ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    3020                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3021                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3022                        var_real32_1d=var_real32_1d_pointer, return_value=return_value )
     3101               CALL netcdf4_write_variable( file_id, var_id,                              &
     3102                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3103                       var_real32_1d=var_real32_1d_pointer, return_value=output_return_value )
    30233104            ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    3024                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3025                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3026                        var_real32_2d=var_real32_2d_pointer, return_value=return_value )
     3105               CALL netcdf4_write_variable( file_id, var_id,                              &
     3106                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3107                       var_real32_2d=var_real32_2d_pointer, return_value=output_return_value )
    30273108            ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    3028                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3029                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3030                        var_real32_3d=var_real32_3d_pointer, return_value=return_value )
     3109               CALL netcdf4_write_variable( file_id, var_id,                              &
     3110                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3111                       var_real32_3d=var_real32_3d_pointer, return_value=output_return_value )
    30313112            !-- 64bit real output
    30323113            ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    3033                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3034                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3035                        var_real64_0d=var_real64_0d_pointer, return_value=return_value )
     3114               CALL netcdf4_write_variable( file_id, var_id,                              &
     3115                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3116                       var_real64_0d=var_real64_0d_pointer, return_value=output_return_value )
    30363117            ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    3037                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3038                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3039                        var_real64_1d=var_real64_1d_pointer, return_value=return_value )
     3118               CALL netcdf4_write_variable( file_id, var_id,                              &
     3119                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3120                       var_real64_1d=var_real64_1d_pointer, return_value=output_return_value )
    30403121            ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    3041                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3042                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3043                        var_real64_2d=var_real64_2d_pointer, return_value=return_value )
     3122               CALL netcdf4_write_variable( file_id, var_id,                              &
     3123                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3124                       var_real64_2d=var_real64_2d_pointer, return_value=output_return_value )
    30443125            ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    3045                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3046                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3047                        var_real64_3d=var_real64_3d_pointer, return_value=return_value )
     3126               CALL netcdf4_write_variable( file_id, var_id,                              &
     3127                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3128                       var_real64_3d=var_real64_3d_pointer, return_value=output_return_value )
    30483129            !-- working-precision real output
    30493130            ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    3050                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3051                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3052                        var_realwp_0d=var_realwp_0d_pointer, return_value=return_value )
     3131               CALL netcdf4_write_variable( file_id, var_id,                              &
     3132                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3133                       var_realwp_0d=var_realwp_0d_pointer, return_value=output_return_value )
    30533134            ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    3054                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3055                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3056                        var_realwp_1d=var_realwp_1d_pointer, return_value=return_value )
     3135               CALL netcdf4_write_variable( file_id, var_id,                              &
     3136                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3137                       var_realwp_1d=var_realwp_1d_pointer, return_value=output_return_value )
    30573138            ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    3058                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3059                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3060                        var_realwp_2d=var_realwp_2d_pointer, return_value=return_value )
     3139               CALL netcdf4_write_variable( file_id, var_id,                              &
     3140                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3141                       var_realwp_2d=var_realwp_2d_pointer, return_value=output_return_value )
    30613142            ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    3062                CALL netcdf4_serial_write_variable( file_id, var_id,                              &
    3063                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3064                        var_realwp_3d=var_realwp_3d_pointer, return_value=return_value )
     3143               CALL netcdf4_write_variable( file_id, var_id,                              &
     3144                       bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
     3145                       var_realwp_3d=var_realwp_3d_pointer, return_value=output_return_value )
    30653146            ELSE
    30663147               return_value = 1
    3067                CALL internal_message( 'error', routine_name //                                    &
    3068                                                ': variable "' // TRIM( name ) //                  &
    3069                                                '" in file "' // TRIM( filename ) //               &
    3070                                                '": output_type not supported by file format "' // &
    3071                                                TRIM( file_format ) // '"' )
    3072             ENDIF
    3073 
    3074          CASE ( 'netcdf4-parallel' )
    3075             !-- 8bit integer output
    3076             IF ( PRESENT( var_int8_0d ) )  THEN
    3077                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3078                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3079                        var_int8_0d=var_int8_0d_pointer, return_value=return_value )
    3080             ELSEIF ( PRESENT( var_int8_1d ) )  THEN
    3081                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3082                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3083                        var_int8_1d=var_int8_1d_pointer, return_value=return_value )
    3084             ELSEIF ( PRESENT( var_int8_2d ) )  THEN
    3085                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3086                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3087                        var_int8_2d=var_int8_2d_pointer, return_value=return_value )
    3088             ELSEIF ( PRESENT( var_int8_3d ) )  THEN
    3089                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3090                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3091                        var_int8_3d=var_int8_3d_pointer, return_value=return_value )
    3092             !-- 16bit integer output
    3093             ELSEIF ( PRESENT( var_int16_0d ) )  THEN
    3094                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3095                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3096                        var_int16_0d=var_int16_0d_pointer, return_value=return_value )
    3097             ELSEIF ( PRESENT( var_int16_1d ) )  THEN
    3098                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3099                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3100                        var_int16_1d=var_int16_1d_pointer, return_value=return_value )
    3101             ELSEIF ( PRESENT( var_int16_2d ) )  THEN
    3102                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3103                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3104                        var_int16_2d=var_int16_2d_pointer, return_value=return_value )
    3105             ELSEIF ( PRESENT( var_int16_3d ) )  THEN
    3106                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3107                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3108                        var_int16_3d=var_int16_3d_pointer, return_value=return_value )
    3109             !-- 32bit integer output
    3110             ELSEIF ( PRESENT( var_int32_0d ) )  THEN
    3111                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3112                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3113                        var_int32_0d=var_int32_0d_pointer, return_value=return_value )
    3114             ELSEIF ( PRESENT( var_int32_1d ) )  THEN
    3115                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3116                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3117                        var_int32_1d=var_int32_1d_pointer, return_value=return_value )
    3118             ELSEIF ( PRESENT( var_int32_2d ) )  THEN
    3119                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3120                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3121                        var_int32_2d=var_int32_2d_pointer, return_value=return_value )
    3122             ELSEIF ( PRESENT( var_int32_3d ) )  THEN
    3123                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3124                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3125                        var_int32_3d=var_int32_3d_pointer, return_value=return_value )
    3126             !-- working-precision integer output
    3127             ELSEIF ( PRESENT( var_intwp_0d ) )  THEN
    3128                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3129                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3130                        var_intwp_0d=var_intwp_0d_pointer, return_value=return_value )
    3131             ELSEIF ( PRESENT( var_intwp_1d ) )  THEN
    3132                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3133                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3134                        var_intwp_1d=var_intwp_1d_pointer, return_value=return_value )
    3135             ELSEIF ( PRESENT( var_intwp_2d ) )  THEN
    3136                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3137                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3138                        var_intwp_2d=var_intwp_2d_pointer, return_value=return_value )
    3139             ELSEIF ( PRESENT( var_intwp_3d ) )  THEN
    3140                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3141                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3142                        var_intwp_3d=var_intwp_3d_pointer, return_value=return_value )
    3143             !-- 32bit real output
    3144             ELSEIF ( PRESENT( var_real32_0d ) )  THEN
    3145                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3146                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3147                        var_real32_0d=var_real32_0d_pointer, return_value=return_value )
    3148             ELSEIF ( PRESENT( var_real32_1d ) )  THEN
    3149                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3150                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3151                        var_real32_1d=var_real32_1d_pointer, return_value=return_value )
    3152             ELSEIF ( PRESENT( var_real32_2d ) )  THEN
    3153                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3154                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3155                        var_real32_2d=var_real32_2d_pointer, return_value=return_value )
    3156             ELSEIF ( PRESENT( var_real32_3d ) )  THEN
    3157                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3158                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3159                        var_real32_3d=var_real32_3d_pointer, return_value=return_value )
    3160             !-- 64bit real output
    3161             ELSEIF ( PRESENT( var_real64_0d ) )  THEN
    3162                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3163                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3164                        var_real64_0d=var_real64_0d_pointer, return_value=return_value )
    3165             ELSEIF ( PRESENT( var_real64_1d ) )  THEN
    3166                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3167                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3168                        var_real64_1d=var_real64_1d_pointer, return_value=return_value )
    3169             ELSEIF ( PRESENT( var_real64_2d ) )  THEN
    3170                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3171                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3172                        var_real64_2d=var_real64_2d_pointer, return_value=return_value )
    3173             ELSEIF ( PRESENT( var_real64_3d ) )  THEN
    3174                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3175                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3176                        var_real64_3d=var_real64_3d_pointer, return_value=return_value )
    3177             !-- working-precision real output
    3178             ELSEIF ( PRESENT( var_realwp_0d ) )  THEN
    3179                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3180                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3181                        var_realwp_0d=var_realwp_0d_pointer, return_value=return_value )
    3182             ELSEIF ( PRESENT( var_realwp_1d ) )  THEN
    3183                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3184                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3185                        var_realwp_1d=var_realwp_1d_pointer, return_value=return_value )
    3186             ELSEIF ( PRESENT( var_realwp_2d ) )  THEN
    3187                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3188                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3189                        var_realwp_2d=var_realwp_2d_pointer, return_value=return_value )
    3190             ELSEIF ( PRESENT( var_realwp_3d ) )  THEN
    3191                CALL netcdf4_parallel_write_variable( file_id, var_id,                            &
    3192                        bounds_start_new, bounds_end_new, bounds_dim_start, do_output, is_global, &
    3193                        var_realwp_3d=var_realwp_3d_pointer, return_value=return_value )
    3194             ELSE
    3195                return_value = 1
    3196                CALL internal_message( 'error', routine_name //                                    &
    3197                                                ': variable "' // TRIM( name ) //                  &
    3198                                                '" in file "' // TRIM( filename ) //               &
    3199                                                '": output_type not supported by file format "' // &
    3200                                                TRIM( file_format ) // '"' )
     3148               CALL internal_message( 'error', routine_name //                           &
     3149                                      ': variable "' // TRIM( name ) //                  &
     3150                                      '" in file "' // TRIM( filename ) //               &
     3151                                      '": output_type not supported by file format "' // &
     3152                                      TRIM( file_format ) // '"' )
    32013153            ENDIF
    32023154
    … …  
    32103162      END SELECT
    32113163
     3164      IF ( return_value == 0  .AND.  output_return_value /= 0 )  THEN
     3165         return_value = 1
     3166         CALL internal_message( 'error', routine_name //                              &
     3167                                ': error while writing variable "' // TRIM( name ) // &
     3168                                '" in file "' // TRIM( filename ) // '"' )
     3169      ENDIF
     3170
    32123171   ENDIF
    32133172
    … …  
    32483207   DO  f = 1, nf
    32493208      IF ( TRIM( filename ) == TRIM( files(f)%name ) )  THEN
     3209         
     3210         IF ( .NOT. files(f)%is_init )  THEN
     3211            return_value = 1
     3212            CALL internal_message( 'error', routine_name //                    &
     3213                                   ': file "' // TRIM( filename ) //           &
     3214                                   '" is not initialized. ' //                 &
     3215                                   'Writing variable "' // TRIM( var_name ) // &
     3216                                   '" to file is impossible.' )
     3217            EXIT
     3218         ENDIF
     3219         
    32503220         file_id     = files(f)%id
    32513221         file_format = files(f)%format
    … …  
    34213391
    34223392   INTEGER(iwp) ::  return_value           !< return value
    3423    INTEGER(iwp) ::  return_value_internal  !< return value from called routines
     3393   INTEGER(iwp) ::  return_value_internal  !< error code after closing a single file
     3394   INTEGER(iwp) ::  output_return_value    !< return value from called routines
    34243395   INTEGER(iwp) ::  f                      !< loop index
    34253396
    … …  
    34293400   DO  f = 1, nf
    34303401
    3431       return_value_internal = 0
    3432 
    3433       SELECT CASE ( TRIM( files(f)%format ) )
    3434 
    3435          CASE ( 'binary' )
    3436             CALL binary_finalize( files(f)%id, return_value_internal )
    3437 
    3438          CASE ( 'netcdf4-serial' )
    3439             CALL netcdf4_serial_finalize( files(f)%id, return_value_internal )
    3440 
    3441          CASE ( 'netcdf4-parallel' )
    3442             CALL netcdf4_parallel_finalize( files(f)%id, return_value_internal )
    3443 
    3444          CASE DEFAULT
    3445             return_value_internal = 1
    3446             CALL internal_message( 'error', routine_name // &
    3447                                    ': unsupported file format "' // TRIM( files(f)%format ) )
    3448 
    3449       END SELECT
    3450 
    3451       IF ( return_value_internal /= 0 )  return_value = return_value_internal
     3402      IF ( files(f)%is_init )  THEN
     3403
     3404         output_return_value = 0
     3405         return_value_internal = 0
     3406
     3407         SELECT CASE ( TRIM( files(f)%format ) )
     3408
     3409            CASE ( 'binary' )
     3410               CALL binary_finalize( files(f)%id, output_return_value )
     3411
     3412            CASE ( 'netcdf4-parallel', 'netcdf4-serial' )
     3413               CALL netcdf4_finalize( files(f)%id, output_return_value )
     3414
     3415            CASE DEFAULT
     3416               return_value_internal = 1
     3417
     3418         END SELECT
     3419
     3420         IF ( output_return_value /= 0 )  THEN
     3421            return_value = output_return_value
     3422            CALL internal_message( 'error', routine_name //             &
     3423                                   ': error while finalizing file "' // &
     3424                                   TRIM( files(f)%name ) // '"' )
     3425         ELSEIF ( return_value_internal /= 0 )  THEN
     3426            return_value = return_value_internal
     3427            CALL internal_message( 'error', routine_name //         &
     3428                                   ': unsupported file format "' // &
     3429                                   TRIM( files(f)%format ) // '"' )
     3430         ENDIF
     3431
     3432      ENDIF
    34523433
    34533434   ENDDO
    … …  
    34883469
    34893470   CHARACTER(LEN=800), INTENT(OUT) ::  error_message         !< return error message to main program
    3490    CHARACTER(LEN=800)              ::  module_error_message  !< error message created by other module
    3491 
    3492 
    3493    CALL binary_get_error_message( module_error_message )
    3494    internal_error_message = TRIM( internal_error_message ) // module_error_message
    3495 
    3496    CALL netcdf4_serial_get_error_message( module_error_message )
    3497    internal_error_message = TRIM( internal_error_message ) // module_error_message
    3498 
    3499    CALL netcdf4_parallel_get_error_message( module_error_message )
    3500    internal_error_message = TRIM( internal_error_message ) // module_error_message
     3471   CHARACTER(LEN=800)              ::  output_error_message  !< error message created by other module
     3472
     3473
     3474   CALL binary_get_error_message( output_error_message )
     3475   internal_error_message = TRIM( internal_error_message ) // output_error_message
     3476
     3477   CALL netcdf4_get_error_message( output_error_message )
     3478   internal_error_message = TRIM( internal_error_message ) // output_error_message
    35013479
    35023480   error_message = internal_error_message

  • palm/trunk/SOURCE/data_output_netcdf4_module.f90

    r4105 r4106  
    1 !> @file data_output_netcdf4_parallel_module.f90
     1!> @file data_output_netcdf4_module.f90
    22!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    … …  
    2020! Current revisions:
    2121! ------------------
    22 ! 
    23 ! 
     22!
     23!
    2424! Former revisions:
    2525! -----------------
    … …  
    3434! Description:
    3535! ------------
    36 !> NetCDF output module to write data to NetCDF files using parallel NetCDF.
    37 !>
    38 !> @todo Think of removing 'is_init' as its value can be derived from the return
    39 !>       value of 'return_value'.
    40 !--------------------------------------------------------------------------------------------------!
    41 MODULE data_output_netcdf4_parallel_module
     36!> NetCDF output module to write data to NetCDF files.
     37!> This is either done in parallel mode via parallel NetCDF4 I/O or in serial mode only by PE0.
     38!--------------------------------------------------------------------------------------------------!
     39MODULE data_output_netcdf4_module
    4240
    4341   USE kinds
    … …  
    5149#endif
    5250
    53 #if defined( __netcdf4_parallel )
     51#if defined( __netcdf4 )
    5452   USE NETCDF
    5553#endif
    … …  
    6058   CHARACTER(LEN=800) ::  temp_string                  !< dummy string
    6159
     60   CHARACTER(LEN=*), PARAMETER ::  mode_parallel = 'parallel'  !< string selecting netcdf4 parallel mode
     61   CHARACTER(LEN=*), PARAMETER ::  mode_serial   = 'serial'    !< string selecting netcdf4 serial mode
     62
    6263   INTEGER(iwp) ::  debug_output_unit       !< Fortran Unit Number of the debug-output file
    6364   INTEGER(iwp) ::  global_id_in_file = -1  !< value of global ID within a file
    … …  
    6970   PRIVATE
    7071
    71    INTERFACE netcdf4_parallel_init_module
    72       MODULE PROCEDURE netcdf4_parallel_init_module
    73    END INTERFACE netcdf4_parallel_init_module
    74 
    75    INTERFACE netcdf4_parallel_open_file
    76       MODULE PROCEDURE netcdf4_parallel_open_file
    77    END INTERFACE netcdf4_parallel_open_file
    78 
    79    INTERFACE netcdf4_parallel_init_dimension
    80       MODULE PROCEDURE netcdf4_parallel_init_dimension
    81    END INTERFACE netcdf4_parallel_init_dimension
    82 
    83    INTERFACE netcdf4_parallel_init_variable
    84       MODULE PROCEDURE netcdf4_parallel_init_variable
    85    END INTERFACE netcdf4_parallel_init_variable
    86 
    87    INTERFACE netcdf4_parallel_write_attribute
    88       MODULE PROCEDURE netcdf4_parallel_write_attribute
    89    END INTERFACE netcdf4_parallel_write_attribute
    90 
    91    INTERFACE netcdf4_parallel_init_end
    92       MODULE PROCEDURE netcdf4_parallel_init_end
    93    END INTERFACE netcdf4_parallel_init_end
    94 
    95    INTERFACE netcdf4_parallel_write_variable
    96       MODULE PROCEDURE netcdf4_parallel_write_variable
    97    END INTERFACE netcdf4_parallel_write_variable
    98 
    99    INTERFACE netcdf4_parallel_finalize
    100       MODULE PROCEDURE netcdf4_parallel_finalize
    101    END INTERFACE netcdf4_parallel_finalize
    102 
    103    INTERFACE netcdf4_parallel_get_error_message
    104       MODULE PROCEDURE netcdf4_parallel_get_error_message
    105    END INTERFACE netcdf4_parallel_get_error_message
     72   INTERFACE netcdf4_init_module
     73      MODULE PROCEDURE netcdf4_init_module
     74   END INTERFACE netcdf4_init_module
     75
     76   INTERFACE netcdf4_open_file
     77      MODULE PROCEDURE netcdf4_open_file
     78   END INTERFACE netcdf4_open_file
     79
     80   INTERFACE netcdf4_init_dimension
     81      MODULE PROCEDURE netcdf4_init_dimension
     82   END INTERFACE netcdf4_init_dimension
     83
     84   INTERFACE netcdf4_init_variable
     85      MODULE PROCEDURE netcdf4_init_variable
     86   END INTERFACE netcdf4_init_variable
     87
     88   INTERFACE netcdf4_write_attribute
     89      MODULE PROCEDURE netcdf4_write_attribute
     90   END INTERFACE netcdf4_write_attribute
     91
     92   INTERFACE netcdf4_init_end
     93      MODULE PROCEDURE netcdf4_init_end
     94   END INTERFACE netcdf4_init_end
     95
     96   INTERFACE netcdf4_write_variable
     97      MODULE PROCEDURE netcdf4_write_variable
     98   END INTERFACE netcdf4_write_variable
     99
     100   INTERFACE netcdf4_finalize
     101      MODULE PROCEDURE netcdf4_finalize
     102   END INTERFACE netcdf4_finalize
     103
     104   INTERFACE netcdf4_get_error_message
     105      MODULE PROCEDURE netcdf4_get_error_message
     106   END INTERFACE netcdf4_get_error_message
    106107
    107108   PUBLIC &
    108       netcdf4_parallel_finalize, &
    109       netcdf4_parallel_get_error_message, &
    110       netcdf4_parallel_init_dimension, &
    111       netcdf4_parallel_init_end, &
    112       netcdf4_parallel_init_module, &
    113       netcdf4_parallel_init_variable, &
    114       netcdf4_parallel_open_file, &
    115       netcdf4_parallel_write_attribute, &
    116       netcdf4_parallel_write_variable
     109      netcdf4_finalize, &
     110      netcdf4_get_error_message, &
     111      netcdf4_init_dimension, &
     112      netcdf4_init_end, &
     113      netcdf4_init_module, &
     114      netcdf4_init_variable, &
     115      netcdf4_open_file, &
     116      netcdf4_write_attribute, &
     117      netcdf4_write_variable
    117118
    118119
    … …  
    125126!> Initialize data-output module.
    126127!--------------------------------------------------------------------------------------------------!
    127 SUBROUTINE netcdf4_parallel_init_module( program_debug_output_unit, debug_output, dom_global_id )
     128SUBROUTINE netcdf4_init_module( program_debug_output_unit, debug_output, dom_global_id )
    128129
    129130   INTEGER(iwp), INTENT(IN) ::  dom_global_id              !< global id within a file defined by DOM
    … …  
    139140   global_id_in_file = dom_global_id
    140141
    141 
    142 END SUBROUTINE netcdf4_parallel_init_module
     142END SUBROUTINE netcdf4_init_module
    143143
    144144!--------------------------------------------------------------------------------------------------!
    … …  
    147147!> Open netcdf file.
    148148!--------------------------------------------------------------------------------------------------!
    149 SUBROUTINE netcdf4_parallel_open_file( filename, file_id, return_value )
     149SUBROUTINE netcdf4_open_file( mode, filename, file_id, return_value )
    150150
    151151   CHARACTER(LEN=*), INTENT(IN) ::  filename  !< name of file
    152 
    153    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_open_file'  !< name of this routine
     152   CHARACTER(LEN=*), INTENT(IN) ::  mode      !< operation mode (either parallel or serial)
     153
     154   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_open_file'  !< name of this routine
    154155
    155156   INTEGER(iwp), INTENT(OUT) ::  file_id       !< file ID
    … …  
    158159
    159160
    160 #if defined( __parallel ) && defined( __netcdf4_parallel )
    161161   return_value = 0
    162162
    … …  
    164164   CALL internal_message( 'debug', routine_name // ': create file "' // TRIM( filename ) // '"' )
    165165
    166    nc_stat = NF90_CREATE( TRIM( filename ),                                       &
    167                           IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
    168                           file_id, COMM = MPI_COMM_WORLD, INFO = MPI_INFO_NULL )
    169 
     166   IF ( TRIM( mode ) == mode_serial )  THEN
     167
     168#if defined( __netcdf4 )
     169      nc_stat = NF90_CREATE( TRIM( filename ),                    &
     170                             IOR( NF90_NOCLOBBER, NF90_NETCDF4 ), &
     171                             file_id )
     172#else
     173      file_id = -1
     174      nc_stat = 0
     175      return_value = 1
     176      CALL internal_message( 'error', routine_name //                               &
     177                             ': pre-processor directive "__netcdf4" not given. ' // &
     178                             'Using NetCDF4 output not possible' )
     179#endif
     180
     181   ELSEIF ( TRIM( mode ) == mode_parallel )  THEN
     182
     183#if defined( __parallel ) && defined( __netcdf4 ) && defined( __netcdf4_parallel )
     184      nc_stat = NF90_CREATE( TRIM( filename ),                                       &
     185                             IOR( NF90_NOCLOBBER, IOR( NF90_NETCDF4, NF90_MPIIO ) ), &
     186                             file_id, COMM = MPI_COMM_WORLD, INFO = MPI_INFO_NULL )
     187#else
     188      file_id = -1
     189      nc_stat = 0
     190      return_value = 1
     191      CALL internal_message( 'error', routine_name //                                 &
     192                             ': pre-processor directives "__parallel" and/or ' //     &
     193                             '"__netcdf4" and/or "__netcdf4_parallel" not given. ' // &
     194                             'Using parallel NetCDF4 output not possible' )
     195#endif
     196
     197   ELSE
     198      file_id = -1
     199      nc_stat = 0
     200      return_value = 1
     201      CALL internal_message( 'error', routine_name // ': selected mode "' // &
     202                                      TRIM( mode ) // '" must be either "' // &
     203                                      mode_serial // '" or "' // mode_parallel // '"' )
     204   ENDIF
     205
     206#if defined( __netcdf4 )
    170207   IF ( nc_stat /= NF90_NOERR )  THEN
    171208      return_value = 1
    … …  
    173210                                      TRIM( filename ) // '": ' // NF90_STRERROR( nc_stat ) )
    174211   ENDIF
    175 #else
    176    file_id = -1
    177    nc_stat = 0
    178    return_value = 1
    179    CALL internal_message( 'error', routine_name //                      &
    180                           ': pre-processor directives "__parallel" ' // &
    181                           'and/or "__netcdf4_parallel" not given. ' //  &
    182                           'Using parallel NetCDF4 output not possible' )
    183 #endif
    184 
    185 END SUBROUTINE netcdf4_parallel_open_file
     212#endif
     213
     214END SUBROUTINE netcdf4_open_file
    186215
    187216!--------------------------------------------------------------------------------------------------!
    … …  
    190219!> Write attribute to netcdf file.
    191220!--------------------------------------------------------------------------------------------------!
    192 SUBROUTINE netcdf4_parallel_write_attribute( file_id, var_id, att_name, att_value_char, &
    193                  att_value_int8, att_value_int16, att_value_int32,                      &
     221SUBROUTINE netcdf4_write_attribute( file_id, var_id, att_name, att_value_char, &
     222                 att_value_int8, att_value_int16, att_value_int32,             &
    194223                 att_value_real32, att_value_real64, return_value )
    195224
    … …  
    197226   CHARACTER(LEN=*), INTENT(IN), OPTIONAL ::  att_value_char  !< value of attribute
    198227
    199    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_write_attribute'  !< name of this routine
     228   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_attribute'  !< name of this routine
    200229
    201230   INTEGER(iwp) ::  nc_stat    !< netcdf return value
    … …  
    214243
    215244
    216 #if defined( __netcdf4_parallel )
     245#if defined( __netcdf4 )
    217246   return_value = 0
    218247
    … …  
    256285#endif
    257286
    258 END SUBROUTINE netcdf4_parallel_write_attribute
     287END SUBROUTINE netcdf4_write_attribute
    259288
    260289!--------------------------------------------------------------------------------------------------!
    … …  
    263292!> Initialize dimension.
    264293!--------------------------------------------------------------------------------------------------!
    265 SUBROUTINE netcdf4_parallel_init_dimension( file_id, dim_id, var_id, &
    266               dim_name, dim_type, dim_length, is_init, return_value )
     294SUBROUTINE netcdf4_init_dimension( mode, file_id, dim_id, var_id, &
     295              dim_name, dim_type, dim_length, return_value )
    267296
    268297   CHARACTER(LEN=*), INTENT(IN) ::  dim_name  !< name of dimension
    269298   CHARACTER(LEN=*), INTENT(IN) ::  dim_type  !< data type of dimension
    270 
    271    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_init_dimension'  !< name of this routine
     299   CHARACTER(LEN=*), INTENT(IN) ::  mode      !< operation mode (either parallel or serial)
     300
     301   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_dimension'  !< name of this routine
    272302
    273303   INTEGER(iwp), INTENT(OUT) ::  dim_id         !< dimension ID
    … …  
    279309   INTEGER(iwp), INTENT(OUT) ::  var_id         !< variable ID
    280310
    281    LOGICAL, INTENT(OUT) ::  is_init  !< true if dimension is initialized
    282 
    283 
    284 #if defined( __netcdf4_parallel )
     311
     312#if defined( __netcdf4 )
    285313   return_value = 0
    286314   var_id = -1
    287315
    288    CALL internal_message( 'debug', routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )
     316   CALL internal_message( 'debug', &
     317                          routine_name // ': init dimension "' // TRIM( dim_name ) // '"' )
    289318
    290319   !-- Check if dimension is unlimited
    … …  
    301330
    302331      !-- Define variable holding dimension values in file
    303       CALL netcdf4_parallel_init_variable( file_id, var_id, dim_name, dim_type, (/dim_id/), &
    304                                            is_init, is_global=.TRUE., return_value=return_value )
     332      CALL netcdf4_init_variable( mode, file_id, var_id, dim_name, dim_type, (/dim_id/), &
     333                                           is_global=.TRUE., return_value=return_value )
    305334
    306335   ELSE
    307336      return_value = 1
    308       is_init = .FALSE.
    309337      CALL internal_message( 'error', routine_name //                                    &
    310338                                      ': NetCDF error while initializing dimension "' // &
    … …  
    315343   var_id = -1
    316344   dim_id = -1
    317    is_init = .FALSE.
    318 #endif
    319 
    320 END SUBROUTINE netcdf4_parallel_init_dimension
     345#endif
     346
     347END SUBROUTINE netcdf4_init_dimension
    321348
    322349!--------------------------------------------------------------------------------------------------!
    … …  
    325352!> Initialize variable.
    326353!--------------------------------------------------------------------------------------------------!
    327 SUBROUTINE netcdf4_parallel_init_variable( file_id, var_id, var_name, var_type, var_dim_ids, &
    328                                            is_init, is_global, return_value )
    329 
     354SUBROUTINE netcdf4_init_variable( mode, file_id, var_id, var_name, var_type, var_dim_ids, &
     355                                  is_global, return_value )
     356
     357   CHARACTER(LEN=*), INTENT(IN) ::  mode      !< operation mode (either parallel or serial)
    330358   CHARACTER(LEN=*), INTENT(IN) ::  var_name  !< name of variable
    331359   CHARACTER(LEN=*), INTENT(IN) ::  var_type  !< data type of variable
    332360
    333    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_init_variable'  !< name of this routine
     361   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_variable'  !< name of this routine
    334362
    335363   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    … …  
    342370
    343371   LOGICAL, INTENT(IN)  ::  is_global  !< true if variable is global (same on all PE)
    344    LOGICAL, INTENT(OUT) ::  is_init    !< true if variable is initialized
    345 
    346 
    347 #if defined( __netcdf4_parallel )
     372
     373
     374#if defined( __netcdf4 )
    348375   return_value = 0
    349376
    … …  
    359386      nc_stat = NF90_DEF_VAR( file_id, var_name, nc_var_type, var_dim_ids, var_id )
    360387
    361       IF ( nc_stat == NF90_NOERR )  THEN
     388#if defined( __netcdf4_parallel )
     389      !-- Define how variable can be accessed by PEs in parallel netcdf file
     390      IF ( nc_stat == NF90_NOERR  .AND.  TRIM( mode ) == mode_parallel )  THEN
    362391         IF ( is_global )  THEN
    363392            nc_stat = NF90_VAR_PAR_ACCESS( file_id, var_id, NF90_INDEPENDENT )
    … …  
    366395         ENDIF
    367396      ENDIF
     397#endif
    368398
    369399      IF ( nc_stat /= NF90_NOERR)  THEN
    … …  
    378408   ENDIF
    379409
    380    is_init = return_value == 0
    381410#else
    382411   return_value = 1
    383412   var_id = -1
    384    is_init = .FALSE.
    385 #endif
    386 
    387 END SUBROUTINE netcdf4_parallel_init_variable
     413#endif
     414
     415END SUBROUTINE netcdf4_init_variable
    388416
    389417!--------------------------------------------------------------------------------------------------!
    … …  
    392420!> Leave file definition state.
    393421!--------------------------------------------------------------------------------------------------!
    394 SUBROUTINE netcdf4_parallel_init_end( file_id, return_value )
    395 
    396    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_init_end'  !< name of this routine
     422SUBROUTINE netcdf4_init_end( file_id, return_value )
     423
     424   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_init_end'  !< name of this routine
    397425
    398426   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    … …  
    402430
    403431
    404 #if defined( __netcdf4_parallel )
     432#if defined( __netcdf4 )
    405433   return_value = 0
    406434
    … …  
    426454#endif
    427455
    428 END SUBROUTINE netcdf4_parallel_init_end
     456END SUBROUTINE netcdf4_init_end
    429457
    430458!--------------------------------------------------------------------------------------------------!
    … …  
    433461!> Write variable of different kind into netcdf file.
    434462!--------------------------------------------------------------------------------------------------!
    435 SUBROUTINE netcdf4_parallel_write_variable(                               &
     463SUBROUTINE netcdf4_write_variable(                                        &
    436464              file_id, var_id, bounds_start, bounds_end, bounds_origin,   &
    437465              do_output, is_global,                                       &
    … …  
    445473              return_value )
    446474
    447    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_write_variable'  !< name of this routine
    448 
     475   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_write_variable'  !< name of this routine
     476
     477   INTEGER(iwp)              ::  d             !< loop index
    449478   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    450    INTEGER(iwp)              ::  myid = 0      !< id number of processor element
     479   INTEGER(iwp)              ::  myid          !< id number of processor element
    451480   INTEGER(iwp)              ::  nc_stat       !< netcdf return value
     481   INTEGER(iwp)              ::  ndim          !< number of dimensions of variable in file
    452482   INTEGER(iwp), INTENT(OUT) ::  return_value  !< return value
    453483   INTEGER(iwp), INTENT(IN)  ::  var_id        !< variable ID
    … …  
    456486   INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  bounds_end     !< ending index of variable
    457487   INTEGER(iwp), DIMENSION(:), INTENT(IN)  ::  bounds_start   !< starting index of variable
     488   INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_ids        !< IDs of dimensions of variable in file
     489   INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  dim_lengths    !< length of dimensions of variable in file
    458490   INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  value_count    !< count of values along each dimension to be written
    459491
    … …  
    497529
    498530
    499 #if defined( __netcdf4_parallel )
    500    return_value = 0
     531#if defined( __netcdf4 )
    501532
    502533#if defined( __parallel )
    … …  
    505536      CALL internal_message( 'error', routine_name // ': MPI_COMM_RANK error' )
    506537   ENDIF
     538#else
     539   myid = 0
     540   return_value = 0
    507541#endif
    508542
    … …  
    512546      CALL internal_message( 'debug', routine_name // ': write variable ' // TRIM( temp_string ) )
    513547
    514       ALLOCATE( value_count(SIZE( bounds_start )) )
     548      ndim = SIZE( bounds_start )
     549
     550      ALLOCATE( value_count(ndim) )
    515551
    516552      IF ( do_output ) THEN
    … …  
    651687      IF ( nc_stat /= NF90_NOERR )  THEN
    652688         return_value = 1
    653          WRITE( temp_string, * ) 'variable_id=', var_id, '; file_id=', file_id, &
    654                                  ', bounds_start=', bounds_start,               &
    655                                  ', bounds_end=', bounds_end,                   &
    656                                  ', count=', value_count
    657          CALL internal_message( 'error', routine_name //                                    &
    658                                          ': error while writing ' // TRIM( temp_string ) // &
    659                                          ': NetCDF error: ' // NF90_STRERROR( nc_stat ) )
     689
     690         IF ( nc_stat == NF90_EEDGE .OR. nc_stat == NF90_EINVALCOORDS )  THEN
     691
     692            !-- If given bounds exceed dimension bounds, get information of bounds in file
     693            WRITE( temp_string, * )  NF90_STRERROR( nc_stat )
     694
     695            ALLOCATE( dim_ids(ndim) )
     696            ALLOCATE( dim_lengths(ndim) )
     697
     698            nc_stat = NF90_INQUIRE_VARIABLE( file_id, var_id, dimids=dim_ids )
     699
     700            d = 1
     701            DO WHILE ( d <= ndim .AND. nc_stat == NF90_NOERR )
     702               nc_stat = NF90_INQUIRE_DIMENSION( file_id, dim_ids(d), len=dim_lengths(d) )
     703               d = d + 1
     704            ENDDO
     705
     706            IF ( nc_stat == NF90_NOERR )  THEN
     707               WRITE( temp_string, * )  TRIM( temp_string ) // '; given variable bounds: ' //  &
     708                  'start=', bounds_start, ', end=', bounds_end, '; file dimension bounds: ' // &
     709                  'start=', bounds_origin, ', end=', bounds_origin + dim_lengths - 1
     710               CALL internal_message( 'error', routine_name //     &
     711                                      ': error while writing: ' // &
     712                                      TRIM( temp_string ) )
     713            ELSE
     714               !-- Error occured during NF90_INQUIRE_VARIABLE or NF90_INQUIRE_DIMENSION
     715               CALL internal_message( 'error', routine_name //            &
     716                                      ': error while accessing file: ' // &
     717                                      NF90_STRERROR( nc_stat ) )
     718            ENDIF
     719
     720         ELSE
     721            !-- Other NetCDF error
     722            CALL internal_message( 'error', routine_name //     &
     723                                   ': error while writing: ' // &
     724                                   NF90_STRERROR( nc_stat ) )
     725         ENDIF
    660726      ENDIF
    661727
    … …  
    665731#endif
    666732
    667 END SUBROUTINE netcdf4_parallel_write_variable
     733END SUBROUTINE netcdf4_write_variable
    668734
    669735!--------------------------------------------------------------------------------------------------!
    … …  
    672738!> Close netcdf file.
    673739!--------------------------------------------------------------------------------------------------!
    674 SUBROUTINE netcdf4_parallel_finalize( file_id, return_value )
    675 
    676    CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_parallel_finalize'  !< name of routine
     740SUBROUTINE netcdf4_finalize( file_id, return_value )
     741
     742   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'netcdf4_finalize'  !< name of routine
    677743
    678744   INTEGER(iwp), INTENT(IN)  ::  file_id       !< file ID
    … …  
    681747
    682748
    683 #if defined( __netcdf4_parallel )
     749#if defined( __netcdf4 )
    684750   WRITE( temp_string, * ) file_id
    685751   CALL internal_message( 'debug', routine_name // &
    … …  
    698764#endif
    699765
    700 END SUBROUTINE netcdf4_parallel_finalize
     766END SUBROUTINE netcdf4_finalize
    701767
    702768!--------------------------------------------------------------------------------------------------!
    … …  
    716782   SELECT CASE ( TRIM( data_type ) )
    717783
    718 #if defined( __netcdf4_parallel )
     784#if defined( __netcdf4 )
    719785      CASE ( 'char' )
    720786         return_value = NF90_CHAR
    … …  
    759825   IF ( TRIM( level ) == 'error' )  THEN
    760826
    761       WRITE( internal_error_message, '(A,A)' ) 'DOM ERROR: ', string
     827      WRITE( internal_error_message, '(A,A)' ) ': ', string
    762828
    763829   ELSEIF ( TRIM( level ) == 'debug'  .AND.  print_debug_output )  THEN
    … …  
    775841!> Return the last created error message.
    776842!--------------------------------------------------------------------------------------------------!
    777 SUBROUTINE netcdf4_parallel_get_error_message( error_message )
     843SUBROUTINE netcdf4_get_error_message( error_message )
    778844
    779845   CHARACTER(LEN=800), INTENT(OUT) ::  error_message  !< return error message to main program
    … …  
    782848   error_message = internal_error_message
    783849
    784 END SUBROUTINE netcdf4_parallel_get_error_message
    785 
    786 
    787 END MODULE data_output_netcdf4_parallel_module
     850END SUBROUTINE netcdf4_get_error_message
     851
     852
     853END MODULE data_output_netcdf4_module
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |