Changeset 4113 for palm/trunk/SOURCE/data_output_module.f90
- Timestamp:
- Jul 23, 2019 8:34:25 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_module.f90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_module.f90
r4107 r4113 260 260 ! Description: 261 261 ! ------------ 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. 267 263 !--------------------------------------------------------------------------------------------------! 268 264 SUBROUTINE dom_database_debug_output 269 265 270 ! CHARACTER(LEN=100) :: dim_string !< list of dimension names as single string271 266 CHARACTER(LEN=*), PARAMETER :: separation_string = '---' !< string separating blocks in output 267 CHARACTER(LEN=50) :: format1 !< format for write statements 272 268 CHARACTER(LEN=*), PARAMETER :: routine_name = 'dom_database_debug_output' !< name of this routine 273 269 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 392 658 393 659 END SUBROUTINE dom_database_debug_output … … 1892 2158 1893 2159 IF ( return_value == 0 .AND. ALLOCATED( file%variables(d)%attributes ) ) THEN 1894 !-- Write variable attribu res2160 !-- Write variable attributes 1895 2161 DO a = 1, SIZE( file%variables(d)%attributes ) 1896 2162 return_value = write_attribute( file%format, file%id, file%name, & … … 2044 2310 2045 2311 END SELECT 2046 2312 2047 2313 IF ( output_return_value /= 0 ) THEN 2048 2314 return_value = output_return_value … … 3224 3490 DO f = 1, nf 3225 3491 IF ( TRIM( filename ) == TRIM( files(f)%name ) ) THEN 3226 3492 3227 3493 IF ( .NOT. files(f)%is_init ) THEN 3228 3494 return_value = 1 … … 3234 3500 EXIT 3235 3501 ENDIF 3236 3502 3237 3503 file_id = files(f)%id 3238 3504 file_format = files(f)%format
Note: See TracChangeset
for help on using the changeset viewer.
