Ignore:
Timestamp:
Feb 27, 2009 2:01:30 PM (15 years ago)
Author:
heinze
Message:

Output of messages replaced by message handling routin

File:
1 edited

Legend:

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

    r198 r247  
    1  SUBROUTINE check_open( file_id )
     1SUBROUTINE check_open( file_id )
    22
    33!------------------------------------------------------------------------------!
    4 ! Actual revisions:
     4! Current revisions:
    55! -----------------
    6 !
     6! Output of messages replaced by message handling routine
     7!
    78!
    89! Former revisions:
     
    99100          CASE ( 13, 14, 21, 22, 23, 80:85 )
    100101             IF ( file_id == 14 .AND. openfile(file_id)%opened_before )  THEN
    101                 IF ( myid == 0 )  PRINT*, '+++ check_open: re-open of unit ', &
    102                                    ' 14 is not verified. Please check results!'
     102                message_string = 're-open of unit ' // &
     103                                 ' 14 is not verified. Please check results!'
     104                CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )       
    103105             ENDIF
    104106
    105107          CASE DEFAULT
    106              IF ( myid == 0 )  THEN
    107                 PRINT*, '+++ check_open: re-opening of file-id ', file_id, &
    108                         ' is not allowed'
    109              ENDIF
     108             WRITE( message_string, * ) 're-opening of file-id ', file_id, &
     109                                           ' is not allowed'
     110             CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )   
     111              
    110112             RETURN
    111113
     
    119121       CASE ( 15, 16, 17, 18, 19, 40:49, 50:59, 81:84, 101:107, 109, 111:113, &
    120122              116 )
    121 
     123         
    122124          IF ( myid /= 0 )  THEN
    123              PRINT*,'+++ check_open: opening file-id ',file_id, &
    124                     ' not allowed for PE ',myid
    125 #if defined( __parallel )
    126              CALL MPI_ABORT( comm2d, 9999, ierr )
    127 #else
    128              CALL local_stop
    129 #endif
     125             WRITE( message_string, * ) 'opening file-id ',file_id, &
     126                                        ' not allowed for PE ',myid
     127             CALL message( 'check_open', 'PA0167', 2, 2, 0, 6, 0 )
    130128          ENDIF
    131129
     
    134132          IF ( .NOT.  data_output_2d_on_each_pe )  THEN
    135133             IF ( myid /= 0 )  THEN
    136                 PRINT*,'+++ check_open: opening file-id ',file_id, &
    137                        ' not allowed for PE ',myid
    138 #if defined( __parallel )
    139                 CALL MPI_ABORT( comm2d, 9999, ierr )
    140 #else
    141                 CALL local_stop
    142 #endif
    143              ENDIF
     134                WRITE( message_string, * ) 'opening file-id ',file_id, &
     135                                           ' not allowed for PE ',myid
     136                CALL message( 'check_open', 'PA0167', 2, 2, 0, 6, 0 )
     137             END IF
    144138          ENDIF
    145139
     
    148142!
    149143!--       File-ids that are used temporarily in other routines
    150           PRINT*,'+++ check_open: opening file-id ',file_id, &
    151                  ' is not allowed since it is used otherwise'
    152 
     144          WRITE( message_string, * ) 'opening file-id ',file_id, &
     145                                     ' is not allowed since it is used otherwise'
     146          CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
     147         
    153148    END SELECT
    154149
     
    409404                IF ( .NOT. avs_coor_file_found  .OR. &
    410405                     .NOT. avs_data_file_found )  THEN
    411                    PRINT*, '+++ check_open: no filename for AVS-data-file ', &
    412                              'found in MRUN-config-file'
    413                    PRINT*, '                filename in FLD-file set to ', &
    414                              '"unknown"'
     406                   message_string= 'no filename for AVS-data-file ' // &
     407                                   'found in MRUN-config-file' // &
     408                                   ' &filename in FLD-file set to "unknown"'
     409                   CALL message( 'check_open', 'PA0169', 0, 1, 0, 6, 0 )
    415410
    416411                   avs_coor_file = 'unknown'
     
    429424                      batch_scp = '/home/nhbksira/pub/batch_scp'
    430425                   ELSE
    431                       PRINT*,'+++ check_open: no path for batch_scp on host "',&
    432                              TRIM( host ), '"'
     426                      message_string= 'no path for batch_scp on host "' // &
     427                                       TRIM( host ) // '"'
     428                      CALL message( 'check_open', 'PA0170', 0, 1, 0, 6, 0 )
    433429                      get_filenames = .FALSE.
    434430                   ENDIF
     
    727723                                       id_set_xy(av) )
    728724#else
    729                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    730                                                'offset allowed on this machine'
     725                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     726                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     727
    731728                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
    732729#endif
     
    787784                                       id_set_xz(av) )
    788785#else
    789                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    790                                                'offset allowed on this machine'
     786                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     787                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     788         
    791789                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
    792790#endif
     
    847845                                       id_set_yz(av) )
    848846#else
    849                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    850                                                'offset allowed on this machine'
     847                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     848                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     849               
    851850                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
    852851#endif
     
    900899                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
    901900                                       id_set_pr )
    902 #else
    903                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    904                                                'offset allowed on this machine'
     901#else
     902                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     903                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     904               
    905905                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pr )
    906906#endif
     
    954954                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
    955955                                       id_set_ts )
    956 #else
    957                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    958                                                'offset allowed on this machine'
     956#else
     957                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     958                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     959               
    959960                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_ts )
    960961#endif
     
    10151016                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
    10161017                                       id_set_3d(av) )
    1017 #else
    1018                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    1019                                                'offset allowed on this machine'
     1018#else
     1019                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     1020                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     1021               
    10201022                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
    10211023#endif
     
    10701072                                       OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
    10711073                                       id_set_sp )
    1072 #else
    1073                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    1074                                                'offset allowed on this machine'
     1074#else
     1075                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     1076                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     1077               
    10751078                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_sp )
    10761079#endif
     
    11461149                                       id_set_prt )
    11471150#else
    1148                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    1149                                                'offset allowed on this machine'
     1151                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     1152                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     1153               
    11501154                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
    11511155#endif
     
    12011205                                       id_set_pts )
    12021206#else
    1203                 IF ( myid == 0 )  PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
    1204                                                'offset allowed on this machine'
     1207                message_string = 'NetCDF: no 64-bit offset allowed on this machine'
     1208                CALL message( 'check_open', 'PA0171', 0, 1, 0, 6, 0 )
     1209               
    12051210                nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pts )
    12061211#endif
     
    12261231       CASE DEFAULT
    12271232
    1228           PRINT*,'+++ check_open: no OPEN-statement for file-id ',file_id
    1229 #if defined( __parallel )
    1230           CALL MPI_ABORT( comm2d, 9999, ierr )
    1231 #else
    1232           CALL local_stop
    1233 #endif
     1233          WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
     1234          CALL message( 'check_open', 'PA0172', 2, 2, 0, 6, 0 )
    12341235
    12351236    END SELECT
Note: See TracChangeset for help on using the changeset viewer.