Ignore:
Timestamp:
Sep 7, 2010 2:50:07 PM (14 years ago)
Author:
weinreis
Message:

bugfix message string in set_mask_locations

File:
1 edited

Legend:

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

    r554 r557  
    9898    IMPLICIT NONE
    9999
    100     INTEGER ::  idum
     100    INTEGER ::  idum, mod_blocksize, rbs
    101101
    102102
     
    104104                       bc_ns, bc_p_b, bc_p_t, bc_pt_b, bc_pt_t, bc_q_b, &
    105105             bc_q_t,bc_s_b, bc_s_t, bc_sa_t, bc_uv_b, bc_uv_t, &
     106             binary_io_blocksize, &
    106107             bottom_salinityflux, building_height, building_length_x, &
    107108             building_length_y, building_wall_left, building_wall_south, &
     
    208209 11 message_string = 'no \$inipar-namelist found'
    209210    CALL message( 'parin', 'PA0272', 1, 2, 0, 6, 0 )
    210 
     211   
     212!
     213!-- Check blocksize of binary IO
     21412  mod_blocksize = MODULO(numprocs,binary_io_blocksize)
     215    IF ( mod_blocksize /= 0 ) THEN
     216       WRITE( message_string, * ) 'illegal value for binary_io_blocksize: &
     217                                  ', binary_io_blocksize, &
     218                                  ' - no binary IO block by block' 
     219       CALL message( 'check_parameters', 'PA0325', 0, 1, 0, 6, 0)
     220       binary_io_blocksize = numprocs
     221    ENDIF
     222    mod_numprocs_size = MOD(myid,numprocs/binary_io_blocksize)
     223   
    211224!
    212225!-- If required, read control parameters from restart file (produced by
    213226!-- a prior run). All PEs are reading from file created by PE0 (see check_open)
    214  12 IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
    215 
    216        CALL read_var_list
     227    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
     228   
     229       DO rbs = 0, numprocs/binary_io_blocksize-1
     230          IF ( mod_numprocs_size == rbs ) THEN
     231             CALL read_var_list
     232          ENDIF 
     233          CALL MPI_BARRIER(comm2d, ierr )   
     234       ENDDO
     235       
    217236!
    218237!--    The restart file will be reopened when reading the subdomain data
Note: See TracChangeset for help on using the changeset viewer.