Changeset 4113 for palm


Ignore:
Timestamp:
Jul 23, 2019 8:34:25 AM (5 years ago)
Author:
gronemeier
Message:

made dom_database_debug_output available (data_output_module.f90)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/data_output_module.f90

    r4107 r4113  
    260260! Description:
    261261! ------------
    262 !> Debugging output. Print contents of output database to terminal.
    263 !>
    264 !> @bug Routine currently not working properly due to changes in dimension/attribute value types.
    265 !> @todo Call routine via debug flag.
    266 !> @todo Use dim and var within loops to enhance readability of the code.
     262!> Debugging output. Print contents of output database to debug_output_unit.
    267263!--------------------------------------------------------------------------------------------------!
    268264SUBROUTINE dom_database_debug_output
    269265
    270    ! CHARACTER(LEN=100) ::  dim_string  !< list of dimension names as single string
    271 
     266   CHARACTER(LEN=*), PARAMETER ::  separation_string = '---'                   !< string separating blocks in output
     267   CHARACTER(LEN=50)           ::  format1                                     !< format for write statements
    272268   CHARACTER(LEN=*), PARAMETER ::  routine_name = 'dom_database_debug_output'  !< name of this routine
    273269
    274    ! INTEGER(iwp) ::  d     !< loop index
    275    ! INTEGER(iwp) ::  f     !< loop index
    276    ! INTEGER(iwp) ::  i     !< loop index
    277    ! INTEGER(iwp) ::  ndim  !< number of dimensions
    278    !
    279    ! TYPE(dimension_type) ::  dim  !< dimension in file
    280    !
    281    ! TYPE(variable_type) ::  var   !< variable in file
    282 
    283 
    284    CALL internal_message( 'error', routine_name // ': routine currently not available' )
    285 
    286    ! nf = SIZE(files)
    287    !
    288    ! WRITE(*, '(A,I3)') '    number of files: ', nf
    289    ! WRITE(*, '(A)')    '    files:'
    290    ! DO  f = 1, nf
    291    !    WRITE(*,'(//6X,A)') 'name: '//TRIM(files(f)%name)
    292    !    WRITE(*,'(6X,A)') 'attributes:'
    293    !    IF ( ALLOCATED(files(f)%attributes) )  THEN
    294    !       CALL print_attributes( files(f)%attributes )
    295    !    ELSE
    296    !       WRITE(*,'(8X,A)') '--none--'
    297    !    ENDIF
    298    !
    299    !    WRITE(*,'(/6X,A)') 'dimensions:'
    300    !    IF ( ALLOCATED(files(f)%dimensions )  THEN
    301    !       ndim = SIZE(files(f)%dimensions)
    302    !       DO  d = 1, ndim
    303    !
    304    !          WRITE(*,'(/8X,A,I4/8X,A)') &
    305    !             'name: '//TRIM(files(f)%dimensions(d)%name)//',  '// &
    306    !             'length: ', files(f)%dimensions(d)%length, &
    307    !             'values:'
    308    !          IF ( ALLOCATED(files(f)%dimensions(d)%values_int32) )  THEN
    309    !             WRITE(*,'(10X,5(I5,1X),A)') files(f)%dimensions(d)%values_int32(0:MIN(4,files(f)%dimensions(d)%length)), '...'
    310    !          ELSE
    311    !             WRITE(*,'(10X,5(F8.2,1X),A)')  &
    312    !                files(f)%dimensions(d)%values_real64(0:MIN(4,files(f)%dimensions(d)%length)), '...'
    313    !          ENDIF
    314    !          IF ( ALLOCATED(files(f)%dimensions(d)%mask) )  THEN
    315    !             WRITE(*,'(8X,A)') 'mask:'
    316    !             WRITE(*,'(10X,5(L,1X),A)') files(f)%dimensions(d)%mask(0:MIN(4,files(f)%dimensions(d)%length)), '...'
    317    !          ENDIF
    318    !          WRITE(*,'(8X,A)') 'attributes:'
    319    !          IF ( ALLOCATED( files(f)%dimensions(d)%attributes ) )  THEN
    320    !             CALL print_attributes( files(f)%dimensions(d)%attributes )
    321    !          ELSE
    322    !             WRITE(*,'(10X,A)') '--none--'
    323    !          ENDIF
    324    !
    325    !       ENDDO
    326    !    ELSE
    327    !       WRITE(*,'(8X,A)') '--none--'
    328    !    ENDIF
    329    !
    330    !    WRITE(*,'(/6X,A)') 'variables:'
    331    !    IF ( ALLOCATED(files(f)%variables) )  THEN
    332    !       ndim = SIZE(files(f)%variables)
    333    !       DO  d = 1, ndim
    334    !          dim_string = '('
    335    !          DO  i = 1, SIZE(files(f)%variables(d)%dimension_names)
    336    !             dim_string = TRIM(dim_string)//' '//TRIM(files(f)%variables(d)%dimension_names(i))
    337    !          ENDDO
    338    !          dim_string = TRIM(dim_string)//')'
    339    !          WRITE(*,'(/8X,A)') &
    340    !             'name: '//TRIM(files(f)%variables(d)%name)//TRIM(dim_string)
    341    !          WRITE(*,'(/8X,A)') &
    342    !             'type: '//TRIM(files(f)%variables(d)%data_type)
    343    !          WRITE(*,'(8X,A)') &
    344    !             'ID: '
    345    !          WRITE(*,'(8X,A)') 'attributes:'
    346    !          IF ( ALLOCATED( files(f)%variables(d)%attributes ) )  THEN
    347    !             CALL print_attributes( files(f)%variables(d)%attributes )
    348    !          ELSE
    349    !             WRITE(*,'(10X,A)') '--none--'
    350    !          ENDIF
    351    !       ENDDO
    352    !    ELSE
    353    !       WRITE(*,'(8X,A)') '--none--'
    354    !    ENDIF
    355    !
    356    !    WRITE(*,'(4X,40("#"))')
    357    !
    358    ! ENDDO
    359    !
    360    ! CONTAINS
    361    !
    362    !    !------------------------------------------------------------------------!
    363    !    ! Description:
    364    !    ! ------------
    365    !    !> Print given list of attributes.
    366    !    !------------------------------------------------------------------------!
    367    !    SUBROUTINE print_attributes( attributes )
    368    !
    369    !       INTEGER(iwp) ::  a     !< loop index
    370    !       INTEGER(iwp) ::  natt  !< number of attributes
    371    !
    372    !       TYPE(attribute_type), DIMENSION(:), INTENT(IN) ::  attributes  !< list of attributes
    373    !
    374    !       natt = SIZE(attributes)
    375    !       DO  a = 1, natt
    376    !          IF ( TRIM(attributes(a)%data_type) == 'int32' )  THEN
    377    !             WRITE(*,'(10X,A,1X,I10)') &
    378    !                '"'//TRIM(attributes(a)%name)//'" = ', &
    379    !                attributes(a)%value_int32
    380    !          ELSEIF (  TRIM(attributes(a)%data_type) == 'real32' )  THEN
    381    !             WRITE(*,'(10X,A,1X,F10.3)') &
    382    !                '"'//TRIM(attributes(a)%name)//'" = ', &
    383    !                attributes(a)%value_real64
    384    !          ELSEIF (  TRIM(attributes(a)%data_type) == 'char' )  THEN
    385    !             WRITE(*,'(10X,A,1X,A)') &
    386    !                '"'//TRIM(attributes(a)%name)//'" = ', &
    387    !                '"'//TRIM(attributes(a)%value_char)//'"'
    388    !          ENDIF
    389    !       ENDDO
    390    !
    391    !    END SUBROUTINE print_attributes
     270   INTEGER            ::  f                       !< loop index
     271   INTEGER, PARAMETER ::  indent_depth = 3        !< space per indentation
     272   INTEGER            ::  indent_level            !< indentation level
     273   INTEGER, PARAMETER ::  max_keyname_length = 6  !< length of longest key name
     274   INTEGER            ::  natt                    !< number of attributes
     275   INTEGER            ::  ndim                    !< number of dimensions
     276   INTEGER            ::  nvar                    !< number of variables
     277
     278
     279   CALL internal_message( 'debug', routine_name // ': write data base to debug output' )
     280
     281   WRITE( debug_output_unit, '(A)' ) 'DOM data base:'
     282   WRITE( debug_output_unit, '(A)' ) REPEAT( separation_string // ' ', 4 )
     283
     284   IF ( .NOT. ALLOCATED( files) )  THEN
     285
     286      WRITE( debug_output_unit, '(A)' ) 'database is empty'
     287
     288   ELSE
     289
     290      indent_level = 1
     291      WRITE( format1, '(A,I3,A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A,T',        &
     292                                        indent_level * indent_depth + 1 + max_keyname_length, &
     293                                        ',(": ")'
     294
     295      nf = SIZE( files )
     296      DO  f = 1, nf
     297
     298         natt = 0
     299         ndim = 0
     300         nvar = 0
     301         IF ( ALLOCATED( files(f)%attributes ) ) natt = SIZE( files(f)%attributes )
     302         IF ( ALLOCATED( files(f)%dimensions ) ) ndim = SIZE( files(f)%dimensions )
     303         IF ( ALLOCATED( files(f)%variables  ) ) nvar = SIZE( files(f)%variables  )
     304
     305         WRITE( debug_output_unit, '(A)' ) 'file:'
     306         WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) 'name', TRIM( files(f)%name )
     307         WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) 'format', TRIM( files(f)%format )
     308         WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) 'id', files(f)%id
     309         WRITE( debug_output_unit, TRIM( format1 ) // ',L1)' ) 'is init', files(f)%is_init
     310         WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) '#atts', natt
     311         WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) '#dims', ndim
     312         WRITE( debug_output_unit, TRIM( format1 ) // ',I7)' ) '#vars', nvar
     313
     314         IF ( natt /= 0 )  CALL print_attributes( indent_level, files(f)%attributes )
     315         IF ( ndim /= 0 )  CALL print_dimensions( indent_level, files(f)%dimensions )
     316         IF ( nvar /= 0 )  CALL print_variables( indent_level, files(f)%variables )
     317
     318         WRITE( debug_output_unit, '(/A/)' ) REPEAT( separation_string // ' ', 4 )
     319
     320      ENDDO
     321
     322   ENDIF
     323
     324   CONTAINS
     325
     326      !--------------------------------------------------------------------------------------------!
     327      ! Description:
     328      ! ------------
     329      !> Print list of attributes.
     330      !--------------------------------------------------------------------------------------------!
     331      SUBROUTINE print_attributes( indent_level, attributes )
     332
     333         CHARACTER(LEN=50) ::  format1  !< format for write statements
     334         CHARACTER(LEN=50) ::  format2  !< format for write statements
     335
     336         INTEGER             ::  i                       !< loop index
     337         INTEGER, INTENT(IN) ::  indent_level            !< indentation level
     338         INTEGER, PARAMETER  ::  max_keyname_length = 6  !< length of longest key name
     339         INTEGER             ::  nelement                !< number of elements to print
     340
     341         TYPE(attribute_type), DIMENSION(:), INTENT(IN) ::  attributes  !< list of attributes
     342
     343
     344         WRITE( format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
     345         WRITE( format2, '(A,I3,A,I3,A)' ) &
     346            '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
     347            ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
     348
     349         WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) REPEAT( separation_string // ' ', 4 )
     350         WRITE( debug_output_unit, TRIM( format1 ) // ')' ) 'attributes:'
     351
     352         nelement = SIZE( attributes )
     353         DO  i = 1, nelement
     354            WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     355               'name', TRIM( attributes(i)%name )
     356            WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     357               'type', TRIM( attributes(i)%data_type )
     358
     359            IF ( TRIM( attributes(i)%data_type ) == 'char' )  THEN
     360               WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     361                  'value', TRIM( attributes(i)%value_char )
     362            ELSEIF ( TRIM( attributes(i)%data_type ) == 'int8' )  THEN
     363               WRITE( debug_output_unit, TRIM( format2 ) // ',I4)' ) &
     364                  'value', attributes(i)%value_int8
     365            ELSEIF ( TRIM( attributes(i)%data_type ) == 'int16' )  THEN
     366               WRITE( debug_output_unit, TRIM( format2 ) // ',I6)' ) &
     367                  'value', attributes(i)%value_int16
     368            ELSEIF ( TRIM( attributes(i)%data_type ) == 'int32' )  THEN
     369               WRITE( debug_output_unit, TRIM( format2 ) // ',I11)' ) &
     370                  'value', attributes(i)%value_int32
     371            ELSEIF ( TRIM( attributes(i)%data_type ) == 'real32' )  THEN
     372               WRITE( debug_output_unit, TRIM( format2 ) // ',E14.7)' ) &
     373                  'value', attributes(i)%value_real32
     374            ELSEIF (  TRIM(attributes(i)%data_type) == 'real64' )  THEN
     375               WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)' ) &
     376                  'value', attributes(i)%value_real64
     377            ENDIF
     378            IF ( i < nelement )  &
     379               WRITE( debug_output_unit, TRIM( format1 ) // ')' ) separation_string
     380         ENDDO
     381
     382      END SUBROUTINE print_attributes
     383
     384      !--------------------------------------------------------------------------------------------!
     385      ! Description:
     386      ! ------------
     387      !> Print list of dimensions.
     388      !--------------------------------------------------------------------------------------------!
     389      SUBROUTINE print_dimensions( indent_level, dimensions )
     390
     391         CHARACTER(LEN=50) ::  format1  !< format for write statements
     392         CHARACTER(LEN=50) ::  format2  !< format for write statements
     393
     394         INTEGER             ::  i                        !< loop index
     395         INTEGER, INTENT(IN) ::  indent_level             !< indentation level
     396         INTEGER             ::  j                        !< loop index
     397         INTEGER, PARAMETER  ::  max_keyname_length = 15  !< length of longest key name
     398         INTEGER             ::  nelement                 !< number of elements to print
     399
     400         LOGICAL ::  is_masked  !< true if dimension is masked
     401
     402         TYPE(dimension_type), DIMENSION(:), INTENT(IN) ::  dimensions  !< list of dimensions
     403
     404
     405         WRITE( format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
     406         WRITE( format2, '(A,I3,A,I3,A)' ) &
     407            '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
     408            ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
     409
     410         WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) REPEAT( separation_string // ' ', 4 )
     411         WRITE( debug_output_unit, TRIM( format1 ) // ')' ) 'dimensions:'
     412
     413         nelement = SIZE( dimensions )
     414         DO  i = 1, nelement
     415            is_masked = dimensions(i)%is_masked
     416
     417            !-- Print general information
     418            WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     419               'name', TRIM( dimensions(i)%name )
     420            WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     421               'type', TRIM( dimensions(i)%data_type )
     422            WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
     423               'id', dimensions(i)%id
     424            WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
     425               'length', dimensions(i)%length
     426            WRITE( debug_output_unit, TRIM( format2 ) // ',I7,A,I7)' ) &
     427               'bounds', dimensions(i)%bounds(1), ',', dimensions(i)%bounds(2)
     428            WRITE( debug_output_unit, TRIM( format2 ) // ',L1)' ) &
     429               'is masked', dimensions(i)%is_masked
     430
     431            !-- Print information about mask
     432            IF ( is_masked )  THEN
     433               WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
     434                  'masked length', dimensions(i)%length_mask
     435
     436               WRITE( debug_output_unit, TRIM( format2 ) // ',L1)', ADVANCE='no' ) &
     437                  'mask', dimensions(i)%mask(dimensions(i)%bounds(1))
     438               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     439                  WRITE( debug_output_unit, '(A,L1)', ADVANCE='no' ) ',', dimensions(i)%mask(j)
     440               ENDDO
     441               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     442
     443               WRITE( debug_output_unit, TRIM( format2 ) // ',I6)', ADVANCE='no' ) &
     444                  'masked indices', dimensions(i)%masked_indices(0)
     445               DO  j = 1, dimensions(i)%length_mask-1
     446                  WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
     447                     ',', dimensions(i)%masked_indices(j)
     448               ENDDO
     449               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     450            ENDIF
     451
     452            !-- Print saved values
     453            IF ( ALLOCATED( dimensions(i)%values_int8 ) )  THEN
     454
     455               WRITE( debug_output_unit, TRIM( format2 ) // ',I4)', ADVANCE='no' ) &
     456                  'values', dimensions(i)%values_int8(dimensions(i)%bounds(1))
     457               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     458                  WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
     459                     ',', dimensions(i)%values_int8(j)
     460               ENDDO
     461               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     462               IF ( is_masked )  THEN
     463                  WRITE( debug_output_unit, TRIM( format2 ) // ',I4)', ADVANCE='no' ) &
     464                     'masked values', dimensions(i)%masked_values_int8(0)
     465                  DO  j = 1, dimensions(i)%length_mask-1
     466                     WRITE( debug_output_unit, '(A,I4)', ADVANCE='no' ) &
     467                        ',', dimensions(i)%masked_values_int8(j)
     468                  ENDDO
     469                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     470               ENDIF
     471
     472            ELSEIF ( ALLOCATED( dimensions(i)%values_int16 ) )  THEN
     473
     474               WRITE( debug_output_unit, TRIM( format2 ) // ',I6)', ADVANCE='no' ) &
     475                  'values', dimensions(i)%values_int16(dimensions(i)%bounds(1))
     476               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     477                  WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
     478                     ',', dimensions(i)%values_int16(j)
     479               ENDDO
     480               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     481               IF ( is_masked )  THEN
     482                  WRITE( debug_output_unit, TRIM( format2 ) // ',I6)', ADVANCE='no' ) &
     483                     'masked values', dimensions(i)%masked_values_int16(0)
     484                  DO  j = 1, dimensions(i)%length_mask-1
     485                     WRITE( debug_output_unit, '(A,I6)', ADVANCE='no' ) &
     486                        ',', dimensions(i)%masked_values_int16(j)
     487                  ENDDO
     488                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     489               ENDIF
     490
     491            ELSEIF ( ALLOCATED( dimensions(i)%values_int32 ) )  THEN
     492
     493               WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
     494                  'values', dimensions(i)%values_int32(dimensions(i)%bounds(1))
     495               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     496                  WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     497                     ',', dimensions(i)%values_int32(j)
     498               ENDDO
     499               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     500               IF ( is_masked )  THEN
     501                  WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
     502                     'masked values', dimensions(i)%masked_values_int32(0)
     503                  DO  j = 1, dimensions(i)%length_mask-1
     504                     WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     505                        ',', dimensions(i)%masked_values_int32(j)
     506                  ENDDO
     507                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     508               ENDIF
     509
     510            ELSEIF ( ALLOCATED( dimensions(i)%values_intwp ) )  THEN
     511
     512               WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
     513                  'values', dimensions(i)%values_intwp(dimensions(i)%bounds(1))
     514               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     515                  WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     516                     ',', dimensions(i)%values_intwp(j)
     517               ENDDO
     518               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     519               IF ( is_masked )  THEN
     520                  WRITE( debug_output_unit, TRIM( format2 ) // ',I11)', ADVANCE='no' ) &
     521                     'masked values', dimensions(i)%masked_values_intwp(0)
     522                  DO  j = 1, dimensions(i)%length_mask-1
     523                     WRITE( debug_output_unit, '(A,I11)', ADVANCE='no' ) &
     524                        ',', dimensions(i)%masked_values_intwp(j)
     525                  ENDDO
     526                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     527               ENDIF
     528
     529            ELSEIF ( ALLOCATED( dimensions(i)%values_real32 ) )  THEN
     530
     531               WRITE( debug_output_unit, TRIM( format2 ) // ',E14.7)', ADVANCE='no' ) &
     532                  'values', dimensions(i)%values_real32(dimensions(i)%bounds(1))
     533               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     534                  WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
     535                     ',', dimensions(i)%values_real32(j)
     536               ENDDO
     537               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     538               IF ( is_masked )  THEN
     539                  WRITE( debug_output_unit, TRIM( format2 ) // ',E14.7)', ADVANCE='no' ) &
     540                     'masked values', dimensions(i)%masked_values_real32(0)
     541                  DO  j = 1, dimensions(i)%length_mask-1
     542                     WRITE( debug_output_unit, '(A,E14.7)', ADVANCE='no' ) &
     543                        ',', dimensions(i)%masked_values_real32(j)
     544                  ENDDO
     545                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     546               ENDIF
     547
     548            ELSEIF ( ALLOCATED( dimensions(i)%values_real64 ) )  THEN
     549
     550               WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
     551                  'values', dimensions(i)%values_real64(dimensions(i)%bounds(1))
     552               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     553                  WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     554                     ',', dimensions(i)%values_real64(j)
     555               ENDDO
     556               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     557               IF ( is_masked )  THEN
     558                  WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
     559                     'masked values', dimensions(i)%masked_values_real64(0)
     560                  DO  j = 1, dimensions(i)%length_mask-1
     561                     WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     562                        ',', dimensions(i)%masked_values_real64(j)
     563                  ENDDO
     564                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     565               ENDIF
     566
     567            ELSEIF ( ALLOCATED( dimensions(i)%values_realwp ) )  THEN
     568
     569               WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
     570                  'values', dimensions(i)%values_realwp(dimensions(i)%bounds(1))
     571               DO  j = dimensions(i)%bounds(1)+1, dimensions(i)%bounds(2)
     572                  WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     573                     ',', dimensions(i)%values_realwp(j)
     574               ENDDO
     575               WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     576               IF ( is_masked )  THEN
     577                  WRITE( debug_output_unit, TRIM( format2 ) // ',E22.15)', ADVANCE='no' ) &
     578                     'masked values', dimensions(i)%masked_values_realwp(0)
     579                  DO  j = 1, dimensions(i)%length_mask-1
     580                     WRITE( debug_output_unit, '(A,E22.15)', ADVANCE='no' ) &
     581                        ',', dimensions(i)%masked_values_realwp(j)
     582                  ENDDO
     583                  WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     584               ENDIF
     585
     586            ENDIF
     587
     588            IF ( ALLOCATED( dimensions(i)%attributes ) )  &
     589               CALL print_attributes( indent_level+1, dimensions(i)%attributes )
     590
     591            IF ( i < nelement )  &
     592               WRITE( debug_output_unit, TRIM( format1 ) // ')' ) separation_string
     593         ENDDO
     594
     595      END SUBROUTINE print_dimensions
     596
     597      !--------------------------------------------------------------------------------------------!
     598      ! Description:
     599      ! ------------
     600      !> Print list of variables.
     601      !--------------------------------------------------------------------------------------------!
     602      SUBROUTINE print_variables( indent_level, variables )
     603
     604         CHARACTER(LEN=50) ::  format1  !< format for write statements
     605         CHARACTER(LEN=50) ::  format2  !< format for write statements
     606
     607         INTEGER             ::  i                        !< loop index
     608         INTEGER, INTENT(IN) ::  indent_level             !< indentation level
     609         INTEGER             ::  j                        !< loop index
     610         INTEGER, PARAMETER  ::  max_keyname_length = 16  !< length of longest key name
     611         INTEGER             ::  nelement                 !< number of elements to print
     612
     613         TYPE(variable_type), DIMENSION(:), INTENT(IN) ::  variables  !< list of variables
     614
     615
     616         WRITE( format1, '(A,I3,A)' ) '(T', indent_level * indent_depth + 1, ',A'
     617         WRITE( format2, '(A,I3,A,I3,A)' ) &
     618            '(T', ( indent_level + 1 ) * indent_depth + 1, ',A,T', &
     619            ( indent_level + 1 ) * indent_depth + 1 + max_keyname_length, ',(": ")'
     620
     621         WRITE( debug_output_unit, TRIM( format1 ) // ',A)' ) REPEAT( separation_string // ' ', 4 )
     622         WRITE( debug_output_unit, TRIM( format1 ) // ')' ) 'variables:'
     623
     624         nelement = SIZE( variables )
     625         DO  i = 1, nelement
     626            WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     627               'name', TRIM( variables(i)%name )
     628            WRITE( debug_output_unit, TRIM( format2 ) // ',A)' ) &
     629               'type', TRIM( variables(i)%data_type )
     630            WRITE( debug_output_unit, TRIM( format2 ) // ',I7)' ) &
     631               'id', variables(i)%id
     632            WRITE( debug_output_unit, TRIM( format2 ) // ',L1)' ) &
     633               'is global', variables(i)%is_global
     634
     635            WRITE( debug_output_unit, TRIM( format2 ) // ',A)', ADVANCE='no' ) &
     636               'dimension names', TRIM( variables(i)%dimension_names(1) )
     637            DO  j = 2, SIZE( variables(i)%dimension_names )
     638               WRITE( debug_output_unit, '(A,A)', ADVANCE='no' ) &
     639                  ',', TRIM( variables(i)%dimension_names(j) )
     640            ENDDO
     641            WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     642
     643            WRITE( debug_output_unit, TRIM( format2 ) // ',I7)', ADVANCE='no' ) &
     644               'dimension ids', variables(i)%dimension_ids(1)
     645            DO  j = 2, SIZE( variables(i)%dimension_names )
     646               WRITE( debug_output_unit, '(A,I7)', ADVANCE='no' ) &
     647                  ',', variables(i)%dimension_ids(j)
     648            ENDDO
     649            WRITE( debug_output_unit, '(A)' )  ''  ! write line-end
     650
     651            IF ( ALLOCATED( variables(i)%attributes ) )  &
     652               CALL print_attributes( indent_level+1, variables(i)%attributes )
     653            IF ( i < nelement )  &
     654               WRITE( debug_output_unit, TRIM( format1 ) // ')' ) separation_string
     655         ENDDO
     656
     657      END SUBROUTINE print_variables
    392658
    393659END SUBROUTINE dom_database_debug_output
     
    18922158
    18932159            IF ( return_value == 0  .AND.  ALLOCATED( file%variables(d)%attributes ) )  THEN
    1894                !-- Write variable attribures
     2160               !-- Write variable attributes
    18952161               DO  a = 1, SIZE( file%variables(d)%attributes )
    18962162                  return_value = write_attribute( file%format, file%id, file%name, &
     
    20442310
    20452311   END SELECT
    2046    
     2312
    20472313   IF ( output_return_value /= 0 )  THEN
    20482314      return_value = output_return_value
     
    32243490   DO  f = 1, nf
    32253491      IF ( TRIM( filename ) == TRIM( files(f)%name ) )  THEN
    3226          
     3492
    32273493         IF ( .NOT. files(f)%is_init )  THEN
    32283494            return_value = 1
     
    32343500            EXIT
    32353501         ENDIF
    3236          
     3502
    32373503         file_id     = files(f)%id
    32383504         file_format = files(f)%format
Note: See TracChangeset for help on using the changeset viewer.