Ignore:
Timestamp:
Sep 15, 2011 1:58:31 PM (13 years ago)
Author:
raasch
Message:

New:
---

The number of parallel I/O operations can be limited with new mrun-option -w.
(advec_particles, data_output_2d, data_output_3d, header, init_grid, init_pegrid, init_3d_model, modules, palm, parin, write_3d_binary)

Changed:


mrun option -T is obligatory

Errors:


Bugfix: No zero assignments to volume_flow_initial and volume_flow_area in
case of normal restart runs. (init_3d_model)

initialization of u_0, v_0. This is just to avoid access of uninitialized
memory in exchange_horiz_2d, which causes respective error messages
when the Intel thread checker (inspector) is used. (production_e)

Bugfix for ts limitation (prandtl_fluxes)

File:
1 edited

Legend:

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

    r723 r759  
    44! Current revisions:
    55! -----------------
    6 !
     6! Splitting of parallel I/O in blocks of PEs
    77!
    88! Former revisions:
     
    8080
    8181    INTEGER ::  bh, blx, bly, bxl, bxr, byn, bys, ch, cwx, cwy, cxl, cxr, cyn, &
    82                 cys, gls, i, inc, i_center, j, j_center, k, l, nxl_l, nxr_l, &
    83                 nyn_l, nys_l, nzb_si, nzt_l, vi
     82                cys, gls, i, ii, inc, i_center, j, j_center, k, l, nxl_l,      &
     83                nxr_l, nyn_l, nys_l, nzb_si, nzt_l, vi
    8484
    8585    INTEGER, DIMENSION(:), ALLOCATABLE   ::  vertical_influence
     
    507507
    508508       CASE ( 'read_from_file' )
    509 !
    510 !--       Arbitrary irregular topography data in PALM format (exactly matching
    511 !--       the grid size and total domain size)
    512           OPEN( 90, FILE='TOPOGRAPHY_DATA', STATUS='OLD', FORM='FORMATTED',  &
    513                ERR=10 )
    514           DO  j = ny, 0, -1
    515              READ( 90, *, ERR=11, END=11 )  ( topo_height(j,i), i = 0, nx )
    516           ENDDO
     509
     510          DO  ii = 0, io_blocks-1
     511             IF ( ii == io_group )  THEN
     512
     513!
     514!--             Arbitrary irregular topography data in PALM format (exactly
     515!--             matching the grid size and total domain size)
     516                OPEN( 90, FILE='TOPOGRAPHY_DATA', STATUS='OLD', &
     517                      FORM='FORMATTED', ERR=10 )
     518                DO  j = ny, 0, -1
     519                   READ( 90, *, ERR=11, END=11 )  ( topo_height(j,i), i = 0,nx )
     520                ENDDO
     521
     522                GOTO 12
     523         
     524 10             message_string = 'file TOPOGRAPHY_DATA does not exist'
     525                CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 )
     526
     527 11             message_string = 'errors in file TOPOGRAPHY_DATA'
     528                CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 )
     529
     530 12             CLOSE( 90 )
     531
     532             ENDIF
     533#if defined( __parallel )
     534             CALL MPI_BARRIER( comm2d, ierr )
     535#endif
     536          ENDDO
     537
    517538!
    518539!--       Calculate the index height of the topography
     
    523544          ENDDO
    524545!
    525 !--       Add cyclic boundaries (additional layers are for calculating flag
    526 !--       arrays needed for the multigrid sover)
     546!--       Add cyclic boundaries (additional layers are for calculating
     547!--       flag arrays needed for the multigrid sover)
    527548          nzb_local(-gls:-1,0:nx)     = nzb_local(ny-gls+1:ny,0:nx)
    528549          nzb_local(ny+1:ny+gls,0:nx) = nzb_local(0:gls-1,0:nx)
    529550          nzb_local(:,-gls:-1)        = nzb_local(:,nx-gls+1:nx)
    530551          nzb_local(:,nx+1:nx+gls)    = nzb_local(:,0:gls-1)
    531 
    532 
    533      
    534           GOTO 12
    535          
    536  10       message_string = 'file TOPOGRAPHY_DATA does not exist'
    537           CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 )
    538 
    539  11       message_string = 'errors in file TOPOGRAPHY_DATA'
    540           CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 )
    541 
    542  12       CLOSE( 90 )
    543552
    544553       CASE DEFAULT
Note: See TracChangeset for help on using the changeset viewer.