Home


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

Ignore:
Timestamp:
May 17, 2020 5:24:13 PM (4 years ago)
Author:
raasch
Message:

messages and debug output converted to PALM routines (restart_data_mpi_io_mod), binary version number set to 5.0, heeader output for restart data format added, restart data filesize and I/O transfer speed added in cpu_measures, handling of single restart files (created with MPI-I/O) added to palmrun, bugfix: preprocessor directive adjusted (virtual_measurement_mod), location message format changed

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/restart_data_mpi_io_mod.f90

    r4534 r4536  
    2424! -----------------
    2525! $Id$
     26! messages and debug output converted to PALM routines
     27!
     28! 4534 2020-05-14 18:35:22Z raasch
    2629! I/O on reduced number of cores added (using shared memory MPI)
    2730!
    … …  
    6366
    6467    USE control_parameters,                                                                        &
    65         ONLY:  include_total_domain_boundaries, restart_data_format_input
     68        ONLY:  debug_output, debug_string, include_total_domain_boundaries, message_string,        &
     69               restart_data_format_input, restart_data_format_output, restart_file_size
    6670
    6771    USE exchange_horiz_mod,                                                                        &
    … …  
    135139    LOGICAL ::  filetypes_created                 !<
    136140    LOGICAL ::  io_on_limited_cores_per_node      !< switch to shared memory MPI-IO
    137     LOGICAL ::  print_header_now = .TRUE.         !<
    138141    LOGICAL ::  rd_flag                           !< file is opened for read
    139142    LOGICAL ::  wr_flag                           !< file is opened for write
    140 
    141     REAL(KIND=wp) ::  mb_processed  !<
    142143
    143144#if defined( __parallel )
    … …  
    194195    PRIVATE
    195196
    196     PUBLIC  mb_processed, total_number_of_surface_values
     197    PUBLIC  restart_file_size, total_number_of_surface_values
    197198
    198199!
    … …  
    300301
    301302    offset = 0
     303    io_on_limited_cores_per_node = .FALSE.
    302304
    303305    rd_flag = ( TRIM( action ) == 'READ'  .OR. TRIM( action ) == 'read'  )
    304306    wr_flag = ( TRIM( action ) == 'WRITE' .OR. TRIM( action ) == 'write' )
    305307
     308    IF ( .NOT. ( rd_flag .OR. wr_flag ) )  THEN
     309       message_string = 'illegal action "' // TRIM( action ) // '" for opening restart files'
     310       CALL message( 'restart_data_mpi_io_mod', 'PA0720', 1, 2, 0, 6, 0 )
     311    ENDIF
    306312!
    307313!-- Store name of I/O file to communicate it internally within this module.
    … …  
    309315!
    310316!-- Setup for IO on a limited number of threads per node (using shared memory MPI)
    311     IF ( TRIM( restart_data_format_input ) == 'mpi_shared_memory' )  THEN
     317    IF ( rd_flag )  THEN
     318       set_filetype = .TRUE.
     319       IF ( TRIM( restart_data_format_input ) == 'mpi_shared_memory' )  THEN
     320          io_on_limited_cores_per_node = .TRUE.
     321       ENDIF
     322    ENDIF
     323
     324    IF ( TRIM( restart_data_format_output ) == 'mpi_shared_memory' .AND.  wr_flag )  THEN
    312325       io_on_limited_cores_per_node = .TRUE.
    313        set_filetype                 = .TRUE.
    314326    ENDIF
    315327!
    … …  
    339351!-- In case of read it is not known yet if data include total domain. Filetypes will be created
    340352!-- further below.
    341     IF ( wr_flag)  THEN
     353    IF ( wr_flag )  THEN
    342354       CALL rd_mpi_io_create_filetypes
    343355       filetypes_created = .TRUE.
    … …  
    348360#if defined( __parallel )
    349361    IF ( sm_io%iam_io_pe )  THEN
     362
    350363       IF ( rd_flag )  THEN
     364
     365          IF ( debug_output )  THEN
     366             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
     367                                       '" for read with MPI-IO'
     368             CALL debug_message( debug_string, 'start' )
     369          ENDIF
     370
    351371          CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_RDONLY, MPI_INFO_NULL, fh,   &
    352372                              ierr )
    353           WRITE (9,*) 'Open MPI-IO restart file for read  ==> ', TRIM( io_file_name )
     373
     374          IF ( ierr /= 0 )  THEN
     375             message_string = 'error opening restart file "' // TRIM( io_file_name ) //      &
     376                              '" for reading with MPI-IO'
     377             CALL message( 'rrd_mpi_io_open', 'PA0727', 3, 2, 0, 6, 0 )
     378          ENDIF
     379
     380          IF ( debug_output )  THEN
     381             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
     382                                       '" for read with MPI-IO'
     383             CALL debug_message( debug_string, 'end' )
     384          ENDIF
     385
    354386       ELSEIF ( wr_flag )  THEN
     387
     388          IF ( debug_output )  THEN
     389             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
     390                                       '" for write with MPI-IO'
     391             CALL debug_message( debug_string, 'start' )
     392          ENDIF
     393
    355394          CALL MPI_FILE_OPEN( comm_io, TRIM( io_file_name ), MPI_MODE_CREATE+MPI_MODE_WRONLY,      &
    356395                              MPI_INFO_NULL, fh, ierr )
    357           WRITE (9,*) 'Open MPI-IO restart file for write ==> ', TRIM( io_file_name )
    358        ELSE
    359           CALL rd_mpi_io_error( 1 )
    360        ENDIF
     396
     397          IF ( ierr /= 0 )  THEN
     398             message_string = 'error opening restart file "' // TRIM( io_file_name ) //      &
     399                              '" for writing with MPI-IO'
     400             CALL message( 'rrd_mpi_io_open', 'PA0728', 3, 2, 0, 6, 0 )
     401          ENDIF
     402
     403          IF ( debug_output )  THEN
     404             WRITE( debug_string, * )  'open joint restart file "' // TRIM( io_file_name ) //      &
     405                                       '" for write with MPI-IO'
     406             CALL debug_message( debug_string, 'end' )
     407          ENDIF
     408
     409       ENDIF
     410
    361411    ENDIF
    362412#else
    363413    IF ( rd_flag )  THEN
     414
     415       IF ( debug_output )  THEN
     416          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //            &
     417                                    '" for read in serial mode (posix)'
     418          CALL debug_message( debug_string, 'start' )
     419       ENDIF
     420
    364421       fh = posix_open( TRIM( io_file_name ), .TRUE. )
    365        WRITE (9,*) 'Open sequential restart file for read  ==> ', TRIM( io_file_name ), ' ', fh
     422
     423       IF ( debug_output )  THEN
     424          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //            &
     425                                    '" for read in serial mode (posix)'
     426          CALL debug_message( debug_string, 'end' )
     427       ENDIF
     428
    366429    ELSEIF ( wr_flag )  THEN
     430
     431       IF ( debug_output )  THEN
     432          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //            &
     433                                    '" for write in serial mode (posix)'
     434          CALL debug_message( debug_string, 'start' )
     435       ENDIF
     436
    367437       fh = posix_open( TRIM( io_file_name ), .FALSE. )
    368        WRITE (9,*) 'Open sequential restart file for write ==> ', TRIM( io_file_name ), ' ', fh
    369     ELSE
    370        CALL rd_mpi_io_error( 1 )
    371     ENDIF
    372 
    373     IF ( fh < 0 )  CALL rd_mpi_io_error( 6 )
     438
     439       IF ( debug_output )  THEN
     440          WRITE( debug_string, * )  'open restart file "' // TRIM( io_file_name ) //            &
     441                                    '" for write in serial mode (posix)'
     442          CALL debug_message( debug_string, 'end' )
     443       ENDIF
     444
     445    ENDIF
     446
     447    IF ( fh < 0 )  THEN
     448       message_string = 'error opening restart file for posix I/O'
     449       CALL message( 'restart_data_mpi_io_mod', 'PA0721', 1, 2, 0, 6, 0 )
     450    ENDIF
    374451#endif
    375452
    … …  
    506583          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
    507584#endif
    508           IF ( debug_level >= 2 )  THEN
    509              WRITE (9,*) 'header positio after array metadata  ', header_position
    510           ENDIF
    511 
    512           IF ( print_header_now )  CALL rd_mpi_io_print_header
     585          IF ( debug_output )  CALL rd_mpi_io_print_header
    513586
    514587       ENDIF
    … …  
    585658!> Read INTEGER with MPI-IO
    586659!--------------------------------------------------------------------------------------------------!
    587  SUBROUTINE rrd_mpi_io_int( name, value, found )
     660 SUBROUTINE rrd_mpi_io_int( name, value )
    588661
    589662    IMPLICIT NONE
    … …  
    594667    INTEGER(KIND=iwp), INTENT(OUT) ::  value
    595668
    596     LOGICAL                        ::  lo_found
    597     LOGICAL, INTENT(OUT), OPTIONAL ::  found
    598 
    599 
    600     lo_found = .FALSE.
     669    LOGICAL                        ::  found
     670
     671
     672    found = .FALSE.
    601673    value = 0
    602674
    603675    DO  i = 1, tgh%nr_int
    604676       IF ( TRIM(int_names(i)) == TRIM( name ) )  THEN
    605           IF ( debug_level >= 2 )  WRITE(9,*) 'INTEGER variable found ', name
    606677          value = int_values(i)
    607           lo_found = .TRUE.
     678          found = .TRUE.
    608679          EXIT
    609680       ENDIF
    610681    ENDDO
    611682
    612     IF ( PRESENT( found ) )  THEN
    613        found = lo_found
    614        RETURN
    615     ENDIF
    616 
    617     IF ( .NOT. lo_found )  THEN
    618        WRITE(9,*)  'INTEGER not found ', name
    619        CALL rd_mpi_io_error( 3 )
     683    IF ( .NOT. found )  THEN
     684       message_string = 'INTEGER variable "' // TRIM( name ) // '" not found in restart file'
     685       CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
    620686    ENDIF
    621687
    … …  
    629695!> Read REAL with MPI-IO
    630696!--------------------------------------------------------------------------------------------------!
    631  SUBROUTINE rrd_mpi_io_real( name, value, found )
     697 SUBROUTINE rrd_mpi_io_real( name, value )
    632698
    633699    IMPLICIT NONE
    … …  
    637703    INTEGER(iwp)                   ::  i
    638704
    639     LOGICAL                        ::  lo_found
    640     LOGICAL, INTENT(OUT), OPTIONAL ::  found
     705    LOGICAL                        ::  found
    641706
    642707    REAL(KIND=wp), INTENT(OUT)     ::  value
    643708
    644709
    645     lo_found = .FALSE.
     710    found = .FALSE.
    646711    value = 0.0
    647712
    648713    DO  i = 1, tgh%nr_real
    649714       IF ( TRIM(real_names(i)) == TRIM( name ) )  THEN
    650           IF ( debug_level >= 2 )  WRITE(9,*) 'REAL variable found ', name
    651715          value = real_values(i)
    652           lo_found = .TRUE.
     716          found = .TRUE.
    653717          EXIT
    654718       ENDIF
    655719    ENDDO
    656720
    657     IF ( PRESENT( found ) )  THEN
    658        found = lo_found
    659        RETURN
    660     ENDIF
    661 
    662     IF ( .NOT. lo_found )  THEN
    663        WRITE(9,*) 'REAL value not found ', name
    664        CALL rd_mpi_io_error(3)
     721    IF ( .NOT. found )  THEN
     722       message_string = 'REAL variable "' // TRIM( name ) // '" not found in restart file'
     723       CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
    665724    ENDIF
    666725
    … …  
    729788
    730789    ELSE
    731        WRITE(9,*) 'array_2D not found ', name
    732        CALL rd_mpi_io_error( 2 )
     790       message_string = '2d-REAL array "' // TRIM( name ) // '" not found in restart file'
     791       CALL message( 'rrd_mpi_io_int', 'PA0722', 3, 2, 0, 6, 0 )
    733792    ENDIF
    734793
    … …  
    778837!--                  would be dimensioned in the caller subroutine like this:
    779838!--                  INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg)::  data
    780           CALL rd_mpi_io_error( 2 )
     839          message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
     840                           'file is defined with illegal dimensions in the PALM code'
     841          CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
    781842
    782843       ELSEIF ( (nxr-nxl+1) == SIZE( data, 2 ) )  THEN
    … …  
    805866          ENDDO
    806867
    807           IF ( debug_level >= 2 )  WRITE(9,*) 'r2i ', TRIM( name ),' ', SUM( array_2di )
    808 
    809868       ELSE
    810           WRITE (9,*) '### rrd_mpi_io_int_2d  array: ', TRIM( name )
    811           CALL rd_mpi_io_error( 4 )
     869
     870          message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be read from restart ' // &
     871                           'file is defined with illegal dimensions in the PALM code'
     872          CALL message( 'rrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
     873
    812874       ENDIF
    813875
    814876    ELSE
    815877
    816        WRITE(9,*) 'array_2D not found ', name
    817        CALL rd_mpi_io_error( 2 )
     878       message_string = '2d-INTEGER array "' // TRIM( name ) // '" not found in restart file'
     879       CALL message( 'rrd_mpi_io_int_2d', 'PA0722', 3, 2, 0, 6, 0 )
    818880
    819881    ENDIF
    … …  
    872934             data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_3d(:,i,lb%nys:lb%nyn)
    873935          ENDDO
    874           IF ( debug_level >= 2 )  WRITE(9,*) 'r3f_ob ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
    875936       ELSE
    876937          DO  i = nxl, nxr
    877938             data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
    878939          ENDDO
    879           IF ( debug_level >= 2 )  WRITE(9,*) 'r3f ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
    880940       ENDIF
    881941
    … …  
    883943
    884944    ELSE
    885        WRITE(9,*)  'array_3D not found ', name
    886        CALL rd_mpi_io_error(2)
     945
     946       message_string = '3d-REAL array "' // TRIM( name ) // '" not found in restart file'
     947       CALL message( 'rrd_mpi_io_real_3d', 'PA0722', 3, 2, 0, 6, 0 )
     948
    887949    ENDIF
    888950
    … …  
    9461008             data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp) = array_3d(:,i,lb%nys:lb%nyn)
    9471009          ENDDO
    948           IF ( debug_level >= 2 )  WRITE(9,*) 'r3f_ob_soil ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
    9491010       ELSE
    9501011          DO  i = nxl, nxr
    9511012             data(:,nys:nyn,i) = array_3d(:,i,nys:nyn)
    9521013          ENDDO
    953           IF ( debug_level >= 2 )  WRITE(9,*) 'r3f_soil ', TRIM( name ),' ', SUM( array_3d )
    9541014       ENDIF
    9551015
    9561016    ELSE
    957        WRITE(9,*)  'array_3D not found ', name
    958        CALL rd_mpi_io_error( 2 )
     1017
     1018       message_string = '3d-REAL soil array "' // TRIM( name ) // '" not found in restart file'
     1019       CALL message( 'rrd_mpi_io_real_3d_soil', 'PA0722', 3, 2, 0, 6, 0 )
     1020
    9591021    ENDIF
    9601022
    … …  
    9681030!> Read CHARACTER with MPI-IO
    9691031!--------------------------------------------------------------------------------------------------!
    970  SUBROUTINE rrd_mpi_io_char( name, text, found )
     1032 SUBROUTINE rrd_mpi_io_char( name, text )
    9711033
    9721034    IMPLICIT NONE
    … …  
    9741036    CHARACTER(LEN=*), INTENT(IN)   ::  name
    9751037    CHARACTER(LEN=*), INTENT(OUT)  ::  text
    976     CHARACTER(LEN=128)             ::  lo_line
     1038    CHARACTER(LEN=128)             ::  line
    9771039
    9781040    INTEGER(iwp)                   ::  i
    9791041
    980     LOGICAL, INTENT(OUT), OPTIONAL ::  found
    981     LOGICAL                        ::  lo_found
    982 
    983 
    984     lo_found = .FALSE.
     1042    LOGICAL                        ::  found
     1043
     1044
     1045    found = .FALSE.
    9851046    text = ' '
    9861047
    9871048    DO  i = 1, tgh%nr_char
    988        lo_line = text_lines(i)
    989        IF ( lo_line(1:32) == name )  THEN
    990           IF ( debug_level >= 2 )  WRITE(9,*)  'Character variable found ==> ', lo_line(1:32)
    991           text = lo_line(33:)
    992           lo_found = .TRUE.
     1049       line = text_lines(i)
     1050       IF ( TRIM( line(1:32) ) == TRIM( name ) )  THEN
     1051          text = line(33:)
     1052          found = .TRUE.
    9931053          EXIT
    9941054       ENDIF
    9951055    ENDDO
    9961056
    997     IF ( PRESENT( found ) )  THEN
    998        found = lo_found
    999        RETURN
    1000     ENDIF
    1001 
    1002     IF ( .NOT. lo_found )  THEN
    1003        WRITE(9,*)  'Character variable not found ', name
    1004        CALL rd_mpi_io_error( 3 )
     1057    IF ( .NOT. found )  THEN
     1058       message_string = 'CHARACTER variable "' // TRIM( name ) // '" not found in restart file'
     1059       CALL message( 'rrd_mpi_io_char', 'PA0722', 3, 2, 0, 6, 0 )
    10051060    ENDIF
    10061061
    … …  
    11011156          array_2d(i,lb%nys:lb%nyn) = data(lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
    11021157       ENDDO
    1103        IF ( debug_level >= 2 )  WRITE(9,*)  'w2f_ob ', TRIM( name ), ' ',  SUM( data(nys:nyn,nxl:nxr) )
     1158
    11041159    ELSE
    11051160!
    … …  
    11081163          array_2d(i,lb%nys:lb%nyn) = data(nys:nyn,i)
    11091164       ENDDO
    1110        IF ( debug_level >= 2 )  WRITE(9,*)  'w2f ', TRIM( name ),' ',                              &
    1111                                             SUM( array_2d(nxl:nxr, lb%nys:lb%nyn) )
     1165
    11121166    ENDIF
    11131167
    … …  
    11381192!> Write 2d-INTEGER array with MPI-IO
    11391193!--------------------------------------------------------------------------------------------------!
    1140  SUBROUTINE wrd_mpi_io_int_2d( name, data, ar_found )
     1194 SUBROUTINE wrd_mpi_io_int_2d( name, data )
    11411195
    11421196    IMPLICIT NONE
    … …  
    11511205#endif
    11521206    INTEGER(KIND=iwp), INTENT(IN), DIMENSION(:,:) ::  data
    1153 
    1154     LOGICAl, OPTIONAL                             ::  ar_found
    11551207
    11561208
    … …  
    11641216!--    dimensioned in the caller subroutine as
    11651217!--    INTEGER, DIMENSION(nysg:nyng,nxlg:nxrg) ::  data
    1166        WRITE (9,*) '### wrd_mpi_io_int_2d  IF  array: ', TRIM( name )
    1167        CALL rd_mpi_io_error( 4 )
     1218       message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' //   &
     1219                        'file is defined with illegal dimensions in the PALM code'
     1220       CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
    11681221
    11691222    ELSEIF ( ( nxr-nxl+1 ) == SIZE( data, 2 ) )  THEN
    … …  
    11771230          ENDDO
    11781231       ENDDO
    1179        IF ( debug_level >= 2 )  WRITE(9,*) 'w2i ', TRIM( name ), ' ', SUM( array_2di(nxl:nxr,nys:nyn) ), SUM( data )
    11801232#if defined( __parallel )
    11811233       CALL sm_io%sm_node_barrier()  ! has no effect if I/O on limited number of cores is inactive
    … …  
    11971249
    11981250    ELSE
    1199        WRITE (9,*) '### wrd_mpi_io_int_2d  array: ', TRIM( name )
    1200        CALL rd_mpi_io_error( 4 )
    1201     ENDIF
    1202 
    1203     IF ( PRESENT( ar_found ) )  ar_found = .TRUE.
     1251
     1252       message_string = '2d-INTEGER array "' // TRIM( name ) // '" to be written to restart ' //   &
     1253                        'file is defined with illegal dimensions in the PALM code'
     1254       CALL message( 'wrd_mpi_io_int_2d', 'PA0723', 3, 2, 0, 6, 0 )
     1255
     1256    ENDIF
    12041257
    12051258 END SUBROUTINE wrd_mpi_io_int_2d
    … …  
    12391292          array_3d(:,i,lb%nys:lb%nyn) = data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
    12401293       ENDDO
    1241        IF ( debug_level >= 2 )  WRITE(9,*) 'w3f_ob ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
     1294
    12421295    ELSE
    12431296!
    … …  
    12461299           array_3d(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
    12471300       ENDDO
    1248        IF ( debug_level >= 2 )  WRITE(9,*)  'w3f ', TRIM( name ),' ', SUM( data(:,nys:nyn,nxl:nxr) )
     1301
    12491302    ENDIF
    12501303#if defined( __parallel )
    … …  
    13121365          array_3d_soil(:,i,lb%nys:lb%nyn) = data(:,lb%nys-nbgp:lb%nyn-nbgp,i-nbgp)
    13131366       ENDDO
    1314        IF ( debug_level >= 2 )  WRITE(9,*) 'w3f_ob_soil ', TRIM( name ), ' ', SUM( data(:,nys:nyn,nxl:nxr) )
     1367
    13151368    ELSE
    13161369!
    … …  
    13191372          array_3d_soil(:,i,lb%nys:lb%nyn) = data(:,nys:nyn,i)
    13201373       ENDDO
    1321        IF ( debug_level >= 2 )  WRITE(9,*) 'w3f_soil ', TRIM( name ), ' ', SUM( array_3d )
     1374
    13221375    ENDIF
    13231376#if defined( __parallel )
    … …  
    14461499       CALL posix_read( fh, data, SIZE( data ) )
    14471500#endif
    1448        IF ( debug_level >= 2) WRITE(9,*) 'rr1f ',name,' ', SUM( data)
     1501
    14491502    ELSE
    1450        WRITE(9,*)  'replicated array_1D not found ', name
    1451        CALL rd_mpi_io_error( 2 )
     1503
     1504       message_string = '1d/2d/3d/4d-REAL global array "' // TRIM( name ) // '" not found in ' //  &
     1505                        'restart file'
     1506       CALL message( 'rrd_mpi_io_global_array_real_1d', 'PA0722', 3, 2, 0, 6, 0 )
     1507
    14521508    ENDIF
    14531509
    … …  
    14811537
    14821538    CALL rrd_mpi_io_global_array_real_1d( name, buf )
    1483     IF ( debug_level >= 2 )  WRITE(9,*) 'rr2f ', TRIM( name ), ' ', bufshape(1), SUM( data )
    14841539
    14851540 END SUBROUTINE rrd_mpi_io_global_array_real_2d
    … …  
    15131568    CALL rrd_mpi_io_global_array_real_1d( name, buf )
    15141569
    1515     IF ( debug_level >= 2 )  WRITE(9,*) 'rr3f ', TRIM( name ), ' ', bufshape(1), SUM( data )
    1516 
    15171570 END SUBROUTINE rrd_mpi_io_global_array_real_3d
    15181571
    … …  
    15441597
    15451598    CALL rrd_mpi_io_global_array_real_1d( name, buf )
    1546     IF ( debug_level >= 2 )  WRITE(9,*) 'rr4f ', TRIM( name ), ' ', bufshape(1), SUM( data )
    15471599
    15481600 END SUBROUTINE rrd_mpi_io_global_array_real_4d
    … …  
    15561608!> Array contains identical data on all PEs.
    15571609!--------------------------------------------------------------------------------------------------!
    1558  SUBROUTINE rrd_mpi_io_global_array_int_1d( name, data, ar_found )
     1610 SUBROUTINE rrd_mpi_io_global_array_int_1d( name, data )
    15591611
    15601612    IMPLICIT NONE
    … …  
    15701622    INTEGER(KIND=iwp), INTENT(INOUT), DIMENSION(:) ::  data
    15711623
    1572     LOGICAl, OPTIONAL                              ::  ar_found
    15731624    LOGICAL                                        ::  found
    15741625
    … …  
    16021653#endif
    16031654    ELSE
    1604        IF ( PRESENT( ar_found ) )  THEN
    1605           ar_found =.FALSE.
    1606           RETURN
    1607        ELSE
    1608           WRITE (9,*) '### rrd_mpi_io_global_array_int_1d ', TRIM( name )
    1609           CALL rd_mpi_io_error( 4 )
    1610           WRITE(9,*)  'replicated array_1D not found ', name
    1611           CALL rd_mpi_io_error( 2 )
    1612        ENDIF
    1613     ENDIF
    1614 
    1615     IF ( PRESENT( ar_found ) )  ar_found =.TRUE.
     1655
     1656       message_string = '1d-INTEGER global array "' // TRIM( name ) // '" not found in ' //        &
     1657                        'restart file'
     1658       CALL message( 'rrd_mpi_io_global_array_int_1d', 'PA0722', 3, 2, 0, 6, 0 )
     1659
     1660    ENDIF
    16161661
    16171662 END SUBROUTINE rrd_mpi_io_global_array_int_1d
    … …  
    16461691    header_arr_index = header_arr_index + 1
    16471692
    1648     IF ( debug_level >= 2 )  WRITE(9,*)  'wr1f ', TRIM( name ), ' ', SUM( data )
    1649 !
    1650 !--    Set default view
    1651 #if defined( __parallel )
    1652        IF ( sm_io%iam_io_pe )  THEN
    1653           CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
    1654        ENDIF
    1655 !
    1656 !--    Only PE 0 writes replicated data
    1657        IF ( myid == 0 )  THEN
    1658           CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
    1659           CALL MPI_FILE_WRITE( fh, data, SIZE( data), MPI_REAL, status, ierr )
    1660        ENDIF
     1693!
     1694!-- Set default view
     1695#if defined( __parallel )
     1696    IF ( sm_io%iam_io_pe )  THEN
     1697       CALL MPI_FILE_SET_VIEW( fh, offset, MPI_BYTE, MPI_BYTE, 'native', MPI_INFO_NULL, ierr )
     1698    ENDIF
     1699!
     1700!-- Only PE 0 writes replicated data
     1701    IF ( myid == 0 )  THEN
     1702       CALL MPI_FILE_SEEK( fh, array_position, MPI_SEEK_SET, ierr )
     1703       CALL MPI_FILE_WRITE( fh, data, SIZE( data), MPI_REAL, status, ierr )
     1704    ENDIF
    16611705#else
    1662        CALL posix_lseek( fh, array_position )
    1663        CALL posix_write( fh, data, SIZE( data ) )
    1664 #endif
    1665        array_position = array_position + SIZE( data ) * wp
     1706    CALL posix_lseek( fh, array_position )
     1707    CALL posix_write( fh, data, SIZE( data ) )
     1708#endif
     1709    array_position = array_position + SIZE( data ) * wp
    16661710
    16671711 END SUBROUTINE wrd_mpi_io_global_array_real_1d
    … …  
    16931737    CALL C_F_POINTER( c_data, buf, bufshape )
    16941738
    1695     IF ( debug_level >= 2 )  WRITE(9,*)  'wr2f ', TRIM( name ), ' ', bufshape(1), SUM( data )
    1696 
    16971739    CALL wrd_mpi_io_global_array_real_1d( name, buf )
    16981740
    … …  
    17251767    CALL C_F_POINTER( c_data, buf, bufshape )
    17261768
    1727     IF ( debug_level >= 2 )  WRITE(9,*)  'wr3f ', TRIM( name ), ' ', bufshape(1), SUM( data )
    1728 
    17291769    CALL wrd_mpi_io_global_array_real_1d( name, buf )
    17301770
    … …  
    17561796    bufshape(1) = SIZE( data)
    17571797    CALL C_F_POINTER( c_data, buf, bufshape )
    1758 
    1759     IF ( debug_level >= 2 )  WRITE(9,*) 'wr4f ', TRIM( name ), ' ', bufshape(1), SUM( data )
    17601798
    17611799    CALL wrd_mpi_io_global_array_real_1d( name, buf )
    … …  
    17891827    header_arr_index = header_arr_index + 1
    17901828
    1791     IF ( debug_level >= 2 )  WRITE(9,*)  'wr1i ', TRIM( name ), ' ', SUM( data )
    17921829!
    17931830!-- Set default view
    … …  
    19061943             ELSE                                          ! read
    19071944#if defined( __parallel )
    1908                 IF ( debug_level >= 2 )  WRITE(9,'(a,4i4,4i10)') 'read block ', j, i, j_f, i_f,    &
    1909                                                          m_start_index(j_f,i_f), nr_bytes_f, disp_f
    19101945                CALL MPI_FILE_SEEK( fhs, disp_f, MPI_SEEK_SET, ierr )
    19111946                nr_words = nr_bytes_f / wp
    … …  
    19251960
    19261961    ELSE
    1927        WRITE(9,*) 'surface array not found ', name
    1928        CALL rd_mpi_io_error( 2 )
    1929     ENDIF
    1930 
    1931       IF ( lo_first_index == 1 )  THEN
    1932          IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
    1933       ELSE
    1934          IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf_next ', TRIM( name ), ' ', &
    1935                                                                lo_first_index,nr_val, SUM( data(1:nr_val) )
    1936       ENDIF
     1962
     1963       message_string = 'surface array "' // TRIM( name ) // '" not found in restart file'
     1964       CALL message( 'rrd_mpi_io_global_array_int_1d', 'PA0722', 3, 2, 0, 6, 0 )
     1965
     1966    ENDIF
     1967
     1968!    IF ( lo_first_index == 1 )  THEN
     1969!       IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
     1970!    ELSE
     1971!       IF ( debug_level >= 2 .AND. nr_val > 0 )  WRITE(9,*)  'r_surf_next ', TRIM( name ), ' ', &
     1972!                                                             lo_first_index,nr_val, SUM( data(1:nr_val) )
     1973!    ENDIF
    19371974
    19381975 END SUBROUTINE rrd_mpi_io_surface
    … …  
    20262063          array_1d(i+local_start) = data(i)
    20272064       ENDDO
    2028        IF ( debug_level >= 2 )  WRITE(9,*) 'w_surf ', TRIM( name ), ' ', SUM( array_1d(local_start+1:local_start+nr_val)),sum(data)
    20292065    ELSE
    20302066!       array_1d => data                           !kk Did not work in all cases    why???
    … …  
    20562092    array_position = array_position + total_number_of_surface_values * wp
    20572093
    2058     IF ( lo_first_index == 1 )  THEN
    2059        IF ( debug_level >= 2 .AND. nr_val  > 0 )  WRITE(9,*) 'w_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
    2060     ELSE
    2061        IF ( debug_level >= 2 .AND. nr_val  > 0 ) WRITE(9,*) 'w_surf_n ', TRIM( name ), ' ', &
    2062                                                             lo_first_index, nr_val, SUM( data(1:nr_val) )
    2063     ENDIF
     2094!    IF ( lo_first_index == 1 )  THEN
     2095!       IF ( debug_level >= 2 .AND. nr_val  > 0 )  WRITE(9,*) 'w_surf_1 ', TRIM( name ), ' ', nr_val, SUM( data(1:nr_val) )
     2096!    ELSE
     2097!       IF ( debug_level >= 2 .AND. nr_val  > 0 ) WRITE(9,*) 'w_surf_n ', TRIM( name ), ' ', &
     2098!                                                            lo_first_index, nr_val, SUM( data(1:nr_val) )
     2099!    ENDIF
    20642100
    20652101 END SUBROUTINE wrd_mpi_io_surface
    … …  
    21222158       tgh%total_nx  = lb%nx + 1
    21232159       tgh%total_ny  = lb%ny + 1
    2124        IF ( include_total_domain_boundaries )  THEN   ! not sure, if LOGICAL interpretation is the same on all compilers,
     2160       IF ( include_total_domain_boundaries )  THEN   ! not sure, if LOGICAL interpretation is the same for all compilers,
    21252161          tgh%i_outer_bound = 1        ! therefore store as INTEGER in general header
    21262162       ELSE
    … …  
    21752211
    21762212          CALL MPI_FILE_SEEK( fh, header_position, MPI_SEEK_SET, ierr )
    2177           CALL MPI_FILE_WRITE( fh, array_offset, SIZE( array_offset )*MPI_OFFSET_KIND, MPI_BYTE, status, ierr )   !There is no I*8 datatype in FORTRAN
     2213          CALL MPI_FILE_WRITE( fh, array_offset, SIZE( array_offset )*MPI_OFFSET_KIND, MPI_BYTE,   &
     2214                               status, ierr )  ! There is no I*8 datatype in Fortran
    21782215          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
    21792216#else
    … …  
    22152252          header_position = header_position + SIZE( array_offset ) * rd_offset_kind
    22162253#endif
    2217           IF ( debug_level >= 2 )  THEN
    2218              WRITE(9,*)  'header position after arrays  ', header_position, gh_size
    2219           ENDIF
    2220 
    2221           IF ( print_header_now )  CALL rd_mpi_io_print_header
     2254          IF ( debug_output )  CALL rd_mpi_io_print_header
    22222255       ENDIF
    22232256
    … …  
    22482281    ENDIF
    22492282
    2250     mb_processed = array_position / ( 1024.0_dp * 1024.0_dp )
     2283    restart_file_size = array_position / ( 1024.0_dp * 1024.0_dp )
    22512284
    22522285 END SUBROUTINE rd_mpi_io_close
    … …  
    26872720
    26882721
    2689     IF ( debug_level >= 1 )  THEN
    2690  
    2691        WRITE (9,*)  ' '
    2692        WRITE (9,*)  ' CHARACTER header values ', tgh%nr_char
    2693        WRITE (9,*)  ' '
    2694        DO  i = 1, tgh%nr_char
    2695           WRITE(9,*)  text_lines(i)(1:80)
    2696        ENDDO
    2697 
    2698        WRITE (9,*)  ' '
    2699        WRITE (9,*) ' INTEGER header values ', tgh%nr_int
    2700        WRITE (9,*)  ' '
    2701        DO  i = 1, tgh%nr_int
    2702           WRITE(9,*)  'INTERGER value:   ', int_names(i), ' ', int_values(i)
    2703        ENDDO
    2704 
    2705        WRITE (9,*)  ' '
    2706        WRITE (9,*)  ' REAL header values ', tgh%nr_real
    2707        WRITE (9,*)  ' '
    2708        DO  i = 1, tgh%nr_real
    2709           WRITE(9,*) 'REAL     value:   ', real_names(i), ' ', real_values(i)
    2710        ENDDO
    2711 
    2712        WRITE (9,*)  ' '
    2713        WRITE (9,*)  ' Header entries with Offset ',tgh%nr_arrays
    2714        WRITE (9,*)  '                Name                                  Offset '
    2715        DO  i = 1, tgh%nr_arrays
    2716           WRITE(9,'(a,1x,a30,1x,i16)') 'Header entiy:   ', array_names(i), array_offset(i)
    2717        ENDDO
    2718        WRITE (9,*)  ' '
    2719     ENDIF
    2720 
    2721     print_header_now = .FALSE.
     2722    WRITE (9,*)  'header position after reading the restart file header: ', header_position
     2723    WRITE (9,*)  ' '
     2724    WRITE (9,*)  'restart file header content:'
     2725    WRITE (9,*)  '----------------------------'
     2726    WRITE (9,*)  ' '
     2727
     2728    WRITE (9,*)  ' CHARACTER header values   Total number: ', tgh%nr_char
     2729    WRITE (9,*)  ' '
     2730    DO  i = 1, tgh%nr_char
     2731       WRITE( 9, '(I3,A,1X,A)' )  i, ': ', text_lines(i)(1:80)
     2732    ENDDO
     2733    WRITE (9,*)  ' '
     2734
     2735    WRITE (9,*) ' INTEGER header variables and values   Total number: ', tgh%nr_int
     2736    WRITE (9,*)  ' '
     2737    DO  i = 1, tgh%nr_int
     2738       WRITE(9,*)  ' variable: ', int_names(i), '  value: ', int_values(i)
     2739    ENDDO
     2740    WRITE (9,*)  ' '
     2741
     2742    WRITE (9,*)  ' REAL header variables and values   Total number: ', tgh%nr_real
     2743    WRITE (9,*)  ' '
     2744    DO  i = 1, tgh%nr_real
     2745       WRITE(9,*)  ' variable: ', real_names(i), '  value: ', real_values(i)
     2746    ENDDO
     2747    WRITE (9,*)  ' '
     2748
     2749    WRITE (9,*)  ' Header entries with offset (2d/3d arrays)   Total number: ', tgh%nr_arrays
     2750    WRITE (9,*)  ' '
     2751    DO  i = 1, tgh%nr_arrays
     2752       WRITE(9,*)  ' variable: ', array_names(i), '  offset: ', array_offset(i)
     2753    ENDDO
     2754    WRITE (9,*)  ' '
    27222755
    27232756 END SUBROUTINE rd_mpi_io_print_header
    2724 
    2725 
    2726 
    2727 !--------------------------------------------------------------------------------------------------!
    2728 ! Description:
    2729 ! ------------
    2730 !> Print error messages for reading/writing restart data with MPI-IO
    2731 !--------------------------------------------------------------------------------------------------!
    2732  SUBROUTINE rd_mpi_io_error( error_number )
    2733 
    2734     IMPLICIT NONE
    2735 
    2736     INTEGER, INTENT(IN) ::  error_number
    2737 
    2738     IF ( myid == 0)  THEN
    2739 
    2740        SELECT CASE (error_number)
    2741  
    2742           CASE ( 1 )
    2743              WRITE(6,*)  'illegal action while opening restart File'
    2744           CASE ( 2 )
    2745              WRITE(6,*)  'data array not found in restart File'
    2746           CASE ( 3 )
    2747              WRITE(6,*)  'INTEGER or REAL value not found in restart File'
    2748           CASE ( 4 )
    2749              WRITE(6,*)  'Arrays only array with nbgp Halos or without halos legal'
    2750           CASE ( 5 )
    2751              WRITE(6,*)  'outer boundary in model and outer boundary in restart file do not match'
    2752           CASE ( 6 )
    2753              WRITE(6,*)  'posix IO: ERROR Opening Restart File'
    2754           CASE DEFAULT
    2755              WRITE(6,*)  'rd_mpi_io_error: illegal error number: ',error_number
    2756 
    2757        END SELECT
    2758 
    2759     ENDIF
    2760 #if defined( __parallel )
    2761     IF ( .NOT. sm_io%iam_io_pe )  RETURN
    2762 
    2763     CALL MPI_BARRIER( comm_io, ierr )
    2764     CALL MPI_ABORT( comm_io, 1, ierr )
    2765 #else
    2766     CALL ABORT
    2767 #endif
    2768 
    2769  END SUBROUTINE rd_mpi_io_error
    27702757
    27712758
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |