Ignore:
Timestamp:
Feb 8, 2012 4:11:23 PM (12 years ago)
Author:
maronga
Message:

bugfix: namelist file check now possible for topography and re-enabled. mrungui update (-z option)

File:
1 edited

Legend:

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

    r810 r818  
    44! Current revisions:
    55! -----------------
    6 !
     6! Bugfix: topo_height is only required if topography is used. It is thus now
     7! allocated in the topography branch
    78!
    89! Former revisions:
     
    3839!
    3940! 555 2010-09-07 07:32:53Z raasch
    40 ! Bugfix: default setting of nzb_local for flat topographie
     41! Bugfix: default setting of nzb_local for flat topography
    4142!
    4243! 274 2009-03-26 15:11:21Z heinze
     
    100101    REAL    ::  dx_l, dy_l, dz_stretched
    101102
    102     REAL, DIMENSION(0:ny,0:nx)          ::  topo_height
     103    REAL, DIMENSION(:,:), ALLOCATABLE   ::  topo_height
    103104
    104105    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  distance
     
    331332    ALLOCATE( l_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    332333
     334
    333335    nzb_s_inner = nzb;  nzb_s_outer = nzb
    334336    nzb_u_inner = nzb;  nzb_u_outer = nzb
     
    517519       CASE ( 'read_from_file' )
    518520
     521          ALLOCATE ( topo_height(0:ny,0:nx) )
     522
    519523          DO  ii = 0, io_blocks-1
    520524             IF ( ii == io_group )  THEN
     
    552556             ENDDO
    553557          ENDDO
     558
     559          DEALLOCATE ( topo_height )
    554560!
    555561!--       Add cyclic boundaries (additional layers are for calculating
Note: See TracChangeset for help on using the changeset viewer.