Home

Context Navigation

source: palm/trunk/UTIL/combine_plot_fields.f90 @ 209

Last change on this file since 209 was 191, checked in by raasch, 16 years ago
further adjustments and bugfixes for SGI system
Property svn:keywords set to `Id`
File size: 26.2 KB

Line
1	PROGRAM combine_plot_fields
2
3	!------------------------------------------------------------------------------!
4	! Actual revisions:
5	! -----------------
6	! Subdomain data are read into temporary arrays pf_tmp/pf3d_tmp in order to
7	! avoid INTEL compiler warnings about (automatic) creation of temporary arrays
8	! Bugfix: three misplaced #endif directives
9	!
10	! Former revisions:
11	! -----------------
12	! $Id: combine_plot_fields.f90 191 2008-08-27 14:34:51Z steinfeld $
13	!
14	! 114 2007-10-10 00:03:15Z raasch
15	! Bugfix: model_string needed a default value
16	!
17	! Aug 07 Loop for processing of output by coupled runs, id_string does not
18	! contain modus any longer
19	!
20	! 18/01/06 Output of time-averaged data
21	!
22	! 25/05/05 Errors removed
23	!
24	! 26/04/05 Output in NetCDF format, iso2d and avs output only if parameter
25	! file exists
26	!
27	! 31/10/01 All comments and messages translated into English
28	!
29	! 23/02/99 Keine Bearbeitung komprimierter 3D-Daten
30	! Ursprungsversion vom 28/07/97
31	!
32	!
33	! Description:
34	! ------------
35	! This routine combines data of the PALM-subdomains into one file. In PALM
36	! every processor element opens its own file and writes 2D- or 3D-binary-data
37	! into it (different files are opened for xy-, xz-, yz-cross-sections and
38	! 3D-data). For plotting or analyzing these PE-data have to be collected and
39	! to be put into single files, which is done by this routine.
40	! Output format is NetCDF. Additionally, a data are output in a binary format
41	! readable by ISO2D-software (cross-sections) and by AVS (3D-data).
42	!
43	! This routine must be compiled with:
44	! decalpha:
45	! f95 -cpp -D__netcdf -fast -r8 -I/usr/local/netcdf-3.5.1/include
46	! -L/usr/local/netcdf-3.5.1/lib -lnetcdf
47	! IBM-Regatta:
48	! xlf95 -qsuffix=cpp=f90 -WF,-D__netcdf -qrealsize=8 -q64 -qmaxmem=-1 -Q
49	! -I /aws/dataformats/netcdf-3.6.0-p1/64-32/include-64
50	! -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib -lnetcdf -O3
51	! IBM-Regatta KISTI:
52	! xlf95 -qsuffix=cpp=f90 -WF,-D__netcdf -qrealsize=8 -q64 -qmaxmem=-1 -Q
53	! -I /applic/netcdf64/src/f90
54	! -L/applic/lib/NETCDF64 -lnetcdf -O3
55	! IBM-Regatta Yonsei (gfdl5):
56	! xlf95 -qsuffix=cpp=f90 -WF,-D__netcdf -qrealsize=8 -q64 -qmaxmem=-1 -Q
57	! -I /usr1/users/raasch/pub/netcdf-3.6.0-p1/include
58	! -L/usr1/users/raasch/pub/netcdf-3.6.0-p1/lib -lnetcdf -O3
59	! IMUK:
60	! ifort combine...f90 -o combine...x
61	! -cpp -D__netcdf -I /muksoft/packages/netcdf/linux/include -axW -r8 -nbs
62	! -Vaxlib -L /muksoft/packages/netcdf/linux/lib -lnetcdf
63	! NEC-SX6:
64	! sxf90 combine...f90 -o combine...x
65	! -I /pool/SX-6/netcdf/netcdf-3.6.0-p1/include -C hopt -Wf '-A idbl4'
66	! -D__netcdf -L/pool/SX-6/netcdf/netcdf-3.6.0-p1/lib -lnetcdf
67	! Sun Fire X4600
68	! pgf95 combine...f90 -o combine...x
69	! -Mpreprocess -D__netcdf -I /home/usr5/mkanda/netcdf-3.6.1/src/f90 -r8
70	! -fast -L/home/usr5/mkanda/netcdf-3.6.1/src/libsrc -lnetcdf
71	! FIMM:
72	! ifort combine...f90 -o combine...x
73	! -axW -cpp -openmp -r8 -nbs -convert little_endian -D__netcdf
74	! -I /local/netcdf/include -Vaxlib -L/local/netcdf/lib -lnetcdf
75	!------------------------------------------------------------------------------!
76
77	#if defined( __netcdf )
78	USE netcdf
79	#endif
80
81	IMPLICIT NONE
82
83	!
84	!-- Local variables
85	CHARACTER (LEN=2) :: modus, model_string
86	CHARACTER (LEN=4) :: id_string
87	CHARACTER (LEN=10) :: dimname, var_name
88	CHARACTER (LEN=40) :: filename
89
90	CHARACTER (LEN=2000), DIMENSION(0:1) :: var_list
91
92	INTEGER, PARAMETER :: spk = SELECTED_REAL_KIND( 6 )
93
94	INTEGER :: av, danz, i, id, &
95	j, model, models, nc_stat, nxa, nxag, nxe, nxeg, nya, &
96	nyag, nye, nyeg, nza, nzag, nze, nzeg, pos, time_step, xa, xe, &
97	ya, ye, za, ze
98
99	INTEGER, DIMENSION(0:1) :: current_level, current_var, fanz, id_set, &
100	id_var_time, num_var
101
102	INTEGER, DIMENSION(4) :: id_dims_loc
103
104	INTEGER, DIMENSION(0:1,4) :: id_dims
105
106	INTEGER, DIMENSION(0:1,1000) :: id_var, levels
107
108	LOGICAL :: avs_output, compressed, found, iso2d_output, netcdf_output, &
109	netcdf_0, netcdf_1
110
111	REAL :: dx, simulated_time
112	REAL, DIMENSION(:), ALLOCATABLE :: eta, ho, hu
113	REAL, DIMENSION(:,:), ALLOCATABLE :: pf, pf_tmp
114	REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: pf3d, pf3d_tmp
115
116	PRINT*, ''
117	PRINT*, ''
118	PRINT, ' combine_plot_fields *'
119
120	!
121	!-- Find out if a coupled run has been carried out
122	INQUIRE( FILE='COUPLING_PORT_OPENED', EXIST=found )
123	IF ( found ) THEN
124	models = 2
125	PRINT*, ' coupled run'
126	ELSE
127	models = 1
128	PRINT*, ' uncoupled run'
129	ENDIF
130
131	!
132	!-- Do everything for each model
133	DO model = 1, models
134	!
135	!-- Set the model string used to identify the filenames
136	model_string = ''
137	IF ( models == 2 ) THEN
138	PRINT*, ''
139	PRINT, ' combine_plot_fields *'
140	IF ( model == 2 ) THEN
141	model_string = '_O'
142	PRINT*, ' now combining ocean data'
143	PRINT*, ' ========================'
144	ELSE
145	PRINT*, ' now combining atmosphere data'
146	PRINT*, ' ============================='
147	ENDIF
148	ENDIF
149	!
150	!-- 2D-arrays for ISO2D
151	!-- Main loop for the three different cross-sections, starting with
152	!-- xy-section
153	modus = 'XY'
154	PRINT*, ''
155	DO WHILE ( modus == 'XY' .OR. modus == 'XZ' .OR. modus == 'YZ' )
156	!
157	!-- Check, if file from PE0 exists. If it does not exist, PALM did not
158	!-- create any output for this cross-section.
159	danz = 0
160	WRITE (id_string,'(I4.4)') danz
161	INQUIRE ( &
162	FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
163	EXIST=found )
164	!
165	!-- Find out the number of files (equal to the number of PEs which
166	!-- have been used in PALM) and open them
167	DO WHILE ( found )
168
169	OPEN ( danz+110, &
170	FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
171	FORM='UNFORMATTED' )
172	danz = danz + 1
173	WRITE (id_string,'(I4.4)') danz
174	INQUIRE ( &
175	FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
176	EXIST=found )
177
178	ENDDO
179
180	!
181	!-- Inquire whether an iso2d parameter file exists
182	INQUIRE( FILE='PLOT2D_'//modus//'_GLOBAL'//TRIM( model_string ), &
183	EXIST=iso2d_output )
184
185	!
186	!-- Inquire whether a NetCDF file exists
187	INQUIRE( FILE='DATA_2D_'//modus//'_NETCDF'//TRIM( model_string ), &
188	EXIST=netcdf_0 )
189
190	!
191	!-- Inquire whether a NetCDF file for time-averaged data exists
192	INQUIRE( FILE='DATA_2D_'//modus//'_AV_NETCDF'//TRIM( model_string ),&
193	EXIST=netcdf_1 )
194
195	IF ( netcdf_0 .OR. netcdf_1 ) THEN
196	netcdf_output = .TRUE.
197	ELSE
198	netcdf_output = .FALSE.
199	ENDIF
200
201	!
202	!-- Info-output
203	PRINT*, ''
204	PRINT, ' combine_plot_fields *'
205	#if defined( __netcdf )
206	IF ( netcdf_output ) PRINT*, ' NetCDF output enabled'
207	#else
208	IF ( netcdf_output ) THEN
209	PRINT*, '--- Sorry, no NetCDF support on this host'
210	netcdf_output = .FALSE.
211	ENDIF
212	#endif
213	IF ( danz /= 0 ) THEN
214	PRINT*, ' ',modus,'-section: ', danz, ' file(s) found'
215	ELSE
216	PRINT*, ' no ', modus, '-section data available'
217	ENDIF
218
219	IF ( netcdf_output .AND. danz /= 0 ) THEN
220	#if defined( __netcdf )
221	DO av = 0, 1
222
223	IF ( av == 0 .AND. .NOT. netcdf_0 ) CYCLE
224	IF ( av == 1 .AND. .NOT. netcdf_1 ) CYCLE
225
226	!
227	!-- Open NetCDF dataset
228	IF ( av == 0 ) THEN
229	filename = 'DATA_2D_'//modus//'_NETCDF' &
230	//TRIM( model_string )
231	ELSE
232	filename = 'DATA_2D_'//modus//'_AV_NETCDF' &
233	//TRIM( model_string )
234	ENDIF
235	nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set(av) )
236	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 1 )
237
238	!
239	!-- Get the list of variables (order of variables corresponds with
240	!-- the order of data on the binary file)
241	var_list(av) = ' ' ! GET_ATT does not assign trailing blanks
242	nc_stat = NF90_GET_ATT( id_set(av), NF90_GLOBAL, 'VAR_LIST', &
243	var_list(av) )
244	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 2 )
245
246	!
247	!-- Inquire id of the time coordinate variable
248	nc_stat = NF90_INQ_VARID( id_set(av), 'time', id_var_time(av) )
249	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 3 )
250
251	!
252	!-- Count number of variables; there is one more semicolon in the
253	!-- string than variable names
254	num_var(av) = -1
255	DO i = 1, LEN( var_list(av) )
256	IF ( var_list(av)(i:i) == ';' ) num_var(av) = num_var(av) +1
257	ENDDO
258
259	!
260	!-- Extract the variable names from the list and inquire their
261	!-- NetCDF IDs
262	pos = INDEX( var_list(av), ';' )
263	!
264	!-- Loop over all variables
265	DO i = 1, num_var(av)
266
267	!
268	!-- Extract variable name from list
269	var_list(av) = var_list(av)(pos+1:)
270	pos = INDEX( var_list(av), ';' )
271	var_name = var_list(av)(1:pos-1)
272
273	!
274	!-- Get variable ID from name
275	nc_stat = NF90_INQ_VARID( id_set(av), TRIM( var_name ), &
276	id_var(av,i) )
277	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 4 )
278
279	!
280	!-- Get number of x/y/z levels for that variable
281	nc_stat = NF90_INQUIRE_VARIABLE( id_set(av), id_var(av,i), &
282	dimids = id_dims_loc )
283	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 5 )
284	id_dims(av,:) = id_dims_loc
285
286	!
287	!-- Inquire dimension ID
288	DO j = 1, 4
289	nc_stat = NF90_INQUIRE_DIMENSION( id_set(av), &
290	id_dims(av,j), dimname, levels(av,i) )
291	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 6 )
292
293	IF ( modus == 'XY' .AND. INDEX(dimname, 'z') /= 0 ) EXIT
294	IF ( modus == 'XZ' .AND. INDEX(dimname, 'y') /= 0 ) EXIT
295	IF ( modus == 'YZ' .AND. INDEX(dimname, 'x') /= 0 ) EXIT
296	ENDDO
297
298	ENDDO
299
300	ENDDO ! av = 0, 1
301
302	#endif
303	ENDIF
304
305	!
306	!-- Read the arrays, as long as the end of the file is reached
307	fanz = 0
308	current_level = 1
309	current_var = 999999999
310
311	DO WHILE ( danz /= 0 )
312
313	!
314	!-- Loop over all files (reading data of the subdomains)
315	DO id = 0, danz-1
316	!
317	!-- File from PE0 contains special information at the beginning,
318	!-- concerning the lower and upper indices of the total-domain used
319	!-- in PALM (nxag, nxeg, nyag, nyeg) and the lower and upper indices
320	!-- of the array to be writte by this routine (nxa, nxe, nya,
321	!-- nye). Usually in the horizontal directions nxag=-1 and nxa=0
322	!-- while all other variables have the same value (i.e. nxeg=nxe).
323	!-- Allocate necessary arrays, open the output file and write
324	!-- the coordinate informations needed by ISO2D.
325	IF ( id == 0 .AND. fanz(0) == 0 .AND. fanz(1) == 0 ) THEN
326	READ ( id+110 ) nxag, nxeg, nyag, nyeg
327	READ ( id+110 ) nxa, nxe, nya, nye
328	ALLOCATE ( eta(nya:nye), ho(nxa:nxe), hu(nxa:nxe), &
329	pf(nxag:nxeg,nyag:nyeg) )
330	READ ( id+110 ) dx, eta, hu, ho
331
332	IF ( iso2d_output ) THEN
333	OPEN ( 2, FILE='PLOT2D_'//modus//TRIM( model_string ), &
334	FORM='UNFORMATTED' )
335	WRITE ( 2 ) dx, eta, hu, ho
336	ENDIF
337	ENDIF
338	!
339	!-- Read output time
340	IF ( netcdf_output .AND. id == 0 ) THEN
341	IF ( netcdf_1 ) THEN
342	READ ( id+110, END=998 ) simulated_time, time_step, av
343	ELSE
344	!
345	!-- For compatibility with earlier PALM versions
346	READ ( id+110, END=998 ) simulated_time, time_step
347	av = 0
348	ENDIF
349	ENDIF
350	!
351	!-- Read subdomain indices
352	READ ( id+110, END=998 ) xa, xe, ya, ye
353	!
354	!-- IF the PE made no output (in case that no part of the
355	!-- cross-section is situated on this PE), indices have the
356	!-- value -1
357	IF ( .NOT. ( xa == -1 .AND. xe == -1 .AND. &
358	ya == -1 .AND. ye == -1 ) ) THEN
359	!
360	!-- Read the subdomain grid-point values
361	ALLOCATE( pf_tmp(xa:xe,ya:ye) )
362	READ ( id+110 ) pf_tmp
363	pf(xa:xe,ya:ye) = pf_tmp
364	DEALLOCATE( pf_tmp )
365	ENDIF
366	IF ( id == 0 ) fanz(av) = fanz(av) + 1
367
368	ENDDO
369	!
370	!-- Write the data of the total domain cross-section
371	IF ( iso2d_output ) WRITE ( 2 ) pf(nxa:nxe,nya:nye)
372
373	!
374	!-- Write same data in NetCDF format
375	IF ( netcdf_output ) THEN
376	#if defined( __netcdf )
377	!
378	!-- Check if a new time step has begun; if yes write data to time
379	!-- axis
380	IF ( current_var(av) > num_var(av) ) THEN
381	current_var(av) = 1
382	nc_stat = NF90_PUT_VAR( id_set(av), id_var_time(av), &
383	(/ simulated_time /), &
384	start = (/ time_step /), &
385	count = (/ 1 /) )
386	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 7 )
387	ENDIF
388
389	!
390	!-- Now write the data; this is mode dependent
391	SELECT CASE ( modus )
392
393	CASE ( 'XY' )
394	nc_stat = NF90_PUT_VAR( id_set(av), &
395	id_var(av,current_var(av)), &
396	pf(nxa:nxe,nya:nye), &
397	start = (/ 1, 1, current_level(av), time_step /), &
398	count = (/ nxe-nxa+1, nye-nya+1, 1, 1 /) )
399	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 8)
400
401	CASE ( 'XZ' )
402	nc_stat = NF90_PUT_VAR( id_set(av), &
403	id_var(av,current_var(av)), &
404	pf(nxa:nxe,nya:nye), &
405	start = (/ 1, current_level(av), 1, time_step /), &
406	count = (/ nxe-nxa+1, 1, nye-nya+1, 1 /) )
407	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 9)
408
409	CASE ( 'YZ' )
410	nc_stat = NF90_PUT_VAR( id_set(av), &
411	id_var(av,current_var(av)), &
412	pf(nxa:nxe,nya:nye), &
413	start = (/ current_level(av), 1, 1, time_step /), &
414	count = (/ 1, nxe-nxa+1, nye-nya+1, 1 /) )
415	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error(10)
416
417	END SELECT
418
419	!
420	!-- Data is written, check if max level is reached
421	current_level(av) = current_level(av) + 1
422	IF ( current_level(av) > levels(av,current_var(av)) ) THEN
423	current_level(av) = 1
424	current_var(av) = current_var(av) + 1
425	ENDIF
426
427	#endif
428	ENDIF
429
430	ENDDO
431
432	998 IF ( danz /= 0 ) THEN
433	!
434	!-- Print the number of the arrays processed
435	WRITE (*,'(16X,I4,A)') fanz(0)+fanz(1), ' array(s) processed'
436	IF ( fanz(1) /= 0 ) THEN
437	WRITE (*,'(16X,I4,A)') fanz(1), ' array(s) are time-averaged'
438	ENDIF
439
440	!
441	!-- Close all files and deallocate arrays
442	DO id = 0, danz-1
443	CLOSE ( id+110 )
444	ENDDO
445	CLOSE ( 2 )
446	DEALLOCATE ( eta, ho, hu, pf )
447	ENDIF
448
449	!
450	!-- Close the NetCDF file
451	IF ( netcdf_output .AND. danz /= 0 ) THEN
452	#if defined( __netcdf )
453	IF ( netcdf_0 ) THEN
454	nc_stat = NF90_CLOSE( id_set(0) )
455	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 11 )
456	ENDIF
457	IF ( netcdf_1 ) THEN
458	nc_stat = NF90_CLOSE( id_set(1) )
459	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 12 )
460	ENDIF
461	#endif
462	ENDIF
463
464	!
465	!-- Choose the next cross-section
466	SELECT CASE ( modus )
467	CASE ( 'XY' )
468	modus = 'XZ'
469	CASE ( 'XZ' )
470	modus = 'YZ'
471	CASE ( 'YZ' )
472	modus = 'no'
473	END SELECT
474
475	ENDDO
476
477
478	!
479	!-- Combine the 3D-arrays
480
481	!
482	!-- Inquire whether an avs fld file exists
483	INQUIRE( FILE='PLOT3D_FLD'//TRIM( model_string ), EXIST=avs_output )
484
485	!
486	!-- Inquire whether a NetCDF file exists
487	INQUIRE( FILE='DATA_3D_NETCDF'//TRIM( model_string ), EXIST=netcdf_0 )
488
489	!
490	!-- Inquire whether a NetCDF file for time-averaged data exists
491	INQUIRE( FILE='DATA_3D_AV_NETCDF'//TRIM( model_string ), EXIST=netcdf_1 )
492
493	IF ( netcdf_0 .OR. netcdf_1 ) THEN
494	netcdf_output = .TRUE.
495	ELSE
496	netcdf_output = .FALSE.
497	ENDIF
498
499	!
500	!-- Check, if file from PE0 exists
501	danz = 0
502	WRITE (id_string,'(I4.4)') danz
503	INQUIRE ( &
504	FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM( id_string ), &
505	EXIST=found )
506
507	!
508	!-- Combination only works, if data are not compressed. In that case,
509	!-- PALM created a flag file (PLOT3D_COMPRESSED)
510	INQUIRE ( FILE='PLOT3D_COMPRESSED'//TRIM( model_string ), &
511	EXIST=compressed )
512
513	!
514	!-- Find out the number of files and open them
515	DO WHILE ( found .AND. .NOT. compressed )
516
517	OPEN ( danz+110, &
518	FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM(id_string), &
519	FORM='UNFORMATTED')
520	danz = danz + 1
521	WRITE (id_string,'(I4.4)') danz
522	INQUIRE ( &
523	FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM(id_string), &
524	EXIST=found )
525
526	ENDDO
527
528	!
529	!-- Info-output
530	PRINT*, ' '
531	PRINT, ' combine_plot_fields *'
532	#if defined( __netcdf )
533	IF ( netcdf_output ) PRINT*, ' NetCDF output enabled'
534	#else
535	IF ( netcdf_output ) THEN
536	PRINT*, '--- Sorry, no NetCDF support on this host'
537	netcdf_output = .FALSE.
538	ENDIF
539	#endif
540	IF ( danz /= 0 ) THEN
541	PRINT*, ' 3D-data: ', danz, ' file(s) found'
542	ELSE
543	IF ( found .AND. compressed ) THEN
544	PRINT*, '+++ no 3D-data processing, since data are compressed'
545	ELSE
546	PRINT*, ' no 3D-data file available'
547	ENDIF
548	ENDIF
549
550	IF ( netcdf_output .AND. danz /= 0 ) THEN
551	#if defined( __netcdf )
552	DO av = 0, 1
553
554	IF ( av == 0 .AND. .NOT. netcdf_0 ) CYCLE
555	IF ( av == 1 .AND. .NOT. netcdf_1 ) CYCLE
556
557	!
558	!-- Open NetCDF dataset
559	IF ( av == 0 ) THEN
560	filename = 'DATA_3D_NETCDF'//TRIM( model_string )
561	ELSE
562	filename = 'DATA_3D_AV_NETCDF'//TRIM( model_string )
563	ENDIF
564	nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set(av) )
565	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 13 )
566
567
568	!
569	!-- Get the list of variables (order of variables corresponds with the
570	!-- order of data on the binary file)
571	var_list(av) = ' ' ! GET_ATT does not assign trailing blanks
572	nc_stat = NF90_GET_ATT( id_set(av), NF90_GLOBAL, 'VAR_LIST', &
573	var_list(av) )
574	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 14 )
575
576	!
577	!-- Inquire id of the time coordinate variable
578	nc_stat = NF90_INQ_VARID( id_set(av), 'time', id_var_time(av) )
579	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 15 )
580
581	!
582	!-- Count number of variables; there is one more semicolon in the
583	!-- string than variable names
584	num_var(av) = -1
585	DO i = 1, LEN( var_list(av) )
586	IF ( var_list(av)(i:i) == ';' ) num_var(av) = num_var(av) + 1
587	ENDDO
588
589	!
590	!-- Extract the variable names from the list and inquire their NetCDF
591	!-- IDs
592	pos = INDEX( var_list(av), ';' )
593	!
594	!-- Loop over all variables
595	DO i = 1, num_var(av)
596
597	!
598	!-- Extract variable name from list
599	var_list(av) = var_list(av)(pos+1:)
600	pos = INDEX( var_list(av), ';' )
601	var_name = var_list(av)(1:pos-1)
602
603	!
604	!-- Get variable ID from name
605	! print, '** find id for "',TRIM( var_name ),'" begin'
606	nc_stat = NF90_INQ_VARID( id_set(av), TRIM( var_name ), &
607	id_var(av,i) )
608	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 16 )
609	! print, '** find id for "',TRIM( var_name ),'" end'
610
611	ENDDO
612
613	ENDDO ! av=0,1
614
615	#endif
616	ENDIF
617
618	!
619	!-- Read arrays, until the end of the file is reached
620	current_var = 999999999
621	fanz = 0
622	DO WHILE ( danz /= 0 )
623
624	!
625	!-- Loop over all files
626	DO id = 0, danz-1
627	!
628	!-- File from PE0 contains special information at the beginning,
629	!-- concerning the lower and upper indices of the total-domain used in
630	!-- PALM (nxag, nxeg, nyag, nyeg, nzag, nzeg) and the lower and upper
631	!-- indices of the array to be written by this routine (nxa, nxe, nya,
632	!-- nye, nza, nze). Usually nxag=-1 and nxa=0, nyag=-1 and nya=0,
633	!-- nzeg=nz and nze=nz_plot3d.
634	!-- Allocate necessary array and open the output file.
635	IF ( id == 0 .AND. fanz(0) == 0 .AND. fanz(1) == 0 ) THEN
636	READ ( id+110 ) nxag, nxeg, nyag, nyeg, nzag, nzeg
637	READ ( id+110 ) nxa, nxe, nya, nye, nza, nze
638	ALLOCATE ( pf3d(nxag:nxeg,nyag:nyeg,nzag:nzeg) )
639	IF ( avs_output ) THEN
640	OPEN ( 2, FILE='PLOT3D_DATA'//TRIM( model_string ), &
641	FORM='UNFORMATTED' )
642	ENDIF
643	ENDIF
644
645	!
646	!-- Read output time
647	IF ( netcdf_output .AND. id == 0 ) THEN
648	IF ( netcdf_1 ) THEN
649	READ ( id+110, END=999 ) simulated_time, time_step, av
650	ELSE
651	!
652	!-- For compatibility with earlier PALM versions
653	READ ( id+110, END=999 ) simulated_time, time_step
654	av = 0
655	ENDIF
656	ENDIF
657
658	!
659	!-- Read subdomain indices and grid point values
660	READ ( id+110, END=999 ) xa, xe, ya, ye, za, ze
661	ALLOCATE( pf3d_tmp(xa:xe,ya:ye,za:ze) )
662	READ ( id+110 ) pf3d_tmp
663	pf3d(xa:xe,ya:ye,za:ze) = pf3d_tmp
664	DEALLOCATE( pf3d_tmp )
665	IF ( id == 0 ) fanz(av) = fanz(av) + 1
666
667	ENDDO
668
669	!
670	!-- Write data of the total domain
671	IF ( avs_output ) WRITE ( 2 ) pf3d(nxa:nxe,nya:nye,nza:nze)
672
673	!
674	!-- Write same data in NetCDF format
675	IF ( netcdf_output ) THEN
676	#if defined( __netcdf )
677	!
678	!-- Check if a new time step has begun; if yes write data to time axis
679	IF ( current_var(av) > num_var(av) ) THEN
680	current_var(av) = 1
681	nc_stat = NF90_PUT_VAR( id_set(av), id_var_time(av), &
682	(/ simulated_time /),&
683	start = (/ time_step /), count = (/ 1 /) )
684	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 17 )
685	ENDIF
686
687	!
688	!-- Now write the data
689	nc_stat = NF90_PUT_VAR( id_set(av), id_var(av,current_var(av)), &
690	pf3d(nxa:nxe,nya:nye,nza:nze), &
691	start = (/ 1, 1, 1, time_step /), &
692	count = (/ nxe-nxa+1, nye-nya+1, nze-nza+1, 1 /) )
693	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 18 )
694
695	current_var(av) = current_var(av) + 1
696
697	#endif
698	ENDIF
699
700	ENDDO
701
702	999 IF ( danz /= 0 ) THEN
703	!
704	!-- Print the number of arrays processed
705	WRITE (*,'(16X,I4,A)') fanz(0)+fanz(1), ' array(s) processed'
706	IF ( fanz(1) /= 0 ) THEN
707	WRITE (*,'(16X,I4,A)') fanz(1), ' array(s) are time-averaged'
708	ENDIF
709	!
710	!-- Close all files and deallocate array
711	DO id = 0, danz-1
712	CLOSE ( id+110 )
713	ENDDO
714	CLOSE ( 2 )
715	DEALLOCATE ( pf3d )
716	!
717	!-- Close the NetCDF file
718	IF ( netcdf_output ) THEN
719	#if defined( __netcdf )
720	IF ( netcdf_0 ) THEN
721	nc_stat = NF90_CLOSE( id_set(0) )
722	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 19 )
723	ENDIF
724	IF ( netcdf_1 ) THEN
725	nc_stat = NF90_CLOSE( id_set(1) )
726	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 20 )
727	ENDIF
728	#endif
729	ENDIF
730	ENDIF
731
732	ENDDO ! models
733
734
735	CONTAINS
736
737
738	SUBROUTINE handle_netcdf_error( errno )
739	!
740	!-- Prints out a text message corresponding to the current NetCDF status
741
742	IMPLICIT NONE
743
744	INTEGER, INTENT(IN) :: errno
745
746	#if defined( __netcdf )
747	IF ( nc_stat /= NF90_NOERR ) THEN
748	PRINT*, '+++ combine_plot_fields netcdf: ', av, errno, &
749	TRIM( nf90_strerror( nc_stat ) )
750	ENDIF
751	#endif
752
753	END SUBROUTINE handle_netcdf_error
754
755
756	END PROGRAM combine_plot_fields
757
758
759

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |