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/init_grid.f90

    r556 r557  
    6363    INTEGER ::  bh, blx, bly, bxl, bxr, byn, bys, ch, cwx, cwy, cxl, cxr, cyn, &
    6464                cys, gls, i, inc, i_center, j, j_center, k, l, nxl_l, nxr_l, &
    65                 nyn_l, nys_l, nzb_si, nzt_l, vi
     65                nyn_l, nys_l, nzb_si, nzt_l, rbs, vi
    6666
    6767    INTEGER, DIMENSION(:), ALLOCATABLE   ::  vertical_influence
     
    460460          OPEN( 90, FILE='TOPOGRAPHY_DATA', STATUS='OLD', FORM='FORMATTED',  &
    461461               ERR=10 )
    462           DO  j = ny, 0, -1
    463              READ( 90, *, ERR=11, END=11 )  ( topo_height(j,i), i = 0, nx )
    464           ENDDO
     462          DO rbs = 0, numprocs/binary_io_blocksize-1     
     463             IF ( mod_numprocs_size == rbs ) THEN
     464                DO  j = ny, 0, -1
     465                   READ( 90, *, ERR=11, END=11 )  ( topo_height(j,i), i = 0, nx )
     466                ENDDO
     467             ENDIF 
     468             CALL MPI_BARRIER(comm2d, ierr )     
     469          ENDDO
    465470!
    466471!--       Calculate the index height of the topography
Note: See TracChangeset for help on using the changeset viewer.