Changeset 147 for palm


Ignore:
Timestamp:
Feb 1, 2008 12:41:46 PM (16 years ago)
Author:
raasch
Message:

further updates for turbulent inflow: reading input data of a precursor run using a smaller total domain is working

Location:
palm/trunk/SOURCE
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/CURRENT_MODIFICATIONS

    r146 r147  
    1515necessary for the current subdomain.
    1616
     17The turbulence recycling method of Kataoka and Mizuno (2002) has been
     18implemented. A pre-run with smaller model domain can be used to initialize
     19the real run, in order to spare the CPU time needed to get the turbulence
     20into a quasi-stationary state (see initializing_actions =
     21'read_data_for_recycling').
     22
    1723User-defined spectra.
    1824
    19 calc_spectra, check_open, data_output_spectra, init_pegrid, modules, netcdf, read_var_list, read_3d_binary, user_interface, write_var_list, write_3d_binary
     25calc_spectra, check_open, check_parameters, data_output_spectra, init_pegrid, init_3d_model, modules, netcdf, read_var_list, read_3d_binary, user_interface, write_var_list, write_3d_binary
    2026
    2127
     
    5056contained uneccessary time levels. (read_3d_binary, write_3d_binary)
    5157Bugfix: extra '*' removed in user_statistics sample code (user_interface)
     58Bugfix: a stop command was missing in some cases of the parallel branch (local_stop)
    5259
    53 flow_statistics, plant_canopy_model, read_3d_binary, user_interface, write_3d_binary
    5460
     61flow_statistics, local_stop, plant_canopy_model, read_3d_binary, user_interface, write_3d_binary
     62
  • palm/trunk/SOURCE/check_parameters.f90

    r139 r147  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Case of reading data for recycling included in initializing_actions
    77!
    88! Former revisions:
     
    506506    ENDIF
    507507
    508     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
     508    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.  &
     509         TRIM( initializing_actions ) /= 'read_data_for_recycling' )  THEN
    509510!
    510511!--    No model continuation run; several initialising actions are possible
  • palm/trunk/SOURCE/header.f90

    r139 r147  
    108108    IF ( TRIM( initializing_actions ) == 'read_restart_data' )  THEN
    109109       run_classification = '3D - restart run'
     110    ELSEIF ( TRIM( initializing_actions ) == 'read_data_for_recycling' )  THEN
     111       run_classification = '3D - run using 3D - prerun data'
     112    ELSEIF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
     113       run_classification = '3D - run without 1D - prerun'
     114    ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
     115       run_classification = '3D - run with 1D - prerun'
    110116    ELSE
    111        IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 )  THEN
    112           run_classification = '3D - run without 1D - prerun'
    113        ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
    114           run_classification = '3D - run with 1D - prerun'
    115        ELSE
    116           PRINT*,'+++ header:  unknown action(s): ',initializing_actions
    117        ENDIF
     117       PRINT*,'+++ header:  unknown action(s): ',initializing_actions
    118118    ENDIF
    119119    IF ( ocean )  THEN
  • palm/trunk/SOURCE/init_3d_model.f90

    r146 r147  
    88! -----------------
    99! Allocation of hom_sum moved to parin, initialization of spectrum_x|y directly
    10 ! after allocating theses arrays
     10! after allocating theses arrays,
     11! read data for recycling added as new initialization option
    1112!
    1213! Former revisions:
     
    366367!
    367368!-- Initialize model variables
    368     IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
     369    IF ( TRIM( initializing_actions ) /= 'read_restart_data'  .AND.  &
     370         TRIM( initializing_actions ) /= 'read_data_for_recycling' )  THEN
    369371!
    370372!--    First model run of a possible job queue.
     
    907909       ENDIF
    908910
    909     ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data' ) &
     911    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.    &
     912             TRIM( initializing_actions ) == 'read_data_for_recycling' )  &
    910913    THEN
    911914!
     915!--    When reading data for initializing the recycling method, first read
     916!--    some of the global variables from restart file
     917       IF ( TRIM( initializing_actions ) == 'read_data_for_recycling' )  THEN
     918          WRITE (9,*) 'before read_parts_of_var_list'
     919          CALL local_flush( 9 )
     920          CALL read_parts_of_var_list
     921          WRITE (9,*) 'after read_parts_of_var_list'
     922          CALL local_flush( 9 )
     923          CALL close_file( 13 )
     924       ENDIF
     925
     926!
    912927!--    Read binary data from restart file
     928          WRITE (9,*) 'before read_3d_binary'
     929          CALL local_flush( 9 )
    913930       CALL read_3d_binary
     931          WRITE (9,*) 'after read_3d_binary'
     932          CALL local_flush( 9 )
    914933
    915934!
  • palm/trunk/SOURCE/local_stop.f90

    r110 r147  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Bugfix: a stop command was missing in some cases of the parallel branch
    77!
    88!
     
    3434    IF ( coupling_mode == 'uncoupled' )  THEN
    3535       CALL MPI_FINALIZE( ierr )
     36       STOP
    3637    ELSE
    3738
     
    5657             ENDIF
    5758             CALL MPI_FINALIZE( ierr )
     59             STOP
    5860
    5961          CASE ( 1 )
     
    6466             ENDIF
    6567             CALL MPI_FINALIZE( ierr )
     68             STOP
    6669
    6770          CASE ( 2 )
  • palm/trunk/SOURCE/modules.f90

    r146 r147  
    55! Actual revisions:
    66! -----------------
    7 ! +hor_index_bounds, hor_index_bounds_previous_run, numprocs_previous_run
     7! +hor_index_bounds, hor_index_bounds_previous_run, numprocs_previous_run,
     8! nx_on_file, ny_on_file
    89! -myid_char_14
    910!
     
    595596!------------------------------------------------------------------------------!
    596597
    597     INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxlu, nxr, nxra, nny, ny = 0, &
    598                 nya, nyn, nyna, nys, nysv, nnz, nz = 0, nza, nzb, nzb_diff,    &
    599                 nzt, nzta, nzt_diff
     598    INTEGER ::  ngp_sums, nnx, nx = 0, nxa, nxl, nxlu, nxr, nxra, nx_on_file, &
     599                nny, ny = 0, nya, nyn, nyna, nys, nysv, ny_on_file, nnz,       &
     600                nz = 0, nza, nzb, nzb_diff, nzt, nzta, nzt_diff
    600601
    601602    INTEGER, DIMENSION(:), ALLOCATABLE ::                                      &
  • palm/trunk/SOURCE/parin.f90

    r146 r147  
    231231          CALL local_stop
    232232       ENDIF
    233 
     233!
     234!--    ATTENTION: in case of changes to the following statement please also
     235!--    check the allocate statement in routine read_var_list
    234236       ALLOCATE( lad(0:nz+1),pt_init(0:nz+1), q_init(0:nz+1), sa_init(0:nz+1), &
    235237                 ug(0:nz+1), u_init(0:nz+1), v_init(0:nz+1), vg(0:nz+1),       &
  • palm/trunk/SOURCE/read_3d_binary.f90

    r146 r147  
    55! -----------------
    66! Files from which restart data are to be read are determined and subsequently
    7 ! opened,
     7! opened. The total domain on the restart file is allowed to be smaller than
     8! the current total domain. In this case it will be periodically mapped on the
     9! current domain (needed for recycling method).
    810! +call of user_read_restart_data, -dopr_time_count,
    911! hom_sum, volume_flow_area, volume_flow_initial moved to read_var_list,
     
    6264
    6365    INTEGER ::  files_to_be_opened, i, idum1, j, myid_on_file,                &
    64                 numprocs_on_file, nxlc, nxl_on_file, nxrc, nxr_on_file, nync, &
    65                 nyn_on_file, nysc, nys_on_file, nzb_on_file, nzt_on_file
    66 
    67     INTEGER, DIMENSION(:), ALLOCATABLE ::  file_list
     66                numprocs_on_file, nxlc, nxlf, nxlpr, nxl_on_file, nxrc, nxrf, &
     67                nxrpr, nxr_on_file, nync, nynf, nynpr, nyn_on_file, nysc,     &
     68                nysf, nyspr, nys_on_file, nzb_on_file, nzt_on_file, offset_x, &
     69                offset_y
     70
     71    INTEGER, DIMENSION(numprocs_previous_run*4) ::  file_list, nxlfa, nxrfa, &
     72                nynfa, nysfa, offset_xa, offset_ya
    6873
    6974    REAL, DIMENSION(:,:), ALLOCATABLE     ::  tmp_2d
     
    8085!-- of this PE
    8186    files_to_be_opened = 0
    82     ALLOCATE( file_list(numprocs_previous_run) )
    8387
    8488    DO  i = 1, numprocs_previous_run
    8589
     90       nxlpr = hor_index_bounds_previous_run(1,i-1)
     91       nxrpr = hor_index_bounds_previous_run(2,i-1)
     92       nyspr = hor_index_bounds_previous_run(3,i-1)
     93       nynpr = hor_index_bounds_previous_run(4,i-1)
     94
     95!
     96!--    Determine the offsets. They may be non-zero in case that the total domain
     97!--    on file is smaller than the current total domain.
     98       offset_x = ( nxl / ( nx_on_file + 1 ) ) * ( nx_on_file + 1 )
     99       offset_y = ( nys / ( ny_on_file + 1 ) ) * ( ny_on_file + 1 )
     100
    86101!
    87102!--    Only data which overlap with the current subdomain have to be read
    88        IF ( hor_index_bounds_previous_run(1,i-1) <= nxr  .AND.  &
    89             hor_index_bounds_previous_run(2,i-1) >= nxl  .AND.  &
    90             hor_index_bounds_previous_run(3,i-1) <= nyn  .AND.  &
    91             hor_index_bounds_previous_run(4,i-1) >= nys )  THEN
     103       IF ( nxlpr <= nxr-offset_x  .AND.  nxrpr >= nxl-offset_x  .AND.  &
     104            nyspr <= nyn-offset_y  .AND.  nynpr >= nys-offset_y )  THEN
    92105
    93106          files_to_be_opened = files_to_be_opened + 1
    94107          file_list(files_to_be_opened) = i-1
     108!
     109!--       Index bounds of overlapping data
     110          nxlfa(files_to_be_opened) = MAX( nxl-offset_x, nxlpr )
     111          nxrfa(files_to_be_opened) = MIN( nxr-offset_x, nxrpr )
     112          nysfa(files_to_be_opened) = MAX( nys-offset_y, nyspr )
     113          nynfa(files_to_be_opened) = MIN( nyn-offset_y, nynpr )
     114
     115          WRITE (9,*) '*** reading from file: ', i
     116          WRITE (9,*) '    index bounds on file:'
     117          WRITE (9,*) '       nxlpr=', nxlpr, ' nxrpr=', nxrpr
     118          WRITE (9,*) '       nyspr=', nyspr, ' nynpr=', nynpr
     119          WRITE (9,*) '    index bounds of current subdmain:'
     120          WRITE (9,*) '       nxl  =', nxl, ' nxr  =', nxr
     121          WRITE (9,*) '       nys  =', nys, ' nyn  =', nyn
     122          WRITE (9,*) '    offset used:'
     123          WRITE (9,*) '       offset_x=', offset_x, ' offset_y=', offset_y
     124          WRITE (9,*) '    bounds of overlapping data:'
     125          WRITE (9,*) '       nxlfa=', nxlfa(files_to_be_opened), ' nxrfa=', nxrfa(files_to_be_opened)
     126          WRITE (9,*) '       nysfa=', nysfa(files_to_be_opened), ' nynfa=', nynfa(files_to_be_opened)
     127          CALL local_flush( 9 )
     128          offset_xa(files_to_be_opened) = offset_x
     129          offset_ya(files_to_be_opened) = offset_y
    95130
    96131       ENDIF
    97132
     133!
     134!--    If the total domain on file is smaller than the current total domain,
     135!--    and if the current subdomain extends beyond the limits of the total
     136!--    domain of file, the respective file may be opened again (three times
     137!--    maximum) to read the still missing parts, which are then added
     138!--    "cyclically".
     139!--    Overlap along x:
     140       IF ( ( nxr - offset_x ) > nx_on_file )  THEN
     141
     142          offset_x = offset_x + ( nx_on_file + 1 )
     143
     144          IF ( nxlpr <= nxr-offset_x  .AND.  nxrpr >= nxl-offset_x  .AND.  &
     145               nyspr <= nyn-offset_y  .AND.  nynpr >= nys-offset_y )  THEN
     146
     147             files_to_be_opened = files_to_be_opened + 1
     148             file_list(files_to_be_opened) = i-1
     149!
     150!--          Index bounds of overlapping data
     151             nxlfa(files_to_be_opened) = MAX( nxl-offset_x, nxlpr )
     152             nxrfa(files_to_be_opened) = MIN( nxr-offset_x, nxrpr )
     153             nysfa(files_to_be_opened) = MAX( nys-offset_y, nyspr )
     154             nynfa(files_to_be_opened) = MIN( nyn-offset_y, nynpr )
     155
     156          WRITE (9,*) '*** reading from file: ', i
     157          WRITE (9,*) '    index bounds on file:'
     158          WRITE (9,*) '       nxlpr=', nxlpr, ' nxrpr=', nxrpr
     159          WRITE (9,*) '       nyspr=', nyspr, ' nynpr=', nynpr
     160          WRITE (9,*) '    index bounds of current subdmain:'
     161          WRITE (9,*) '       nxl  =', nxl, ' nxr  =', nxr
     162          WRITE (9,*) '       nys  =', nys, ' nyn  =', nyn
     163          WRITE (9,*) '    offset used:'
     164          WRITE (9,*) '       offset_x=', offset_x, ' offset_y=', offset_y
     165          WRITE (9,*) '    bounds of overlapping data:'
     166          WRITE (9,*) '       nxlfa=', nxlfa(files_to_be_opened), ' nxrfa=', nxrfa(files_to_be_opened)
     167          WRITE (9,*) '       nysfa=', nysfa(files_to_be_opened), ' nynfa=', nynfa(files_to_be_opened)
     168          CALL local_flush( 9 )
     169             offset_xa(files_to_be_opened) = offset_x
     170             offset_ya(files_to_be_opened) = offset_y
     171
     172          ENDIF
     173
     174          offset_x = offset_x - ( nx_on_file + 1 )
     175
     176       ENDIF
     177
     178
     179!
     180!--    Overlap along y:
     181       IF ( ( nyn - offset_y ) > ny_on_file )  THEN
     182
     183          offset_y = offset_y + ( ny_on_file + 1 )
     184
     185          IF ( nxlpr <= nxr-offset_x  .AND.  nxrpr >= nxl-offset_x  .AND.  &
     186               nyspr <= nyn-offset_y  .AND.  nynpr >= nys-offset_y )  THEN
     187
     188             files_to_be_opened = files_to_be_opened + 1
     189             file_list(files_to_be_opened) = i-1
     190!
     191!--          Index bounds of overlapping data
     192             nxlfa(files_to_be_opened) = MAX( nxl-offset_x, nxlpr )
     193             nxrfa(files_to_be_opened) = MIN( nxr-offset_x, nxrpr )
     194             nysfa(files_to_be_opened) = MAX( nys-offset_y, nyspr )
     195             nynfa(files_to_be_opened) = MIN( nyn-offset_y, nynpr )
     196
     197          WRITE (9,*) '*** reading from file: ', i
     198          WRITE (9,*) '    index bounds on file:'
     199          WRITE (9,*) '       nxlpr=', nxlpr, ' nxrpr=', nxrpr
     200          WRITE (9,*) '       nyspr=', nyspr, ' nynpr=', nynpr
     201          WRITE (9,*) '    index bounds of current subdmain:'
     202          WRITE (9,*) '       nxl  =', nxl, ' nxr  =', nxr
     203          WRITE (9,*) '       nys  =', nys, ' nyn  =', nyn
     204          WRITE (9,*) '    offset used:'
     205          WRITE (9,*) '       offset_x=', offset_x, ' offset_y=', offset_y
     206          WRITE (9,*) '    bounds of overlapping data:'
     207          WRITE (9,*) '       nxlfa=', nxlfa(files_to_be_opened), ' nxrfa=', nxrfa(files_to_be_opened)
     208          WRITE (9,*) '       nysfa=', nysfa(files_to_be_opened), ' nynfa=', nynfa(files_to_be_opened)
     209          CALL local_flush( 9 )
     210             offset_xa(files_to_be_opened) = offset_x
     211             offset_ya(files_to_be_opened) = offset_y
     212
     213          ENDIF
     214
     215          offset_y = offset_y - ( ny_on_file + 1 )
     216
     217       ENDIF
     218
     219!--    Overlap along x and y:
     220       IF ( ( nxr - offset_x ) > nx_on_file  .AND.  &
     221            ( nyn - offset_y ) > ny_on_file )  THEN
     222
     223          offset_x = offset_x + ( nx_on_file + 1 )
     224          offset_y = offset_y + ( ny_on_file + 1 )
     225
     226          IF ( nxlpr <= nxr-offset_x  .AND.  nxrpr >= nxl-offset_x  .AND.  &
     227               nyspr <= nyn-offset_y  .AND.  nynpr >= nys-offset_y )  THEN
     228
     229             files_to_be_opened = files_to_be_opened + 1
     230             file_list(files_to_be_opened) = i-1
     231!
     232!--          Index bounds of overlapping data
     233             nxlfa(files_to_be_opened) = MAX( nxl-offset_x, nxlpr )
     234             nxrfa(files_to_be_opened) = MIN( nxr-offset_x, nxrpr )
     235             nysfa(files_to_be_opened) = MAX( nys-offset_y, nyspr )
     236             nynfa(files_to_be_opened) = MIN( nyn-offset_y, nynpr )
     237
     238          WRITE (9,*) '*** reading from file: ', i
     239          WRITE (9,*) '    index bounds on file:'
     240          WRITE (9,*) '       nxlpr=', nxlpr, ' nxrpr=', nxrpr
     241          WRITE (9,*) '       nyspr=', nyspr, ' nynpr=', nynpr
     242          WRITE (9,*) '    index bounds of current subdmain:'
     243          WRITE (9,*) '       nxl  =', nxl, ' nxr  =', nxr
     244          WRITE (9,*) '       nys  =', nys, ' nyn  =', nyn
     245          WRITE (9,*) '    offset used:'
     246          WRITE (9,*) '       offset_x=', offset_x, ' offset_y=', offset_y
     247          WRITE (9,*) '    bounds of overlapping data:'
     248          WRITE (9,*) '       nxlfa=', nxlfa(files_to_be_opened), ' nxrfa=', nxrfa(files_to_be_opened)
     249          WRITE (9,*) '       nysfa=', nysfa(files_to_be_opened), ' nynfa=', nynfa(files_to_be_opened)
     250          CALL local_flush( 9 )
     251             offset_xa(files_to_be_opened) = offset_x
     252             offset_ya(files_to_be_opened) = offset_y
     253
     254          ENDIF
     255
     256          offset_x = offset_x - ( nx_on_file + 1 )
     257          offset_y = offset_y - ( ny_on_file + 1 )
     258
     259       ENDIF
     260
    98261    ENDDO
    99262
     263!
     264!-- Save the id-string of the current process, since myid_char may now be used
     265!-- to open files created by PEs with other id.
    100266    myid_char_save = myid_char
    101267
     268!
     269!-- Test output (remove later)
    102270    DO i = 1, numprocs_previous_run
    103271       WRITE (9,*) 'i=',i-1, ' ibs= ',hor_index_bounds_previous_run(1:4,i-1)
     
    128296!--    first.
    129297       CALL check_open( 13 )
     298       WRITE (9,*) 'before skipping'
     299       CALL local_flush( 9 )
    130300       IF ( j == 0 )  CALL skip_var_list
     301       WRITE (9,*) 'skipping done'
     302       CALL local_flush( 9 )
    131303
    132304!
     
    228400
    229401!
    230 !--    Determine the index range of those gridpoints to be copied from
    231 !--    the subdomains on the restart files to the current subdomain
    232        nxlc = MAX( nxl, nxl_on_file )
    233        nxrc = MIN( nxr, nxr_on_file )
    234        nysc = MAX( nys, nys_on_file )
    235        nync = MIN( nyn, nyn_on_file )
     402!--    Get the index range of the subdomain on file which overlap with the
     403!--    current subdomain
     404       nxlf = nxlfa(i)
     405       nxlc = nxlfa(i) + offset_xa(i)
     406       nxrf = nxrfa(i)
     407       nxrc = nxrfa(i) + offset_xa(i)
     408       nysf = nysfa(i)
     409       nysc = nysfa(i) + offset_ya(i)
     410       nynf = nynfa(i)
     411       nync = nynfa(i) + offset_ya(i)
    236412
    237413!
     
    244420       DO  WHILE ( TRIM( field_chr ) /= '*** end ***' )
    245421
     422          WRITE (9,*) 'var = ', field_chr
     423          CALL local_flush( 9 )
    246424          SELECT CASE ( TRIM( field_chr ) )
    247425
     
    249427                READ ( 13 )  tmp_3d
    250428                e(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    251                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     429                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    252430
    253431             CASE ( 'e_av' )
     
    257435                READ ( 13 )  tmp_3d
    258436                e_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    259                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     437                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    260438
    261439             CASE ( 'e_m' )
    262440                READ ( 13 )  tmp_3d
    263441                e_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    264                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     442                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    265443
    266444             CASE ( 'iran' ) ! matching random numbers is still unresolved issue
     
    270448                READ ( 13 )  tmp_3d
    271449                kh(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    272                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     450                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    273451
    274452             CASE ( 'kh_m' )
    275453                READ ( 13 )  tmp_3d
    276454                kh_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    277                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     455                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    278456
    279457             CASE ( 'km' )
    280458                READ ( 13 )  tmp_3d
    281459                km(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    282                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     460                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    283461
    284462             CASE ( 'km_m' )
    285463                READ ( 13 )  tmp_3d
    286464                km_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    287                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     465                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    288466
    289467             CASE ( 'lwp_av' )
     
    293471                READ ( 13 )  tmp_2d
    294472                lwp_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    295                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     473                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    296474
    297475             CASE ( 'p' )
    298476                READ ( 13 )  tmp_3d
    299477                p(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    300                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     478                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    301479
    302480             CASE ( 'p_av' )
     
    306484                READ ( 13 )  tmp_3d
    307485                p_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    308                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     486                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    309487
    310488             CASE ( 'pc_av' )
     
    314492                READ ( 13 )  tmp_3d
    315493                pc_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    316                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     494                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    317495
    318496             CASE ( 'pr_av' )
     
    322500                READ ( 13 )  tmp_3d
    323501                pr_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    324                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     502                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    325503
    326504             CASE ( 'precipitation_amount' )
    327505                READ ( 13 )  tmp_2d
    328506                precipitation_amount(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    329                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     507                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    330508
    331509             CASE ( 'precipitation_rate_a' )
     
    335513                READ ( 13 )  tmp_2d
    336514                precipitation_rate_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    337                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     515                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    338516
    339517             CASE ( 'pt' )
    340518                READ ( 13 )  tmp_3d
    341519                pt(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    342                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     520                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    343521
    344522             CASE ( 'pt_av' )
     
    348526                READ ( 13 )  tmp_3d
    349527                pt_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    350                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     528                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    351529
    352530             CASE ( 'pt_m' )
    353531                READ ( 13 )  tmp_3d
    354532                pt_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    355                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     533                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    356534
    357535             CASE ( 'q' )
    358536                READ ( 13 )  tmp_3d
    359537                q(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    360                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     538                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    361539
    362540             CASE ( 'q_av' )
     
    366544                READ ( 13 )  tmp_3d
    367545                q_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    368                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     546                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    369547
    370548             CASE ( 'q_m' )
    371549                READ ( 13 )  tmp_3d
    372550                q_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    373                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     551                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    374552
    375553             CASE ( 'ql' )
    376554                READ ( 13 )  tmp_3d
    377555                ql(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    378                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     556                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    379557
    380558             CASE ( 'ql_av' )
     
    384562                READ ( 13 )  tmp_3d
    385563                ql_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    386                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     564                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    387565
    388566             CASE ( 'ql_c_av' )
     
    392570                READ ( 13 )  tmp_3d
    393571                ql_c_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    394                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     572                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    395573
    396574             CASE ( 'ql_v_av' )
     
    400578                READ ( 13 )  tmp_3d
    401579                ql_v_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    402                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     580                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    403581
    404582             CASE ( 'ql_vp_av' )
     
    408586                READ ( 13 )  tmp_3d
    409587                ql_vp_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    410                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     588                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    411589
    412590             CASE ( 'qs' )
    413591                READ ( 13 )  tmp_2d
    414592                qs(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    415                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     593                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    416594
    417595             CASE ( 'qsws' )
    418596                READ ( 13 )  tmp_2d
    419597                qsws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    420                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     598                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    421599
    422600             CASE ( 'qsws_m' )
    423601                READ ( 13 )  tmp_2d
    424602                qsws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    425                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     603                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    426604
    427605             CASE ( 'qswst' )
    428606                READ ( 13 )  tmp_2d
    429607                qswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    430                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     608                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    431609
    432610             CASE ( 'qswst_m' )
    433611                READ ( 13 )  tmp_2d
    434612                qswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    435                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     613                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    436614
    437615             CASE ( 'qv_av' )
     
    441619                READ ( 13 )  tmp_3d
    442620                qv_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    443                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     621                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    444622
    445623             CASE ( 'random_iv' )  ! still unresolved issue
     
    453631                READ ( 13 )  tmp_3d
    454632                rho_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    455                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     633                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    456634
    457635             CASE ( 'rif' )
    458636                READ ( 13 )  tmp_2d
    459637                rif(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    460                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     638                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    461639
    462640             CASE ( 'rif_m' )
    463641                READ ( 13 )  tmp_2d
    464642                rif_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    465                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     643                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    466644
    467645             CASE ( 'rif_wall' )
     
    470648                READ ( 13 )  tmp_4d
    471649                rif_wall(:,nysc-1:nync+1,nxlc-1:nxrc+1,:) = &
    472                                          tmp_4d(:,nysc-1:nync+1,nxlc-1:nxrc+1,:)
     650                                         tmp_4d(:,nysf-1:nynf+1,nxlf-1:nxrf+1,:)
    473651                DEALLOCATE( tmp_4d )
    474652
     
    479657                READ ( 13 )  tmp_3d
    480658                s_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    481                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     659                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    482660
    483661             CASE ( 'sa' )
    484662                READ ( 13 )  tmp_3d
    485663                sa(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    486                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     664                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    487665
    488666             CASE ( 'sa_av' )
     
    492670                READ ( 13 )  tmp_3d
    493671                sa_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    494                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     672                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    495673
    496674             CASE ( 'saswsb' )
    497675                READ ( 13 )  tmp_2d
    498676                saswsb(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    499                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     677                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    500678
    501679             CASE ( 'saswst' )
    502680                READ ( 13 )  tmp_2d
    503681                saswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    504                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     682                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    505683
    506684             CASE ( 'shf' )
    507685                READ ( 13 )  tmp_2d
    508686                shf(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    509                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     687                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    510688
    511689             CASE ( 'shf_m' )
    512690                READ ( 13 )  tmp_2d
    513691                shf_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    514                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     692                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    515693
    516694             CASE ( 'spectrum_x' )
     
    523701                READ ( 13 )  tmp_2d
    524702                ts(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    525                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     703                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    526704
    527705             CASE ( 'ts_av' )
     
    531709                READ ( 13 )  tmp_2d
    532710                ts_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    533                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     711                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    534712
    535713             CASE ( 'tswst' )
    536714                READ ( 13 )  tmp_2d
    537715                tswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    538                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     716                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    539717
    540718             CASE ( 'tswst_m' )
    541719                READ ( 13 )  tmp_2d
    542720                tswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    543                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     721                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    544722
    545723             CASE ( 'u' )
    546724                READ ( 13 )  tmp_3d
    547725                u(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    548                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     726                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    549727
    550728             CASE ( 'u_av' )
     
    554732                READ ( 13 )  tmp_3d
    555733                u_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    556                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     734                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    557735
    558736             CASE ( 'u_m' )
    559737                READ ( 13 )  tmp_3d
    560738                u_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    561                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     739                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    562740
    563741             CASE ( 'u_m_l' )
     
    565743                READ ( 13 )  tmp_3dw
    566744                IF ( outflow_l )  THEN
    567                    u_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysc-1:nync+1,:)
     745                   u_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
    568746                ENDIF
    569747                DEALLOCATE( tmp_3dw )
     
    574752                READ ( 13 )  tmp_3dw
    575753                IF ( outflow_n )  THEN
    576                    u_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlc-1:nxrc+1)
     754                   u_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
    577755                ENDIF
    578756                DEALLOCATE( tmp_3dw )
     
    583761                READ ( 13 )  tmp_3dw
    584762                IF ( outflow_r )  THEN
    585                    u_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysc-1:nync+1,:)
     763                   u_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
    586764                ENDIF
    587765                DEALLOCATE( tmp_3dw )
     
    592770                READ ( 13 )  tmp_3dw
    593771                IF ( outflow_s )  THEN
    594                    u_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlc-1:nxrc+1)
     772                   u_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
    595773                ENDIF
    596774                DEALLOCATE( tmp_3dw )
     
    599777                READ ( 13 )  tmp_2d
    600778                us(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    601                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     779                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    602780
    603781             CASE ( 'usws' )
    604782                READ ( 13 )  tmp_2d
    605783                usws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    606                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     784                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    607785
    608786             CASE ( 'uswst' )
    609787                READ ( 13 )  tmp_2d
    610788                uswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    611                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     789                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    612790
    613791             CASE ( 'usws_m' )
    614792                READ ( 13 )  tmp_2d
    615793                usws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    616                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     794                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    617795
    618796             CASE ( 'uswst_m' )
    619797                READ ( 13 )  tmp_2d
    620798                uswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    621                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     799                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    622800
    623801             CASE ( 'us_av' )
     
    627805                READ ( 13 )  tmp_2d
    628806                us_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    629                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     807                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    630808
    631809             CASE ( 'v' )
    632810                READ ( 13 )  tmp_3d
    633811                v(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    634                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     812                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    635813
    636814             CASE ( 'v_av' )
     
    640818                READ ( 13 )  tmp_3d
    641819                v_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    642                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     820                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    643821
    644822             CASE ( 'v_m' )
    645823                READ ( 13 )  tmp_3d
    646824                v_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    647                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     825                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    648826
    649827             CASE ( 'v_m_l' )
     
    651829                READ ( 13 )  tmp_3dw
    652830                IF ( outflow_l )  THEN
    653                    v_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysc-1:nync+1,:)
     831                   v_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
    654832                ENDIF
    655833                DEALLOCATE( tmp_3dw )
     
    660838                READ ( 13 )  tmp_3dw
    661839                IF ( outflow_n )  THEN
    662                    v_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlc-1:nxrc+1)
     840                   v_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
    663841                ENDIF
    664842                DEALLOCATE( tmp_3dw )
     
    669847                READ ( 13 )  tmp_3dw
    670848                IF ( outflow_r )  THEN
    671                    v_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysc-1:nync+1,:)
     849                   v_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
    672850                ENDIF
    673851                DEALLOCATE( tmp_3dw )
     
    678856                READ ( 13 )  tmp_3dw
    679857                IF ( outflow_s )  THEN
    680                    v_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlc-1:nxrc+1)
     858                   v_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
    681859                ENDIF
    682860                DEALLOCATE( tmp_3dw )
     
    685863                READ ( 13 )  tmp_3d
    686864                vpt(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    687                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     865                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    688866
    689867             CASE ( 'vpt_av' )
     
    693871                READ ( 13 )  tmp_3d
    694872                vpt_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    695                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     873                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    696874
    697875             CASE ( 'vpt_m' )
    698876                READ ( 13 )  tmp_3d
    699877                vpt_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    700                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     878                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    701879
    702880             CASE ( 'vsws' )
    703881                READ ( 13 )  tmp_2d
    704882                vsws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    705                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     883                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    706884
    707885             CASE ( 'vswst' )
    708886                READ ( 13 )  tmp_2d
    709887                vswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    710                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     888                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    711889
    712890             CASE ( 'vsws_m' )
    713891                READ ( 13 )  tmp_2d
    714892                vsws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    715                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     893                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    716894
    717895             CASE ( 'vswst_m' )
    718896                READ ( 13 )  tmp_2d
    719897                vswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    720                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     898                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    721899
    722900             CASE ( 'w' )
    723901                READ ( 13 )  tmp_3d
    724902                w(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    725                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     903                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    726904
    727905             CASE ( 'w_av' )
     
    731909                READ ( 13 )  tmp_3d
    732910                w_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    733                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     911                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    734912
    735913             CASE ( 'w_m' )
    736914                READ ( 13 )  tmp_3d
    737915                w_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
    738                                           tmp_3d(:,nysc-1:nync+1,nxlc-1:nxrc+1)
     916                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    739917
    740918             CASE ( 'w_m_l' )
     
    742920                READ ( 13 )  tmp_3dw
    743921                IF ( outflow_l )  THEN
    744                    w_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysc-1:nync+1,:)
     922                   w_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
    745923                ENDIF
    746924                DEALLOCATE( tmp_3dw )
     
    751929                READ ( 13 )  tmp_3dw
    752930                IF ( outflow_n )  THEN
    753                    w_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlc-1:nxrc+1)
     931                   w_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
    754932                ENDIF
    755933                DEALLOCATE( tmp_3dw )
     
    760938                READ ( 13 )  tmp_3dw
    761939                IF ( outflow_r )  THEN
    762                    w_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysc-1:nync+1,:)
     940                   w_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
    763941                ENDIF
    764942                DEALLOCATE( tmp_3dw )
     
    769947                READ ( 13 )  tmp_3dw
    770948                IF ( outflow_s )  THEN
    771                    w_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlc-1:nxrc+1)
     949                   w_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
    772950                ENDIF
    773951                DEALLOCATE( tmp_3dw )
     
    776954                READ ( 13 )  tmp_2d
    777955                z0(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    778                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     956                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    779957
    780958             CASE ( 'z0_av' )
     
    784962                READ ( 13 )  tmp_2d
    785963                z0_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
    786                                           tmp_2d(nysc-1:nync+1,nxlc-1:nxrc+1)
     964                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
    787965
    788966             CASE DEFAULT
     
    801979!
    802980!--    Read user-defined restart data
    803        CALL user_read_restart_data
     981       CALL user_read_restart_data( nxlc, nxlf, nxl_on_file, nxrc, nxrf, &
     982                                    nxr_on_file, nync, nynf, nyn_on_file, &
     983                                    nysc, nysf, nys_on_file, tmp_2d, tmp_3d )
    804984
    805985!
  • palm/trunk/SOURCE/read_var_list.f90

    r146 r147  
    88! hom_sum, volume_flow_area, volume_flow_initial moved from
    99! read_3d_binary to here,
    10 ! routine skip_var_list added at the end
     10! routines read_parts_of_var_list and skip_var_list added at the end
    1111!
    1212! Former revisions:
     
    148148    READ ( 13 )  statistic_regions
    149149    IF ( .NOT. ALLOCATED( ug ) )  THEN
    150        ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1), v_init(0:nz+1), &
    151                  pt_init(0:nz+1), q_init(0:nz+1), sa_init(0:nz+1),       &
     150       ALLOCATE( lad(0:nz+1), ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1),    &
     151                 v_init(0:nz+1), pt_init(0:nz+1), q_init(0:nz+1),        &
     152                 sa_init(0:nz+1),                                        &
    152153                 hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions),  &
    153154                 hom_sum(0:nz+1,pr_palm+max_pr_user,0:statistic_regions) )
     
    314315          CASE ( 'nx' )
    315316             READ ( 13 )  nx
     317             nx_on_file = nx
    316318          CASE ( 'ny' )
    317319             READ ( 13 )  ny
     320             ny_on_file = ny
    318321          CASE ( 'ocean' )
    319322             READ ( 13 )  ocean
     
    542545
    543546
     547 SUBROUTINE read_parts_of_var_list
     548
     549!------------------------------------------------------------------------------!
     550! Description:
     551! ------------
     552! Skipping the global control variables from restart-file (binary format)
     553! except some informations needed when reading restart data from a previous
     554! run which used a smaller total domain.
     555!------------------------------------------------------------------------------!
     556
     557    USE control_parameters
     558    USE indices
     559    USE pegrid
     560    USE statistics
     561
     562    IMPLICIT NONE
     563
     564    CHARACTER (LEN=10) ::  version_on_file
     565    CHARACTER (LEN=30) ::  variable_chr
     566
     567    INTEGER ::  idum, max_pr_user_on_file, nz_on_file, &
     568                statistic_regions_on_file
     569
     570    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  hom_on_file
     571
     572
     573    CALL check_open( 13 )
     574
     575    WRITE (9,*) 'rpovl: after check open 13'
     576    CALL local_flush( 9 )
     577    READ ( 13 )  version_on_file
     578
     579!
     580!-- Read number of PEs and horizontal index bounds of all PEs used in previous
     581!-- run
     582    READ ( 13 )  variable_chr
     583    IF ( TRIM( variable_chr ) /= 'numprocs' )  THEN
     584       PRINT*, '+++ read_parts_of_var_list: numprocs not found in data from ', &
     585                    'prior run on PE ', myid
     586       CALL local_stop
     587    ENDIF
     588    READ ( 13 )  numprocs_previous_run
     589
     590    IF ( .NOT. ALLOCATED( hor_index_bounds_previous_run ) )  THEN
     591       ALLOCATE( hor_index_bounds_previous_run(4,0:numprocs_previous_run-1) )
     592    ENDIF
     593
     594    READ ( 13 )  variable_chr
     595    IF ( TRIM( variable_chr ) /= 'hor_index_bounds' )  THEN
     596       PRINT*, '+++ read_parts_of_var_list: hor_index_bounds not found in da', &
     597                    'ta from prior run on PE ', myid
     598       CALL local_stop
     599    ENDIF
     600    READ ( 13 )  hor_index_bounds_previous_run
     601
     602!
     603!-- Read vertical number of gridpoints and number of different areas used
     604!-- for computing statistics. Allocate arrays depending on these values,
     605!-- which are needed for the following read instructions.
     606    READ ( 13 )  variable_chr
     607    IF ( TRIM( variable_chr ) /= 'nz' )  THEN
     608       PRINT*, '+++ read_parts_of_var_list: nz not found in restart data file'
     609       CALL local_stop
     610    ENDIF
     611    READ ( 13 )  nz_on_file
     612    IF ( nz_on_file /= nz )  THEN
     613       IF ( myid == 0 )  THEN
     614          PRINT*, '+++ read_parts_of_var_list: mismatch concerning number of', &
     615                       ' gridpoints along z'
     616          PRINT*, '                   nz on file    = "', nz_on_file, '"'
     617          PRINT*, '                   nz from run   = "', nz, '"'
     618       ENDIF
     619       CALL local_stop
     620    ENDIF
     621
     622    READ ( 13 )  variable_chr
     623    IF ( TRIM( variable_chr ) /= 'max_pr_user' )  THEN
     624       PRINT*, '+++ read_parts_of_var_list: max_pr_user not found in restart', &
     625                    ' data file'
     626       CALL local_stop
     627    ENDIF
     628    READ ( 13 )  max_pr_user_on_file
     629    IF ( max_pr_user_on_file > max_pr_user )  THEN
     630       IF ( myid == 0 )  THEN
     631          PRINT*, '+++ read_parts_of_var_list: too many user profiles on res', &
     632                       'tart data file'
     633          PRINT*, '                   max_pr_user on file    = "', &
     634                  max_pr_user_on_file, '"'
     635          PRINT*, '                   max_pr_user from run   = "', &
     636                  max_pr_user, '"'
     637       ENDIF
     638       CALL local_stop
     639    ENDIF
     640
     641    READ ( 13 )  variable_chr
     642    IF ( TRIM( variable_chr ) /= 'statistic_regions' )  THEN
     643       PRINT*, '+++ read_var_list: statistic_regions not found in restart da', &
     644                    'ta file'
     645       CALL local_stop
     646    ENDIF
     647    READ ( 13 )  statistic_regions_on_file
     648    IF ( statistic_regions_on_file > statistic_regions )  THEN
     649       IF ( myid == 0 )  THEN
     650          PRINT*, '+++ read_parts_of_var_list: too many statistic regions on', &
     651                       ' restart data file'
     652          PRINT*, '                   statistic regions on file    = "', &
     653                  max_pr_user_on_file, '"'
     654          PRINT*, '                   statistic regions from run   = "', &
     655                  max_pr_user, '"'
     656       ENDIF
     657       CALL local_stop
     658    ENDIF
     659
     660
     661!
     662!-- Now read and check some control parameters and skip the rest
     663!-- The total domain of the pre-run must not be smaller than the subdomain
     664!-- of the current run, because the mapping of data from the pre-run does
     665!-- not work for this case.
     666    WRITE (9,*) 'wpovl: begin reading variables'
     667    CALL local_flush( 9 )
     668    READ ( 13 )  variable_chr
     669
     670    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
     671
     672       SELECT CASE ( TRIM( variable_chr ) )
     673
     674          CASE ( 'hom' )
     675             ALLOCATE( hom_on_file(0:nz+1,2,pr_palm+max_pr_user_on_file, &
     676                       0:statistic_regions_on_file) )
     677             READ ( 13 )  hom_on_file
     678             hom = hom_on_file(:,:,1:pr_palm+max_pr_user,0:statistic_regions)
     679             DEALLOCATE( hom_on_file )
     680
     681          CASE ( 'nx' )
     682             READ ( 13 )  nx_on_file
     683             IF ( nx_on_file < ( nxr - nxl ) )  THEN
     684                PRINT*, '+++ read_parts_of_var_list: total domain along x on', &
     685                             ' restart file is smaller than current subdomain'
     686                PRINT*, '                            nx on file = ', nx_on_file
     687                PRINT*, '                            nxr - nxl  = ', nxr - nxl
     688                CALL local_stop
     689             ENDIF
     690
     691          CASE ( 'ny' )
     692             READ ( 13 )  ny_on_file
     693             IF ( ny_on_file < ( nyn - nys ) )  THEN
     694                PRINT*, '+++ read_parts_of_var_list: total domain along y on', &
     695                             ' restart file is smaller than current subdomain'
     696                PRINT*, '                            ny on file = ', ny_on_file
     697                PRINT*, '                            nyn - nys  = ', nyn - nys
     698                CALL local_stop
     699             ENDIF
     700
     701
     702          CASE DEFAULT
     703
     704             READ ( 13 )  idum
     705
     706       END SELECT
     707
     708       READ ( 13 )  variable_chr
     709
     710    ENDDO
     711
     712
     713 END SUBROUTINE read_parts_of_var_list
     714
     715
     716
    544717 SUBROUTINE skip_var_list
    545718
     
    550723!------------------------------------------------------------------------------!
    551724
     725    IMPLICIT NONE
     726
    552727    CHARACTER (LEN=10) ::  version_on_file
    553728    CHARACTER (LEN=30) ::  variable_chr
     
    556731
    557732
     733    WRITE (9,*) 'skipvl #1'
     734    CALL local_flush( 9 )
    558735    READ ( 13 )  version_on_file
    559736
    560     READ ( 13 )  variable_chr
     737    WRITE (9,*) 'skipvl before variable_chr'
     738    CALL local_flush( 9 )
     739    READ ( 13 )  variable_chr
     740    WRITE (9,*) 'skipvl after variable_chr'
     741    CALL local_flush( 9 )
    561742
    562743    DO  WHILE ( TRIM( variable_chr ) /= '*** end ***' )
    563744
     745    WRITE (9,*) 'skipvl chr = ', variable_chr
     746    CALL local_flush( 9 )
    564747       READ ( 13 )  idum
    565748       READ ( 13 )  variable_chr
    566749
    567750    ENDDO
     751    WRITE (9,*) 'skipvl last'
     752    CALL local_flush( 9 )
    568753
    569754
  • palm/trunk/SOURCE/user_interface.f90

    r145 r147  
    177177
    178178
    179  SUBROUTINE user_read_restart_data
     179 SUBROUTINE user_read_restart_data( nxlc, nxlf, nxl_on_file, nxrc, nxrf,  &
     180                                    nxr_on_file, nync, nynf, nyn_on_file, &
     181                                    nysc, nysf, nys_on_file, tmp_2d, tmp_3d )
    180182
    181183!------------------------------------------------------------------------------!
     
    184186! ------------
    185187! Reading restart data from file(s)
     188! Subdomain index limits on file are given by nxl_on_file, etc.
     189! Indices nxlc, etc. indicate the range of gridpoints to be mapped from the
     190! subdomain on file (f) to the subdomain of the current PE (c). They have been
     191! calculated in routine read_3d_binary.
    186192!------------------------------------------------------------------------------!
    187193
     
    194200
    195201    CHARACTER (LEN=20) :: field_char
     202
     203    INTEGER ::  nxlc, nxlf, nxl_on_file, nxrc, nxrf, nxr_on_file, nync, nynf, &
     204                nyn_on_file, nysc, nysf, nys_on_file
     205
     206    REAL, DIMENSION(nys_on_file-1:nyn_on_file+1,nxl_on_file-1:nxr_on_file+1) ::&
     207          tmp_2d
     208
     209    REAL, DIMENSION(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
     210                    nxl_on_file-1:nxr_on_file+1) ::        &
     211          tmp_3d
     212
    196213!
    197214!-- Here the reading of user-defined restart data follows:
     
    207224!
    208225!             CASE ( 'u2_av' )
    209 !                ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     226!                IF ( .NOT. ALLOCATED( u2_av )  THEN
     227!                   ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
     228!                ENDIF
     229!                READ ( 13 )  tmp_3d
    210230!                READ ( 13 )  u2_av
     231!                u2_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
     232!                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
    211233!
    212234!             CASE DEFAULT
Note: See TracChangeset for help on using the changeset viewer.