Home

Context Navigation

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

Last change on this file since 3947 was 3241, checked in by raasch, 6 years ago
various changes to avoid compiler warnings (mainly removal of unused variables)
Property svn:keywords set to `Id`
File size: 30.0 KB

Line
1	PROGRAM combine_plot_fields
2
3	!------------------------------------------------------------------------------!
4	! This file is part of the PALM model system.
5	!
6	! PALM is free software: you can redistribute it and/or modify it under the
7	! terms of the GNU General Public License as published by the Free Software
8	! Foundation, either version 3 of the License, or (at your option) any later
9	! version.
10	!
11	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14	!
15	! You should have received a copy of the GNU General Public License along with
16	! PALM. If not, see <http://www.gnu.org/licenses/>.
17	!
18	! Copyright 1997-2018 Leibniz Universitaet Hannover
19	!------------------------------------------------------------------------------!
20	!
21	! Current revisions:
22	! -----------------
23	!
24	!
25	! Former revisions:
26	! -----------------
27	! $Id: combine_plot_fields.f90 3241 2018-09-12 15:02:00Z hellstea $
28	! unused variables removed
29	!
30	! 2718 2018-01-02 08:49:38Z maronga
31	! Corrected "Former revisions" section
32	!
33	! 2696 2017-12-14 17:12:51Z kanani
34	! Change in file header (GPL part)
35	!
36	! 2669 2017-12-06 16:03:27Z raasch
37	! data of 3d-nest runs are completely processed now
38	!
39	! 2523 2017-10-05 14:42:47Z kanani
40	! Increased LEN for CHARACTER variable var_name, equal to the value in PALM
41	!
42	! 2512 2017-10-04 08:26:59Z raasch
43	! PALM output does not contain ghost layer data any more
44	! avs- and iso2d-related parts removed, handling of compressed data removed
45	!
46	! 2365 2017-08-21 14:59:59Z kanani
47	! Vertical grid nesting implemented (SadiqHuq)
48	!
49	! 1809 2016-04-05 20:13:28Z raasch
50	!
51	! 1808 2016-04-05 19:44:00Z raasch
52	! cpu measurements are done with standard FORTRAN routine on every machine
53	!
54	! 1551 2015-03-03 14:18:16Z maronga
55	! Adjustments for data output of soil model quantities
56	!
57	! 1468 2014-09-24 14:06:57Z maronga
58	! Adapted for use on up to 6-digit processor cores (not tested)
59	!
60	! 1394 2014-05-06 10:17:31Z keck
61	! KIND-attribute added to all INTEGER and REAL declaration statements
62	!
63	! 1046 2012-11-09 14:38:45Z maronga
64	! code put under GPL (PALM 3.9)
65	!
66	! 691 2011-03-04 08:45:30Z maronga
67	! Bugfix: check for precursor ocean runs, removed typo
68	!
69	! 493 2010-03-01 08:30:24Z raasch
70	! Exit in case of already complete NetCDF data (due to parallel output in PALM)
71	! cpu measurements included
72	!
73	! 210 2008-11-06 08:54:02Z raasch
74	! Size of pf3d adjusted to the required output size (1 gridpoint less, along
75	! all three dimensions), because output of a subset of the data
76	! (pf3d(nxa:nxe...) in the NF90_PUT_VAR statement caused segmentation fault
77	! with the INTEL compiler.
78	! Subdomain data are read into temporary arrays pf_tmp/pf3d_tmp in order to
79	! avoid INTEL compiler warnings about (automatic) creation of temporary arrays
80	! Bugfix: three misplaced #endif directives
81	!
82	! 114 2007-10-10 00:03:15Z raasch
83	! Bugfix: model_string needed a default value
84	!
85	! Aug 07 Loop for processing of output by coupled runs, id_string does not
86	! contain modus any longer
87	!
88	! 18/01/06 Output of time-averaged data
89	!
90	! 25/05/05 Errors removed
91	!
92	! 26/04/05 Output in NetCDF format, iso2d and avs output only if parameter
93	! file exists
94	!
95	! 31/10/01 All comments and messages translated into English
96	!
97	! 23/02/99 Keine Bearbeitung komprimierter 3D-Daten
98	! Ursprungsversion vom 28/07/97
99	!
100	!
101	! Description:
102	! ------------
103	! This routine combines data of the PALM-subdomains into one file. In PALM
104	! every processor element opens its own file and writes 2D- or 3D-binary-data
105	! into it (different files are opened for xy-, xz-, yz-cross-sections and
106	! 3D-data). For plotting or analyzing these PE-data have to be collected and
107	! to be put into single files, which is done by this routine.
108	! Output format is NetCDF. Additionally, a data are output in a binary format
109	! readable by ISO2D-software (cross-sections) and by AVS (3D-data).
110	!------------------------------------------------------------------------------!
111
112	#if defined( __netcdf )
113	USE netcdf
114	#endif
115
116	IMPLICIT NONE
117
118	!
119	!-- Local variables
120	CHARACTER (LEN=2) :: modus
121	CHARACTER (LEN=4) :: model_string
122	CHARACTER (LEN=6) :: id_string
123	CHARACTER (LEN=30) :: dimname, var_name
124	CHARACTER (LEN=40) :: filename
125
126	CHARACTER (LEN=2000), DIMENSION(0:1) :: var_list
127
128	INTEGER, PARAMETER :: iwp = 4, spk = SELECTED_REAL_KIND( 6 ), wp = 8
129
130	INTEGER(iwp) :: av, danz, i, id, j, k, model, models, nc_stat, &
131	nxa, nxe, nya, nye, &
132	nza, nze, pos, time_step, xa, xe, xxa, xxe, ya, ya_do, &
133	ya_tot, ye, ye_do, ye_tot, yya, yye, za, ze
134
135	INTEGER(8) :: count, count_rate
136
137	INTEGER(iwp), DIMENSION(0:1) :: current_level, current_var, &
138	fanz, id_set, id_var_time, num_var
139	INTEGER(iwp), DIMENSION(4) :: id_dims_loc
140	INTEGER(iwp), DIMENSION(0:1,4) :: id_dims
141	INTEGER(iwp), DIMENSION(0:1,1000) :: id_var, levels
142
143	LOGICAL :: found, nest3d, netcdf_output, netcdf_parallel, netcdf_0, &
144	netcdf_1, vnest
145
146	REAL(wp) :: cpu_start_time, cpu_end_time, simulated_time
147	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pf, pf_tmp
148	REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: pf3d, pf3d_tmp
149
150
151
152	PRINT*, ''
153	PRINT*, ''
154	PRINT, ' combine_plot_fields *'
155
156	!
157	!-- Find out if a coupled or nested run has been carried out
158	INQUIRE( FILE='COUPLING_PORT_OPENED', EXIST=found )
159	INQUIRE( FILE='VNESTING_PORT_OPENED', EXIST=vnest )
160	INQUIRE( FILE='3DNESTING', EXIST=nest3d )
161	IF ( found ) THEN
162	models = 2
163	PRINT*, ' coupled run'
164	ELSEIF ( vnest ) THEN
165	models = 2
166	PRINT*, ' Vertically nested grid coupling'
167	ELSEIF ( nest3d ) THEN
168	OPEN( 90, FILE='3DNESTING', FORM='FORMATTED' )
169	READ ( 90, '(I2)' ) models
170	CLOSE ( 90 )
171	PRINT*, ' 3d-nest run'
172	PRINT*, ' number of nest domains = ', models
173	ELSE
174	models = 1
175	PRINT*, ' uncoupled run'
176	ENDIF
177
178	!
179	!-- Find out if a precursor ocean run has been carried out
180	INQUIRE( FILE='PRECURSOR_OCEAN', EXIST=found )
181	IF ( found ) THEN
182	model_string = '_O'
183	PRINT*, ' precursor ocean run'
184	ELSE
185	model_string = ''
186	ENDIF
187
188	!
189	!-- Do everything for each model
190	DO model = 1, models
191	!
192	!-- Set the model string used to identify the filenames
193	IF ( found .OR. vnest ) THEN
194	PRINT*, ''
195	IF ( model == 2 ) THEN
196	IF ( vnest ) THEN
197	model_string = '_N'
198	PRINT*, ' now combining FINE data'
199	PRINT*, ' ========================'
200	ELSE
201	model_string = '_O'
202	PRINT*, ' now combining ocean data'
203	PRINT*, ' ========================'
204	ENDIF
205	ELSE
206	IF ( vnest ) THEN
207	PRINT*, ' now combining COARSE data'
208	PRINT*, ' ============================='
209	ELSE
210	PRINT*, ' now combining atmosphere data'
211	PRINT*, ' ============================='
212	ENDIF
213	ENDIF
214	ELSEIF ( nest3d ) THEN
215	PRINT*, ''
216	PRINT*, '--> processing nest id = ', model
217	IF ( model == 1 ) THEN
218	model_string = ''
219	ELSE
220	WRITE( model_string, '(A2,I2.2)' ) '_N', model
221	ENDIF
222	ENDIF
223	!
224	!-- 2D-arrays for ISO2D
225	!-- Main loop for the three different cross-sections, starting with
226	!-- xy-section
227	modus = 'XY'
228	PRINT*, ''
229	DO WHILE ( modus == 'XY' .OR. modus == 'XZ' .OR. modus == 'YZ' )
230	!
231	!-- Take current time
232	CALL SYSTEM_CLOCK( count, count_rate )
233	cpu_start_time = REAL( count ) / REAL( count_rate )
234
235	netcdf_parallel = .FALSE.
236	!
237	!-- Check, if file from PE0 exists. If it does not exist, PALM did not
238	!-- create any output for this cross-section.
239	danz = 0
240	WRITE (id_string,'(I6.6)') danz
241	INQUIRE ( &
242	FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
243	EXIST=found )
244	!
245	!-- Find out the number of files (equal to the number of PEs which
246	!-- have been used in PALM) and open them
247	DO WHILE ( found )
248
249	OPEN ( danz+110, &
250	FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
251	FORM='UNFORMATTED' )
252	danz = danz + 1
253	WRITE (id_string,'(I6.6)') danz
254	INQUIRE ( &
255	FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
256	EXIST=found )
257
258	ENDDO
259
260	!
261	!-- Inquire whether a NetCDF file exists
262	INQUIRE( FILE='DATA_2D_'//modus//'_NETCDF'//TRIM( model_string ), &
263	EXIST=netcdf_0 )
264
265	!
266	!-- Inquire whether a NetCDF file for time-averaged data exists
267	INQUIRE( FILE='DATA_2D_'//modus//'_AV_NETCDF'//TRIM( model_string ),&
268	EXIST=netcdf_1 )
269
270	IF ( netcdf_0 .OR. netcdf_1 ) THEN
271	netcdf_output = .TRUE.
272	!
273	!-- Inquire whether the NetCDF file is already complete (parallel
274	!-- output)
275	INQUIRE( FILE='NO_COMBINE_PLOT_FIELDS_'//modus, &
276	EXIST=netcdf_parallel )
277	IF ( netcdf_parallel ) THEN
278	netcdf_parallel = .TRUE.
279	ELSE
280	netcdf_parallel = .FALSE.
281	ENDIF
282	ELSE
283	netcdf_output = .FALSE.
284	ENDIF
285
286	!
287	!-- Info-output
288	PRINT*, ''
289	#if defined( __netcdf )
290	IF ( netcdf_output ) THEN
291	IF ( netcdf_parallel ) THEN
292	PRINT*, ' NetCDF ' // modus // '-data are in one file ', &
293	'(NetCDF4-format) - merging not neccessary'
294	ELSE
295	PRINT*, ' NetCDF output enabled'
296	ENDIF
297	ENDIF
298	#else
299	IF ( netcdf_output ) THEN
300	PRINT*, '--- Sorry, no NetCDF support on this host'
301	netcdf_output = .FALSE.
302	ENDIF
303	#endif
304	IF ( .NOT. netcdf_parallel ) THEN
305	IF ( danz /= 0 ) THEN
306	PRINT*, ' ',modus,'-section: ', danz, ' file(s) found'
307	ELSE
308	PRINT*, ' no ', modus, '-section data available'
309	ENDIF
310	ENDIF
311
312	IF ( netcdf_output .AND. .NOT. netcdf_parallel .AND. danz /= 0 ) &
313	THEN
314	#if defined( __netcdf )
315	DO av = 0, 1
316
317	IF ( av == 0 .AND. .NOT. netcdf_0 ) CYCLE
318	IF ( av == 1 .AND. .NOT. netcdf_1 ) CYCLE
319
320	!
321	!-- Open NetCDF dataset
322	IF ( av == 0 ) THEN
323	filename = 'DATA_2D_'//modus//'_NETCDF' &
324	//TRIM( model_string )
325	ELSE
326	filename = 'DATA_2D_'//modus//'_AV_NETCDF' &
327	//TRIM( model_string )
328	ENDIF
329	nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set(av) )
330	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 1 )
331
332	!
333	!-- Get the list of variables (order of variables corresponds with
334	!-- the order of data on the binary file)
335	var_list(av) = ' ' ! GET_ATT does not assign trailing blanks
336	nc_stat = NF90_GET_ATT( id_set(av), NF90_GLOBAL, 'VAR_LIST', &
337	var_list(av) )
338	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 2 )
339
340	!
341	!-- Inquire id of the time coordinate variable
342	nc_stat = NF90_INQ_VARID( id_set(av), 'time', id_var_time(av) )
343	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 3 )
344
345	!
346	!-- Count number of variables; there is one more semicolon in the
347	!-- string than variable names
348	num_var(av) = -1
349	DO i = 1, LEN( var_list(av) )
350	IF ( var_list(av)(i:i) == ';' ) num_var(av) = num_var(av) +1
351	ENDDO
352
353	!
354	!-- Extract the variable names from the list and inquire their
355	!-- NetCDF IDs
356	pos = INDEX( var_list(av), ';' )
357	!
358	!-- Loop over all variables
359	DO i = 1, num_var(av)
360
361	!
362	!-- Extract variable name from list
363	var_list(av) = var_list(av)(pos+1:)
364	pos = INDEX( var_list(av), ';' )
365	var_name = var_list(av)(1:pos-1)
366
367	!
368	!-- Get variable ID from name
369	nc_stat = NF90_INQ_VARID( id_set(av), TRIM( var_name ), &
370	id_var(av,i) )
371	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 4 )
372
373	!
374	!-- Get number of x/y/z levels for that variable
375	nc_stat = NF90_INQUIRE_VARIABLE( id_set(av), id_var(av,i), &
376	dimids = id_dims_loc )
377	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 5 )
378	id_dims(av,:) = id_dims_loc
379
380	!
381	!-- Inquire dimension ID
382	DO j = 1, 4
383	nc_stat = NF90_INQUIRE_DIMENSION( id_set(av), &
384	id_dims(av,j), dimname, levels(av,i) )
385	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 6 )
386
387	IF ( modus == 'XY' .AND. INDEX(dimname, 'z') /= 0 ) EXIT
388	IF ( modus == 'XZ' .AND. INDEX(dimname, 'y') /= 0 ) EXIT
389	IF ( modus == 'YZ' .AND. INDEX(dimname, 'x') /= 0 ) EXIT
390	ENDDO
391
392	ENDDO
393
394	ENDDO ! av = 0, 1
395
396	#endif
397	ENDIF
398
399	!
400	!-- Read the arrays, as long as the end of the file is reached
401	IF ( .NOT. netcdf_parallel ) THEN
402
403	fanz = 0
404	current_level = 1
405	current_var = 999999999
406
407	DO WHILE ( danz /= 0 )
408
409	!
410	!-- Loop over all files (reading data of the subdomains)
411	DO id = 0, danz-1
412	!
413	!-- File from PE0 contains special information at the beginning,
414	!-- concerning the lower and upper indices of the total-domain
415	!-- used in PALM (nxa, nxe, nya, nye).
416	!-- Allocate necessary arrays, open the output file and write
417	!-- the coordinate informations needed by ISO2D.
418	IF ( id == 0 .AND. fanz(0) == 0 .AND. fanz(1) == 0 ) THEN
419
420	READ ( id+110 ) nxa, nxe, nya, nye
421	ALLOCATE ( pf(nxa:nxe,nya:nye) )
422	!
423	!-- Set actual domain bounds to total domain
424	ya_do = nya
425	ye_do = nye
426
427	ENDIF
428	!
429	!-- Read output time
430	IF ( netcdf_output .AND. id == 0 ) THEN
431	READ ( id+110, END=998 ) simulated_time, time_step, av
432	ENDIF
433	!
434	!-- Read subdomain indices
435	READ ( id+110, END=998 ) xa, xe, ya, ye, ya_tot, ye_tot
436
437	!
438	!-- IF the PE made no output (in case that no part of the
439	!-- cross-section is situated on this PE), indices have the
440	!-- value -1
441	IF ( .NOT. ( xa == -1 .AND. xe == -1 .AND. &
442	ya == -1 .AND. ye == -1 ) ) THEN
443
444
445	!
446	!-- Read the subdomain grid-point values
447	ALLOCATE( pf_tmp(xa:xe,ya:ye) )
448	READ ( id+110 ) pf_tmp
449	!
450	!-- Calculate indices on atmospheric grid (e.g. for soil model
451	!-- quantities)
452	IF ( ya /= ya_tot .OR. ye /= ye_tot ) THEN
453	ye_do = ye - ya
454	ya_do = ya
455	pf(xa:xe,ya_do:ye_do) = pf_tmp
456	ELSE
457	ye_do = nye
458	ya_do = nya
459	pf(xa:xe,ya:ye) = pf_tmp
460	ENDIF
461
462	DEALLOCATE( pf_tmp )
463	ENDIF
464	IF ( id == 0 ) fanz(av) = fanz(av) + 1
465
466	ENDDO
467	!
468	!-- Write data in NetCDF format
469	IF ( netcdf_output ) THEN
470	#if defined( __netcdf )
471	!
472	!-- Check if a new time step has begun; if yes write data to
473	!-- time axis
474	IF ( current_var(av) > num_var(av) ) THEN
475	current_var(av) = 1
476	nc_stat = NF90_PUT_VAR( id_set(av), id_var_time(av), &
477	(/ simulated_time /), &
478	start = (/ time_step /), &
479	count = (/ 1 /) )
480	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 7 )
481	ENDIF
482
483	!
484	!-- Now write the data; this is mode dependent
485	SELECT CASE ( modus )
486
487	CASE ( 'XY' )
488	nc_stat = NF90_PUT_VAR( id_set(av), &
489	id_var(av,current_var(av)), &
490	pf(nxa:nxe,nya:nye), &
491	start = (/ 1, 1, current_level(av), time_step /), &
492	count = (/ nxe-nxa+1, nye-nya+1, 1, 1 /) )
493	IF ( nc_stat /= NF90_NOERR ) THEN
494	CALL handle_netcdf_error( 8 )
495	ENDIF
496
497	CASE ( 'XZ' )
498	nc_stat = NF90_PUT_VAR( id_set(av), &
499	id_var(av,current_var(av)), &
500	pf(nxa:nxe,ya_do:ye_do), &
501	start = (/ 1, current_level(av), 1, time_step /), &
502	count = (/ nxe-nxa+1, 1, ye_do-ya_do+1, 1 /) )
503	IF ( nc_stat /= NF90_NOERR ) THEN
504	CALL handle_netcdf_error( 9 )
505	ENDIF
506
507	CASE ( 'YZ' )
508	nc_stat = NF90_PUT_VAR( id_set(av), &
509	id_var(av,current_var(av)), &
510	pf(nxa:nxe,ya_do:ye_do), &
511	start = (/ current_level(av), 1, 1, time_step /), &
512	count = (/ 1, nxe-nxa+1, ye_do-ya_do+1, 1 /) )
513	IF ( nc_stat /= NF90_NOERR ) THEN
514	CALL handle_netcdf_error( 10 )
515	ENDIF
516
517	END SELECT
518
519	!
520	!-- Data is written, check if max level is reached
521	current_level(av) = current_level(av) + 1
522	IF ( current_level(av) > levels(av,current_var(av)) ) THEN
523	current_level(av) = 1
524	current_var(av) = current_var(av) + 1
525	ENDIF
526
527	#endif
528	ENDIF
529
530	ENDDO
531
532	ENDIF
533
534	998 IF ( danz /= 0 .AND. .NOT. netcdf_parallel ) THEN
535	!
536	!-- Print the number of the arrays processed
537	WRITE (*,'(16X,I4,A)') fanz(0)+fanz(1), ' array(s) processed'
538	IF ( fanz(1) /= 0 ) THEN
539	WRITE (*,'(16X,I4,A)') fanz(1), ' array(s) are time-averaged'
540	ENDIF
541
542	!
543	!-- Close all files and deallocate arrays
544	DO id = 0, danz-1
545	CLOSE ( id+110 )
546	ENDDO
547	CLOSE ( 2 )
548	DEALLOCATE ( pf )
549
550	!
551	!-- Close the NetCDF file
552	IF ( netcdf_output ) THEN
553	#if defined( __netcdf )
554	IF ( netcdf_0 ) THEN
555	nc_stat = NF90_CLOSE( id_set(0) )
556	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 11 )
557	ENDIF
558	IF ( netcdf_1 ) THEN
559	nc_stat = NF90_CLOSE( id_set(1) )
560	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 12 )
561	ENDIF
562	#endif
563	ENDIF
564	ENDIF
565
566	!
567	!-- Output required cpu time
568	IF ( danz /= 0 .AND. .NOT. netcdf_parallel ) THEN
569	CALL SYSTEM_CLOCK( count, count_rate )
570	cpu_end_time = REAL( count ) / REAL( count_rate )
571	WRITE (*,'(5X,A,F9.3,A)') 'Required cpu-time: ', &
572	cpu_end_time-cpu_start_time, ' sec'
573	ENDIF
574
575	!
576	!-- Choose the next cross-section
577	SELECT CASE ( modus )
578	CASE ( 'XY' )
579	modus = 'XZ'
580	CASE ( 'XZ' )
581	modus = 'YZ'
582	CASE ( 'YZ' )
583	modus = 'no'
584	END SELECT
585
586	ENDDO
587
588
589	!
590	!-- Combine the 3D-arrays
591	netcdf_parallel = .FALSE.
592
593	!
594	!-- Info-output
595	PRINT*, ' '
596
597	!
598	!-- Take current time
599	CALL SYSTEM_CLOCK( count, count_rate )
600	cpu_start_time = REAL( count ) / REAL( count_rate )
601
602	!
603	!-- Inquire whether a NetCDF file exists
604	INQUIRE( FILE='DATA_3D_NETCDF'//TRIM( model_string ), EXIST=netcdf_0 )
605
606	!
607	!-- Inquire whether a NetCDF file for time-averaged data exists
608	INQUIRE( FILE='DATA_3D_AV_NETCDF'//TRIM( model_string ), EXIST=netcdf_1 )
609
610	IF ( netcdf_0 .OR. netcdf_1 ) THEN
611	netcdf_output = .TRUE.
612	!
613	!-- Inquire whether the NetCDF file is already complete (parallel output)
614	INQUIRE( FILE='NO_COMBINE_PLOT_FIELDS_3D', EXIST=netcdf_parallel )
615	IF ( netcdf_parallel ) THEN
616	netcdf_parallel = .TRUE.
617	ELSE
618	netcdf_parallel = .FALSE.
619	ENDIF
620	ELSE
621	netcdf_output = .FALSE.
622	ENDIF
623
624	!
625	!-- Check, if file from PE0 exists; not neccessary in case of parallel
626	!-- PALM output
627	IF ( .NOT. netcdf_parallel ) THEN
628	danz = 0
629	WRITE (id_string,'(I6.6)') danz
630	INQUIRE ( &
631	FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM( id_string ), &
632	EXIST=found )
633	ELSE
634	found = .FALSE.
635	ENDIF
636
637	!
638	!-- Find out the number of files and open them
639	DO WHILE ( found )
640
641	OPEN ( danz+110, &
642	FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM(id_string), &
643	FORM='UNFORMATTED')
644	danz = danz + 1
645	WRITE (id_string,'(I6.6)') danz
646	INQUIRE ( &
647	FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM(id_string), &
648	EXIST=found )
649
650	ENDDO
651
652	#if defined( __netcdf )
653	IF ( netcdf_output ) THEN
654	IF ( netcdf_parallel ) THEN
655	PRINT*, ' NetCDF data are in one file (NetCDF4-format)', &
656	' - merging not neccessary'
657	ELSE
658	PRINT*, ' NetCDF output enabled'
659	ENDIF
660	ENDIF
661	#else
662	IF ( netcdf_output ) THEN
663	PRINT*, '--- Sorry, no NetCDF support on this host'
664	netcdf_output = .FALSE.
665	ENDIF
666	#endif
667	IF ( .NOT. netcdf_parallel ) THEN
668	IF ( danz /= 0 ) THEN
669	PRINT*, ' 3D-data: ', danz, ' file(s) found'
670	ELSE
671	PRINT*, ' no 3D-data file available'
672	ENDIF
673	ENDIF
674
675	IF ( netcdf_output .AND. .NOT. netcdf_parallel .AND. danz /= 0 ) THEN
676	#if defined( __netcdf )
677	DO av = 0, 1
678
679	IF ( av == 0 .AND. .NOT. netcdf_0 ) CYCLE
680	IF ( av == 1 .AND. .NOT. netcdf_1 ) CYCLE
681
682	!
683	!-- Open NetCDF dataset
684	IF ( av == 0 ) THEN
685	filename = 'DATA_3D_NETCDF'//TRIM( model_string )
686	ELSE
687	filename = 'DATA_3D_AV_NETCDF'//TRIM( model_string )
688	ENDIF
689	nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set(av) )
690	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 13 )
691
692
693	!
694	!-- Get the list of variables (order of variables corresponds with the
695	!-- order of data on the binary file)
696	var_list(av) = ' ' ! GET_ATT does not assign trailing blanks
697	nc_stat = NF90_GET_ATT( id_set(av), NF90_GLOBAL, 'VAR_LIST', &
698	var_list(av) )
699	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 14 )
700
701	!
702	!-- Inquire id of the time coordinate variable
703	nc_stat = NF90_INQ_VARID( id_set(av), 'time', id_var_time(av) )
704	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 15 )
705
706	!
707	!-- Count number of variables; there is one more semicolon in the
708	!-- string than variable names
709	num_var(av) = -1
710	DO i = 1, LEN( var_list(av) )
711	IF ( var_list(av)(i:i) == ';' ) num_var(av) = num_var(av) + 1
712	ENDDO
713
714	!
715	!-- Extract the variable names from the list and inquire their NetCDF
716	!-- IDs
717	pos = INDEX( var_list(av), ';' )
718	!
719	!-- Loop over all variables
720	DO i = 1, num_var(av)
721
722	!
723	!-- Extract variable name from list
724	var_list(av) = var_list(av)(pos+1:)
725	pos = INDEX( var_list(av), ';' )
726	var_name = var_list(av)(1:pos-1)
727
728	!
729	!-- Get variable ID from name
730	nc_stat = NF90_INQ_VARID( id_set(av), TRIM( var_name ), &
731	id_var(av,i) )
732	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 16 )
733
734	ENDDO
735
736	ENDDO ! av=0,1
737
738	#endif
739	ENDIF
740
741	!
742	!-- Read arrays, until the end of the file is reached
743	IF ( .NOT. netcdf_parallel ) THEN
744
745	current_var = 999999999
746	fanz = 0
747	DO WHILE ( danz /= 0 )
748
749	!
750	!-- Loop over all files
751	DO id = 0, danz-1
752	!
753	!-- File from PE0 contains at the beginning the index bounds
754	!-- of PALM's total domain.
755	!-- Allocate the array for storing the total domain data
756	IF ( id == 0 .AND. fanz(0) == 0 .AND. fanz(1) == 0 ) THEN
757	READ ( id+110 ) nxa, nxe, nya, nye, nza, nze
758	ALLOCATE ( pf3d(nxa:nxe,nya:nye,nza:nze) )
759	ENDIF
760
761	!
762	!-- Read output time
763	IF ( netcdf_output .AND. id == 0 ) THEN
764	IF ( netcdf_1 ) THEN
765	READ ( id+110, END=999 ) simulated_time, time_step, av
766	ELSE
767	!
768	!-- For compatibility with earlier PALM versions
769	READ ( id+110, END=999 ) simulated_time, time_step
770	av = 0
771	ENDIF
772	ENDIF
773
774	!
775	!-- Read subdomain indices and grid point values
776	READ ( id+110, END=999 ) xa, xe, ya, ye, za, ze
777	ALLOCATE( pf3d_tmp(xa:xe,ya:ye,za:ze) )
778	READ ( id+110 ) pf3d_tmp
779
780	xxa = MAX( nxa, xa )
781	xxe = MIN( nxe, xe )
782	yya = MAX( nya, ya )
783	yye = MIN( nye, ye )
784	DO k = za, ze
785	DO j = yya, yye
786	DO i = xxa, xxe
787	pf3d(i,j,k) = pf3d_tmp(i,j,k)
788	ENDDO
789	ENDDO
790	ENDDO
791
792	DEALLOCATE( pf3d_tmp )
793	IF ( id == 0 ) fanz(av) = fanz(av) + 1
794
795	ENDDO
796
797	!
798	!-- Write data of the total domain in NetCDF format
799	IF ( netcdf_output ) THEN
800	#if defined( __netcdf )
801	!
802	!-- Check if a new time step has begun; if yes write data to time
803	!-- axis
804	IF ( current_var(av) > num_var(av) ) THEN
805	current_var(av) = 1
806	nc_stat = NF90_PUT_VAR( id_set(av), id_var_time(av), &
807	(/ simulated_time /),&
808	start = (/ time_step /), count = (/ 1 /) )
809	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 17 )
810	ENDIF
811
812	!
813	!-- Now write the data
814	nc_stat = NF90_PUT_VAR( id_set(av), id_var(av,current_var(av)),&
815	pf3d(nxa:nxe,nya:nye,za:ze), start = (/ 1, 1, 1, time_step /),&
816	count = (/ nxe-nxa+1, nye-nya+1, ze-za+1, 1 /) )
817	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 18 )
818
819	current_var(av) = current_var(av) + 1
820
821	#endif
822	ENDIF
823
824	ENDDO
825
826	ENDIF
827
828	999 IF ( danz /= 0 .AND. .NOT. netcdf_parallel ) THEN
829	!
830	!-- Print the number of arrays processed
831	WRITE (*,'(16X,I4,A)') fanz(0)+fanz(1), ' array(s) processed'
832	IF ( fanz(1) /= 0 ) THEN
833	WRITE (*,'(16X,I4,A)') fanz(1), ' array(s) are time-averaged'
834	ENDIF
835	!
836	!-- Close all files and deallocate array
837	DO id = 0, danz-1
838	CLOSE ( id+110 )
839	ENDDO
840	CLOSE ( 2 )
841	DEALLOCATE ( pf3d )
842	!
843	!-- Close the NetCDF file
844	IF ( netcdf_output ) THEN
845	#if defined( __netcdf )
846	IF ( netcdf_0 ) THEN
847	nc_stat = NF90_CLOSE( id_set(0) )
848	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 19 )
849	ENDIF
850	IF ( netcdf_1 ) THEN
851	nc_stat = NF90_CLOSE( id_set(1) )
852	IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 20 )
853	ENDIF
854	#endif
855	ENDIF
856
857	!
858	!-- Output required cpu time
859	CALL SYSTEM_CLOCK( count, count_rate )
860	cpu_end_time = REAL( count ) / REAL( count_rate )
861	WRITE (*,'(5X,A,F9.3,A)') 'Required cpu-time: ', &
862	cpu_end_time-cpu_start_time, ' sec'
863
864	ENDIF
865
866	ENDDO ! models
867
868
869	CONTAINS
870
871
872	SUBROUTINE handle_netcdf_error( errno )
873	!
874	!-- Prints out a text message corresponding to the current NetCDF status
875
876	IMPLICIT NONE
877
878	INTEGER, INTENT(IN) :: errno
879
880	#if defined( __netcdf )
881	IF ( nc_stat /= NF90_NOERR ) THEN
882	PRINT*, '+++ combine_plot_fields netcdf: ', av, errno, &
883	TRIM( nf90_strerror( nc_stat ) )
884	ENDIF
885	#endif
886
887	END SUBROUTINE handle_netcdf_error
888
889
890	END PROGRAM combine_plot_fields
891
892
893

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |