Home

Context Navigation

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

Last change on this file since 115 was 114, checked in by raasch, 17 years ago
preliminary updates for implementing buildings in poismg
Property svn:keywords set to `Id`
File size: 25.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |