source: palm/trunk/SOURCE/read_3d_binary.f90 @ 150

Last change on this file since 150 was 150, checked in by raasch, 16 years ago

particle advection allowed for ocean runs

  • Property svn:keywords set to Id
File size: 39.2 KB
RevLine 
[1]1 SUBROUTINE read_3d_binary
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
[146]6! Files from which restart data are to be read are determined and subsequently
[147]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).
[146]10! +call of user_read_restart_data, -dopr_time_count,
[145]11! hom_sum, volume_flow_area, volume_flow_initial moved to read_var_list,
[143]12! reading of old profil parameters (cross_..., dopr_crossindex, profile_***)
[146]13! removed, initialization of spectrum_x|y removed
[1]14!
15! Former revisions:
16! -----------------
[3]17! $Id: read_3d_binary.f90 150 2008-02-29 08:19:58Z raasch $
[39]18!
[110]19! 102 2007-07-27 09:09:17Z raasch
20! +uswst, uswst_m, vswst, vswst_m
21!
[98]22! 96 2007-06-04 08:07:41Z raasch
23! +rho_av, sa, sa_av, saswsb, saswst
24!
[77]25! 73 2007-03-20 08:33:14Z raasch
26! +precipitation_amount, precipitation_rate_av, rif_wall, u_m_l, u_m_r, etc.,
27! z0_av
28!
[39]29! 19 2007-02-23 04:53:48Z raasch
[77]30! +qswst, qswst_m, tswst, tswst_m
[39]31!
[3]32! RCS Log replace by Id keyword, revision history cleaned up
33!
[1]34! Revision 1.4  2006/08/04 15:02:32  raasch
35! +iran, iran_part
36!
37! Revision 1.1  2004/04/30 12:47:27  raasch
38! Initial revision
39!
40!
41! Description:
42! ------------
43! Binary input of variables and arrays from restart file
44!------------------------------------------------------------------------------!
45
46    USE arrays_3d
47    USE averaging
[72]48    USE cloud_parameters
[1]49    USE control_parameters
50    USE cpulog
51    USE indices
52    USE interfaces
53    USE particle_attributes
54    USE pegrid
55    USE profil_parameter
56    USE random_function_mod
57    USE statistics
58
59    IMPLICIT NONE
60
[146]61    CHARACTER (LEN=5)  ::  myid_char_save
[1]62    CHARACTER (LEN=10) ::  binary_version, version_on_file
63    CHARACTER (LEN=20) ::  field_chr
64
[150]65    INTEGER ::  files_to_be_opened, i, j, myid_on_file,                       &
[147]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
[1]70
[147]71    INTEGER, DIMENSION(numprocs_previous_run*4) ::  file_list, nxlfa, nxrfa, &
72                nynfa, nysfa, offset_xa, offset_ya
[146]73
74    REAL, DIMENSION(:,:), ALLOCATABLE     ::  tmp_2d
75    REAL, DIMENSION(:,:,:), ALLOCATABLE   ::  tmp_3d, tmp_3dw
76    REAL, DIMENSION(:,:,:,:), ALLOCATABLE ::  tmp_4d
77
78
[1]79!
[146]80!-- Read data from previous model run.
[1]81    CALL cpu_log( log_point_s(14), 'read_3d_binary', 'start' )
82
83!
[146]84!-- Check which of the restart files contain data needed for the subdomain
85!-- of this PE
86    files_to_be_opened = 0
[143]87
[146]88    DO  i = 1, numprocs_previous_run
89
[147]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
[143]95!
[147]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
101!
[146]102!--    Only data which overlap with the current subdomain have to be read
[147]103       IF ( nxlpr <= nxr-offset_x  .AND.  nxrpr >= nxl-offset_x  .AND.  &
104            nyspr <= nyn-offset_y  .AND.  nynpr >= nys-offset_y )  THEN
[146]105
106          files_to_be_opened = files_to_be_opened + 1
107          file_list(files_to_be_opened) = i-1
[147]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 )
[146]114
[147]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
130
[1]131       ENDIF
[146]132
[147]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
[146]261    ENDDO
262
[147]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.
[146]266    myid_char_save = myid_char
267
[147]268!
269!-- Test output (remove later)
[146]270    DO i = 1, numprocs_previous_run
271       WRITE (9,*) 'i=',i-1, ' ibs= ',hor_index_bounds_previous_run(1:4,i-1)
272    ENDDO
273    CALL local_flush( 9 )
274
275    IF ( files_to_be_opened /= 1  .OR.  numprocs /= numprocs_previous_run ) &
276    THEN
277       PRINT*, '*** number of PEs or virtual PE-grid changed in restart run'
278       PRINT*, '    PE', myid, ' will read from files ', &
279               file_list(1:files_to_be_opened)
[1]280    ENDIF
281
282!
[146]283!-- Read data from all restart files determined above
284    DO  i = 1, files_to_be_opened
[1]285
[146]286       j = file_list(i)
287!
288!--    Set the filename (underscore followed by four digit processor id)
289       WRITE (myid_char,'(''_'',I4.4)')  j
290       WRITE (9,*) 'myid=',myid,' opening file "',myid_char,'"'
291       CALL local_flush( 9 )
[1]292
[146]293!
294!--    Open the restart file. If this file has been created by PE0 (_0000),
295!--    the global variables at the beginning of the file have to be skipped
296!--    first.
297       CALL check_open( 13 )
[147]298       WRITE (9,*) 'before skipping'
299       CALL local_flush( 9 )
[146]300       IF ( j == 0 )  CALL skip_var_list
[147]301       WRITE (9,*) 'skipping done'
302       CALL local_flush( 9 )
[1]303
[146]304!
305!--    First compare the version numbers
306       READ ( 13 )  version_on_file
307       binary_version = '3.1'
308       IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
309          IF ( myid == 0 )  THEN
310             PRINT*, '+++ init_3d_model: version mismatch concerning data ', &
311                     'from prior run'
312             PRINT*, '        version on file    = "', TRIM( version_on_file ),&
313                     '"'
314             PRINT*, '        version in program = "', TRIM( binary_version ), &
315                     '"'
316          ENDIF
317          CALL local_stop
318       ENDIF
319
320!
321!--    Read number of processors, processor-id, and array ranges.
322!--    Compare the array ranges with those stored in the index bound array.
323       READ ( 13 )  numprocs_on_file, myid_on_file, nxl_on_file, nxr_on_file, &
324                    nys_on_file, nyn_on_file, nzb_on_file, nzt_on_file
325
326       IF ( nxl_on_file /= hor_index_bounds_previous_run(1,j) )  THEN
327          PRINT*, '+++ read_3d_binary: problem with index bound nxl on ', &
328                       ' restart file "', myid_char, '"'
329          PRINT*, '                    nxl = ', nxl_on_file, ' but it should be'
330          PRINT*, '                    = ', hor_index_bounds_previous_run(1,j)
331          PRINT*, '                    from the index bound information array'
[1]332#if defined( __parallel )
[146]333          CALL MPI_ABORT( comm2d, 9999, ierr )
[1]334#else
[146]335          CALL local_stop
[1]336#endif
[146]337       ENDIF
[1]338
[146]339       IF ( nxr_on_file /= hor_index_bounds_previous_run(2,j) )  THEN
340          PRINT*, '+++ read_3d_binary: problem with index bound nxr on ', &
341                       ' restart file "', myid_char, '"'
342          PRINT*, '                    nxr = ', nxr_on_file, ' but it should be'
343          PRINT*, '                    = ', hor_index_bounds_previous_run(2,j)
344          PRINT*, '                    from the index bound information array'
[1]345#if defined( __parallel )
[146]346          CALL MPI_ABORT( comm2d, 9999, ierr )
[1]347#else
[146]348          CALL local_stop
[1]349#endif
[146]350       ENDIF
[1]351
[146]352       IF ( nys_on_file /= hor_index_bounds_previous_run(3,j) )  THEN
353          PRINT*, '+++ read_3d_binary: problem with index bound nys on ', &
354                       ' restart file "', myid_char, '"'
355          PRINT*, '                    nys = ', nys_on_file, ' but it should be'
356          PRINT*, '                    = ', hor_index_bounds_previous_run(3,j)
357          PRINT*, '                    from the index bound information array'
[1]358#if defined( __parallel )
[146]359          CALL MPI_ABORT( comm2d, 9999, ierr )
[1]360#else
[146]361          CALL local_stop
[1]362#endif
[146]363       ENDIF
[1]364
[146]365       IF ( nyn_on_file /= hor_index_bounds_previous_run(4,j) )  THEN
366          PRINT*, '+++ read_3d_binary: problem with index bound nyn on ', &
367                       ' restart file "', myid_char, '"'
368          PRINT*, '                    nyn = ', nyn_on_file, ' but it should be'
369          PRINT*, '                    = ', hor_index_bounds_previous_run(4,j)
370          PRINT*, '                    from the index bound information array'
[1]371#if defined( __parallel )
[146]372          CALL MPI_ABORT( comm2d, 9999, ierr )
[1]373#else
[146]374          CALL local_stop
[1]375#endif
[146]376       ENDIF
[1]377
[146]378       IF ( nzb_on_file /= nzb )  THEN
379          PRINT*, '+++ read_3d_binary: mismatch between actual data and data '
380          PRINT*, '                    from prior run on PE ', myid
381          PRINT*, '                    nzb on file = ', nzb_on_file
382          PRINT*, '                    nzb         = ', nzb
383          CALL local_stop
384       ENDIF
[1]385
[146]386       IF ( nzt_on_file /= nzt )  THEN
387          PRINT*, '+++ read_3d_binary: mismatch between actual data and data '
388          PRINT*, '                    from prior run on PE ', myid
389          PRINT*, '                    nzt on file = ', nzt_on_file
390          PRINT*, '                    nzt         = ', nzt
391          CALL local_stop
392       ENDIF
[1]393
394!
[146]395!--    Allocate temporary arrays sized as the arrays on the restart file
396       ALLOCATE( tmp_2d(nys_on_file-1:nyn_on_file+1,           &
397                        nxl_on_file-1:nxr_on_file+1),          &
398                 tmp_3d(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
399                        nxl_on_file-1:nxr_on_file+1) )
[1]400
401!
[147]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)
[1]412
[146]413!
414!--    Read arrays
415!--    ATTENTION: If the following read commands have been altered, the
416!--    ---------- version number of the variable binary_version must be altered,
417!--               too. Furthermore, the output list of arrays in write_3d_binary
418!--               must also be altered accordingly.
419       READ ( 13 )  field_chr
420       DO  WHILE ( TRIM( field_chr ) /= '*** end ***' )
[1]421
[147]422          WRITE (9,*) 'var = ', field_chr
423          CALL local_flush( 9 )
[146]424          SELECT CASE ( TRIM( field_chr ) )
[1]425
[146]426             CASE ( 'e' )
427                READ ( 13 )  tmp_3d
428                e(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]429                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[1]430
[146]431             CASE ( 'e_av' )
432                IF ( .NOT. ALLOCATED( e_av ) )  THEN
433                   ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
434                ENDIF
435                READ ( 13 )  tmp_3d
436                e_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]437                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]438
439             CASE ( 'e_m' )
440                READ ( 13 )  tmp_3d
441                e_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]442                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]443
444             CASE ( 'iran' ) ! matching random numbers is still unresolved issue
445                READ ( 13 )  iran, iran_part
446
447             CASE ( 'kh' )
448                READ ( 13 )  tmp_3d
449                kh(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]450                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]451
452             CASE ( 'kh_m' )
453                READ ( 13 )  tmp_3d
454                kh_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]455                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]456
457             CASE ( 'km' )
458                READ ( 13 )  tmp_3d
459                km(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]460                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]461
462             CASE ( 'km_m' )
463                READ ( 13 )  tmp_3d
464                km_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]465                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]466
467             CASE ( 'lwp_av' )
468                IF ( .NOT. ALLOCATED( lwp_av ) )  THEN
469                   ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
470                ENDIF
471                READ ( 13 )  tmp_2d
472                lwp_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]473                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]474
475             CASE ( 'p' )
476                READ ( 13 )  tmp_3d
477                p(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]478                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]479
480             CASE ( 'p_av' )
481                IF ( .NOT. ALLOCATED( p_av ) )  THEN
482                   ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
483                ENDIF
484                READ ( 13 )  tmp_3d
485                p_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]486                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]487
488             CASE ( 'pc_av' )
489                IF ( .NOT. ALLOCATED( pc_av ) )  THEN
490                   ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
491                ENDIF
492                READ ( 13 )  tmp_3d
493                pc_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]494                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]495
496             CASE ( 'pr_av' )
497                IF ( .NOT. ALLOCATED( pr_av ) )  THEN
498                   ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
499                ENDIF
500                READ ( 13 )  tmp_3d
501                pr_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]502                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]503
504             CASE ( 'precipitation_amount' )
505                READ ( 13 )  tmp_2d
506                precipitation_amount(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]507                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]508
509             CASE ( 'precipitation_rate_a' )
510                IF ( .NOT. ALLOCATED( precipitation_rate_av ) )  THEN
511                   ALLOCATE( precipitation_rate_av(nys-1:nyn+1,nxl-1:nxr+1) )
512                ENDIF
513                READ ( 13 )  tmp_2d
514                precipitation_rate_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]515                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]516
517             CASE ( 'pt' )
518                READ ( 13 )  tmp_3d
519                pt(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]520                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]521
522             CASE ( 'pt_av' )
523                IF ( .NOT. ALLOCATED( pt_av ) )  THEN
524                   ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
525                ENDIF
526                READ ( 13 )  tmp_3d
527                pt_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]528                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]529
530             CASE ( 'pt_m' )
531                READ ( 13 )  tmp_3d
532                pt_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]533                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]534
535             CASE ( 'q' )
536                READ ( 13 )  tmp_3d
537                q(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]538                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]539
540             CASE ( 'q_av' )
541                IF ( .NOT. ALLOCATED( q_av ) )  THEN
542                   ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
543                ENDIF
544                READ ( 13 )  tmp_3d
545                q_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]546                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]547
548             CASE ( 'q_m' )
549                READ ( 13 )  tmp_3d
550                q_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]551                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]552
553             CASE ( 'ql' )
554                READ ( 13 )  tmp_3d
555                ql(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]556                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]557
558             CASE ( 'ql_av' )
559                IF ( .NOT. ALLOCATED( ql_av ) )  THEN
560                   ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
561                ENDIF
562                READ ( 13 )  tmp_3d
563                ql_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]564                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]565
566             CASE ( 'ql_c_av' )
567                IF ( .NOT. ALLOCATED( ql_c_av ) )  THEN
568                   ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
569                ENDIF
570                READ ( 13 )  tmp_3d
571                ql_c_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]572                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]573
574             CASE ( 'ql_v_av' )
575                IF ( .NOT. ALLOCATED( ql_v_av ) )  THEN
576                   ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
577                ENDIF
578                READ ( 13 )  tmp_3d
579                ql_v_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]580                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]581
582             CASE ( 'ql_vp_av' )
583                IF ( .NOT. ALLOCATED( ql_vp_av ) )  THEN
584                   ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
585                ENDIF
586                READ ( 13 )  tmp_3d
587                ql_vp_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]588                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]589
590             CASE ( 'qs' )
591                READ ( 13 )  tmp_2d
592                qs(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]593                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]594
595             CASE ( 'qsws' )
596                READ ( 13 )  tmp_2d
597                qsws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]598                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]599
600             CASE ( 'qsws_m' )
601                READ ( 13 )  tmp_2d
602                qsws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]603                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]604
605             CASE ( 'qswst' )
606                READ ( 13 )  tmp_2d
607                qswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]608                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]609
610             CASE ( 'qswst_m' )
611                READ ( 13 )  tmp_2d
612                qswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]613                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]614
615             CASE ( 'qv_av' )
616                IF ( .NOT. ALLOCATED( qv_av ) )  THEN
617                   ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
618                ENDIF
619                READ ( 13 )  tmp_3d
620                qv_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]621                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]622
623             CASE ( 'random_iv' )  ! still unresolved issue
624                READ ( 13 )  random_iv
625                READ ( 13 )  random_iy
626
627             CASE ( 'rho_av' )
628                IF ( .NOT. ALLOCATED( rho_av ) )  THEN
629                   ALLOCATE( rho_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
630                ENDIF
631                READ ( 13 )  tmp_3d
632                rho_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]633                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]634
635             CASE ( 'rif' )
636                READ ( 13 )  tmp_2d
637                rif(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]638                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]639
640             CASE ( 'rif_m' )
641                READ ( 13 )  tmp_2d
642                rif_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]643                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]644
645             CASE ( 'rif_wall' )
646                ALLOCATE( tmp_4d(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
647                                 nxl_on_file-1:nxr_on_file+1,1:4) )
648                READ ( 13 )  tmp_4d
649                rif_wall(:,nysc-1:nync+1,nxlc-1:nxrc+1,:) = &
[147]650                                         tmp_4d(:,nysf-1:nynf+1,nxlf-1:nxrf+1,:)
[146]651                DEALLOCATE( tmp_4d )
652
653             CASE ( 's_av' )
654                IF ( .NOT. ALLOCATED( s_av ) )  THEN
655                   ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
656                ENDIF
657                READ ( 13 )  tmp_3d
658                s_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]659                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]660
661             CASE ( 'sa' )
662                READ ( 13 )  tmp_3d
663                sa(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]664                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]665
666             CASE ( 'sa_av' )
667                IF ( .NOT. ALLOCATED( sa_av ) )  THEN
668                   ALLOCATE( sa_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
669                ENDIF
670                READ ( 13 )  tmp_3d
671                sa_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]672                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]673
674             CASE ( 'saswsb' )
675                READ ( 13 )  tmp_2d
676                saswsb(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]677                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]678
679             CASE ( 'saswst' )
680                READ ( 13 )  tmp_2d
681                saswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]682                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]683
684             CASE ( 'shf' )
685                READ ( 13 )  tmp_2d
686                shf(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]687                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]688
689             CASE ( 'shf_m' )
690                READ ( 13 )  tmp_2d
691                shf_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]692                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]693
694             CASE ( 'spectrum_x' )
695                READ ( 13 )  spectrum_x
696
697             CASE ( 'spectrum_y' )
698                READ ( 13 )  spectrum_y
699
700             CASE ( 'ts' )
701                READ ( 13 )  tmp_2d
702                ts(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]703                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]704
705             CASE ( 'ts_av' )
706                IF ( .NOT. ALLOCATED( ts_av ) )  THEN
707                   ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
708                ENDIF
709                READ ( 13 )  tmp_2d
710                ts_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]711                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]712
713             CASE ( 'tswst' )
714                READ ( 13 )  tmp_2d
715                tswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]716                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]717
718             CASE ( 'tswst_m' )
719                READ ( 13 )  tmp_2d
720                tswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]721                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]722
723             CASE ( 'u' )
724                READ ( 13 )  tmp_3d
725                u(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]726                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]727
728             CASE ( 'u_av' )
729                IF ( .NOT. ALLOCATED( u_av ) )  THEN
730                   ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
731                ENDIF
732                READ ( 13 )  tmp_3d
733                u_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]734                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]735
736             CASE ( 'u_m' )
737                READ ( 13 )  tmp_3d
738                u_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]739                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]740
741             CASE ( 'u_m_l' )
742                ALLOCATE( tmp_3dw(nzb:nzt+1,nys_on_file-1:nyn_on_file+1,1:2) )
743                READ ( 13 )  tmp_3dw
744                IF ( outflow_l )  THEN
[147]745                   u_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
[146]746                ENDIF
747                DEALLOCATE( tmp_3dw )
748
749             CASE ( 'u_m_n' )
750                ALLOCATE( tmp_3dw(nzb:nzt+1,ny-1:ny, &
751                                  nxl_on_file-1:nxr_on_file+1) )
752                READ ( 13 )  tmp_3dw
753                IF ( outflow_n )  THEN
[147]754                   u_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
[146]755                ENDIF
756                DEALLOCATE( tmp_3dw )
757
758             CASE ( 'u_m_r' )
759                ALLOCATE( tmp_3dw(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
760                                  nx-1:nx) )
761                READ ( 13 )  tmp_3dw
762                IF ( outflow_r )  THEN
[147]763                   u_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
[146]764                ENDIF
765                DEALLOCATE( tmp_3dw )
766
767             CASE ( 'u_m_s' )
768                ALLOCATE( tmp_3dw(nzb:nzt+1,0:1, &
769                                  nxl_on_file-1:nxr_on_file+1) )
770                READ ( 13 )  tmp_3dw
771                IF ( outflow_s )  THEN
[147]772                   u_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
[146]773                ENDIF
774                DEALLOCATE( tmp_3dw )
775
776             CASE ( 'us' )
777                READ ( 13 )  tmp_2d
778                us(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]779                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]780
781             CASE ( 'usws' )
782                READ ( 13 )  tmp_2d
783                usws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]784                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]785
786             CASE ( 'uswst' )
787                READ ( 13 )  tmp_2d
788                uswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]789                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]790
791             CASE ( 'usws_m' )
792                READ ( 13 )  tmp_2d
793                usws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]794                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]795
796             CASE ( 'uswst_m' )
797                READ ( 13 )  tmp_2d
798                uswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]799                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]800
801             CASE ( 'us_av' )
802                IF ( .NOT. ALLOCATED( us_av ) )  THEN
803                   ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
804                ENDIF
805                READ ( 13 )  tmp_2d
806                us_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]807                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]808
809             CASE ( 'v' )
810                READ ( 13 )  tmp_3d
811                v(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]812                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]813
814             CASE ( 'v_av' )
815                IF ( .NOT. ALLOCATED( v_av ) )  THEN
816                   ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
817                ENDIF
818                READ ( 13 )  tmp_3d
819                v_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]820                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]821
822             CASE ( 'v_m' )
823                READ ( 13 )  tmp_3d
824                v_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]825                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]826
827             CASE ( 'v_m_l' )
828                ALLOCATE( tmp_3dw(nzb:nzt+1,nys_on_file-1:nyn_on_file+1,0:1) )
829                READ ( 13 )  tmp_3dw
830                IF ( outflow_l )  THEN
[147]831                   v_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
[146]832                ENDIF
833                DEALLOCATE( tmp_3dw )
834
835             CASE ( 'v_m_n' )
836                ALLOCATE( tmp_3dw(nzb:nzt+1,ny-1:ny, &
837                                  nxl_on_file-1:nxr_on_file+1) )
838                READ ( 13 )  tmp_3dw
839                IF ( outflow_n )  THEN
[147]840                   v_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
[146]841                ENDIF
842                DEALLOCATE( tmp_3dw )
843
844             CASE ( 'v_m_r' )
845                ALLOCATE( tmp_3dw(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
846                                  nx-1:nx) )
847                READ ( 13 )  tmp_3dw
848                IF ( outflow_r )  THEN
[147]849                   v_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
[146]850                ENDIF
851                DEALLOCATE( tmp_3dw )
852
853             CASE ( 'v_m_s' )
854                ALLOCATE( tmp_3dw(nzb:nzt+1,1:2, &
855                                  nxl_on_file-1:nxr_on_file+1) )
856                READ ( 13 )  tmp_3dw
857                IF ( outflow_s )  THEN
[147]858                   v_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
[146]859                ENDIF
860                DEALLOCATE( tmp_3dw )
861
862             CASE ( 'vpt' )
863                READ ( 13 )  tmp_3d
864                vpt(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]865                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]866
867             CASE ( 'vpt_av' )
868                IF ( .NOT. ALLOCATED( vpt_av ) )  THEN
869                   ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
870                ENDIF
871                READ ( 13 )  tmp_3d
872                vpt_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]873                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]874
875             CASE ( 'vpt_m' )
876                READ ( 13 )  tmp_3d
877                vpt_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]878                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]879
880             CASE ( 'vsws' )
881                READ ( 13 )  tmp_2d
882                vsws(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]883                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]884
885             CASE ( 'vswst' )
886                READ ( 13 )  tmp_2d
887                vswst(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]888                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]889
890             CASE ( 'vsws_m' )
891                READ ( 13 )  tmp_2d
892                vsws_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]893                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]894
895             CASE ( 'vswst_m' )
896                READ ( 13 )  tmp_2d
897                vswst_m(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]898                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]899
900             CASE ( 'w' )
901                READ ( 13 )  tmp_3d
902                w(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]903                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]904
905             CASE ( 'w_av' )
906                IF ( .NOT. ALLOCATED( w_av ) )  THEN
907                   ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
908                ENDIF
909                READ ( 13 )  tmp_3d
910                w_av(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]911                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]912
913             CASE ( 'w_m' )
914                READ ( 13 )  tmp_3d
915                w_m(:,nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]916                                          tmp_3d(:,nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]917
918             CASE ( 'w_m_l' )
919                ALLOCATE( tmp_3dw(nzb:nzt+1,nys_on_file-1:nyn_on_file+1,0:1) )
920                READ ( 13 )  tmp_3dw
921                IF ( outflow_l )  THEN
[147]922                   w_m_l(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
[146]923                ENDIF
924                DEALLOCATE( tmp_3dw )
925
926             CASE ( 'w_m_n' )
927                ALLOCATE( tmp_3dw(nzb:nzt+1,ny-1:ny, &
928                                  nxl_on_file-1:nxr_on_file+1) )
929                READ ( 13 )  tmp_3dw
930                IF ( outflow_n )  THEN
[147]931                   w_m_n(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
[146]932                ENDIF
933                DEALLOCATE( tmp_3dw )
934
935             CASE ( 'w_m_r' )
936                ALLOCATE( tmp_3dw(nzb:nzt+1,nys_on_file-1:nyn_on_file+1, &
937                                  nx-1:nx) )
938                READ ( 13 )  tmp_3dw
939                IF ( outflow_r )  THEN
[147]940                   w_m_r(:,nysc-1:nync+1,:) = tmp_3dw(:,nysf-1:nynf+1,:)
[146]941                ENDIF
942                DEALLOCATE( tmp_3dw )
943
944             CASE ( 'w_m_s' )
945                ALLOCATE( tmp_3dw(nzb:nzt+1,0:1, &
946                                  nxl_on_file-1:nxr_on_file+1) )
947                READ ( 13 )  tmp_3dw
948                IF ( outflow_s )  THEN
[147]949                   w_m_s(:,:,nxlc-1:nxrc+1) = tmp_3dw(:,:,nxlf-1:nxrf+1)
[146]950                ENDIF
951                DEALLOCATE( tmp_3dw )
952
953             CASE ( 'z0' )
954                READ ( 13 )  tmp_2d
955                z0(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]956                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]957
958             CASE ( 'z0_av' )
959                IF ( .NOT. ALLOCATED( z0_av ) )  THEN
960                   ALLOCATE( z0_av(nys-1:nyn+1,nxl-1:nxr+1) )
961                ENDIF
962                READ ( 13 )  tmp_2d
963                z0_av(nysc-1:nync+1,nxlc-1:nxrc+1) = &
[147]964                                          tmp_2d(nysf-1:nynf+1,nxlf-1:nxrf+1)
[146]965
966             CASE DEFAULT
967                PRINT*, '+++ read_3d_binary: unknown field named "', &
968                        TRIM( field_chr ), '" found in'
969                PRINT*, '                    data from prior run on PE ', myid
970                CALL local_stop
971
972          END SELECT
[1]973!
[146]974!--       Read next character string
975          READ ( 13 )  field_chr
[1]976
[146]977       ENDDO  ! loop over variables
[1]978
979!
[146]980!--    Read user-defined restart data
[147]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 )
[145]984
985!
[146]986!--    Close the restart file
987       CALL close_file( 13 )
988
989       DEALLOCATE( tmp_2d, tmp_3d )
990
991    ENDDO  ! loop over restart files
992
993
994!
995!-- Restore the original filename for the restart file to be written
996    myid_char = myid_char_save
997
998
999!
[1]1000!-- End of time measuring for reading binary data
1001    CALL cpu_log( log_point_s(14), 'read_3d_binary', 'stop' )
1002
1003 END SUBROUTINE read_3d_binary
Note: See TracBrowser for help on using the repository browser.