Home

Context Navigation

source: palm/trunk/SOURCE/data_output_3d.f90 @ 2209

Last change on this file since 2209 was 2209, checked in by kanani, 7 years ago
small bugfix, formatting and new PCM output
Property svn:keywords set to `Id`
File size: 25.3 KB

Rev	Line
[1682]	1	!> @file data_output_3d.f90
[2000]	2	!------------------------------------------------------------------------------!
[1036]	3	! This file is part of PALM.
	4	!
[2000]	5	! PALM is free software: you can redistribute it and/or modify it under the
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
[1036]	9	!
	10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
	11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
	12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
	13	!
	14	! You should have received a copy of the GNU General Public License along with
	15	! PALM. If not, see <http://www.gnu.org/licenses/>.
	16	!
[2101]	17	! Copyright 1997-2017 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[254]	20	! Current revisions:
[1106]	21	! ------------------
[2209]	22	! Added plant canopy model output
[1961]	23	!
[1552]	24	! Former revisions:
	25	! -----------------
	26	! $Id: data_output_3d.f90 2209 2017-04-19 09:34:46Z kanani $
	27	!
[2032]	28	! 2031 2016-10-21 15:11:58Z knoop
	29	! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
	30	!
[2012]	31	! 2011 2016-09-19 17:29:57Z kanani
	32	! Flag urban_surface is now defined in module control_parameters,
	33	! changed prefix for urban surface model output to "usm_",
	34	! introduced control parameter varnamelength for LEN of trimvar.
	35	!
[2008]	36	! 2007 2016-08-24 15:47:17Z kanani
	37	! Added support for new urban surface model (temporary modifications of
	38	! SELECT CASE ( ) necessary, see variable trimvar)
	39	!
[2001]	40	! 2000 2016-08-20 18:09:15Z knoop
	41	! Forced header and separation lines into 80 columns
	42	!
[1981]	43	! 1980 2016-07-29 15:51:57Z suehring
	44	! Bugfix, in order to steer user-defined output, setting flag found explicitly
	45	! to .F.
	46	!
[1977]	47	! 1976 2016-07-27 13:28:04Z maronga
	48	! Output of radiation quantities is now done directly in the respective module
	49	!
[1973]	50	! 1972 2016-07-26 07:52:02Z maronga
	51	! Output of land surface quantities is now done directly in the respective module.
	52	! Unnecessary directive __parallel removed.
	53	!
[1961]	54	! 1960 2016-07-12 16:34:24Z suehring
	55	! Scalar surface flux added
	56	!
[1851]	57	! 1849 2016-04-08 11:33:18Z hoffmann
	58	! prr moved to arrays_3d
	59	!
[1823]	60	! 1822 2016-04-07 07:49:42Z hoffmann
	61	! prr vertical dimensions set to nzb_do to nzt_do. Unused variables deleted.
	62	!
[1809]	63	! 1808 2016-04-05 19:44:00Z raasch
	64	! test output removed
	65	!
[1784]	66	! 1783 2016-03-06 18:36:17Z raasch
	67	! name change of netcdf routines and module + related changes
	68	!
[1746]	69	! 1745 2016-02-05 13:06:51Z gronemeier
	70	! Bugfix: test if time axis limit exceeds moved to point after call of check_open
	71	!
[1692]	72	! 1691 2015-10-26 16:17:44Z maronga
	73	! Added output of radiative heating rates for RRTMG
	74	!
[1683]	75	! 1682 2015-10-07 23:56:08Z knoop
	76	! Code annotations made doxygen readable
	77	!
[1586]	78	! 1585 2015-04-30 07:05:52Z maronga
	79	! Added support for RRTMG
	80	!
[1552]	81	! 1551 2015-03-03 14:18:16Z maronga
[1551]	82	! Added suppport for land surface model and radiation model output. In the course
	83	! of this action, the limits for vertical loops have been changed (from nzb and
	84	! nzt+1 to nzb_do and nzt_do, respectively in order to allow soil model output).
	85	! Moreover, a new vertical grid zs was introduced.
[1329]	86	!
[1360]	87	! 1359 2014-04-11 17:15:14Z hoffmann
	88	! New particle structure integrated.
	89	!
[1354]	90	! 1353 2014-04-08 15:21:23Z heinze
	91	! REAL constants provided with KIND-attribute
	92	!
[1329]	93	! 1327 2014-03-21 11:00:16Z raasch
	94	! parts concerning avs output removed,
	95	! -netcdf output queries
	96	!
[1321]	97	! 1320 2014-03-20 08:40:49Z raasch
[1320]	98	! ONLY-attribute added to USE-statements,
	99	! kind-parameters added to all INTEGER and REAL declaration statements,
	100	! kinds are defined in new module kinds,
	101	! old module precision_kind is removed,
	102	! revision history before 2012 removed,
	103	! comment fields (!:) to be used for variable explanations added to
	104	! all variable declaration statements
[674]	105	!
[1319]	106	! 1318 2014-03-17 13:35:16Z raasch
	107	! barrier argument removed from cpu_log,
	108	! module interfaces removed
	109	!
[1309]	110	! 1308 2014-03-13 14:58:42Z fricke
	111	! Check, if the limit of the time dimension is exceeded for parallel output
	112	! To increase the performance for parallel output, the following is done:
	113	! - Update of time axis is only done by PE0
	114	!
[1245]	115	! 1244 2013-10-31 08:16:56Z raasch
	116	! Bugfix for index bounds in case of 3d-parallel output
	117	!
[1116]	118	! 1115 2013-03-26 18:16:16Z hoffmann
	119	! ql is calculated by calc_liquid_water_content
	120	!
[1107]	121	! 1106 2013-03-04 05:31:38Z raasch
	122	! array_kind renamed precision_kind
	123	!
[1077]	124	! 1076 2012-12-05 08:30:18Z hoffmann
	125	! Bugfix in output of ql
	126	!
[1054]	127	! 1053 2012-11-13 17:11:03Z hoffmann
	128	! +nr, qr, prr, qc and averaged quantities
	129	!
[1037]	130	! 1036 2012-10-22 13:43:42Z raasch
	131	! code put under GPL (PALM 3.9)
	132	!
[1035]	133	! 1031 2012-10-19 14:35:30Z raasch
	134	! netCDF4 without parallel file support implemented
	135	!
[1008]	136	! 1007 2012-09-19 14:30:36Z franke
	137	! Bugfix: missing calculation of ql_vp added
	138	!
[1]	139	! Revision 1.1 1997/09/03 06:29:36 raasch
	140	! Initial revision
	141	!
	142	!
	143	! Description:
	144	! ------------
[1682]	145	!> Output of the 3D-arrays in netCDF and/or AVS format.
[1]	146	!------------------------------------------------------------------------------!
[1682]	147	SUBROUTINE data_output_3d( av )
	148
[1]	149
[1320]	150	USE arrays_3d, &
[2031]	151	ONLY: e, nr, p, pt, prr, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, tend, &
[1960]	152	u, v, vpt, w
[1320]	153
[1]	154	USE averaging
[1320]	155
	156	USE cloud_parameters, &
[1849]	157	ONLY: l_d_cp, pt_d_t
[1320]	158
	159	USE control_parameters, &
[1822]	160	ONLY: cloud_physics, do3d, do3d_no, do3d_time_count, io_blocks, &
	161	io_group, message_string, ntdim_3d, nz_do3d, psolver, &
[2011]	162	simulated_time, time_since_reference_point, urban_surface, &
	163	varnamelength
[1320]	164
	165	USE cpulog, &
	166	ONLY: log_point, cpu_log
	167
	168	USE indices, &
[1822]	169	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb
[1320]	170
	171	USE kinds
	172
[1551]	173	USE land_surface_model_mod, &
[1972]	174	ONLY: land_surface, lsm_data_output_3d, nzb_soil, nzt_soil
[1551]	175
[1783]	176	#if defined( __netcdf )
	177	USE NETCDF
	178	#endif
	179
	180	USE netcdf_interface, &
	181	ONLY: id_set_3d, id_var_do3d, id_var_time_3d, nc_stat, &
	182	netcdf_data_format, netcdf_handle_error
[1320]	183
	184	USE particle_attributes, &
[1359]	185	ONLY: grid_particles, number_of_particles, particles, &
	186	particle_advection_start, prt_count
[1320]	187
[1]	188	USE pegrid
	189
[2209]	190	USE plant_canopy_model_mod, &
	191	ONLY: pcm_data_output_3d, plant_canopy
	192
[1585]	193	USE radiation_model_mod, &
[1976]	194	ONLY: radiation, radiation_data_output_3d
[1585]	195
[2007]	196	USE urban_surface_mod, &
[2011]	197	ONLY: nzub, nzut, usm_data_output_3d
[1585]	198
[2007]	199
[1]	200	IMPLICIT NONE
	201
[1682]	202	INTEGER(iwp) :: av !<
	203	INTEGER(iwp) :: i !<
	204	INTEGER(iwp) :: if !<
	205	INTEGER(iwp) :: j !<
	206	INTEGER(iwp) :: k !<
	207	INTEGER(iwp) :: n !<
	208	INTEGER(iwp) :: nzb_do !< vertical lower limit for data output
	209	INTEGER(iwp) :: nzt_do !< vertical upper limit for data output
[1]	210
[1682]	211	LOGICAL :: found !<
	212	LOGICAL :: resorted !<
[1]	213
[1682]	214	REAL(wp) :: mean_r !<
	215	REAL(wp) :: s_r2 !<
	216	REAL(wp) :: s_r3 !<
[1]	217
[1682]	218	REAL(sp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !<
[1]	219
[1682]	220	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !<
[1]	221
[2011]	222	CHARACTER (LEN=varnamelength) :: trimvar !< TRIM of output-variable string
[2007]	223
[1]	224	!
	225	!-- Return, if nothing to output
	226	IF ( do3d_no(av) == 0 ) RETURN
	227
	228	CALL cpu_log (log_point(14),'data_output_3d','start')
	229
	230	!
	231	!-- Open output file.
	232	!-- Also creates coordinate and fld-file for AVS.
[1031]	233	!-- For classic or 64bit netCDF output or output of other (old) data formats,
[493]	234	!-- for a run on more than one PE, each PE opens its own file and
[1]	235	!-- writes the data of its subdomain in binary format (regardless of the format
	236	!-- the user has requested). After the run, these files are combined to one
	237	!-- file by combine_plot_fields in the format requested by the user (netcdf
[493]	238	!-- and/or avs).
[1031]	239	!-- For netCDF4/HDF5 output, data is written in parallel into one file.
[1327]	240	IF ( netcdf_data_format < 5 ) THEN
	241	CALL check_open( 30 )
	242	IF ( myid == 0 ) CALL check_open( 106+av*10 )
[493]	243	ELSE
[1327]	244	CALL check_open( 106+av*10 )
[493]	245	ENDIF
[1]	246
	247	!
[1745]	248	!-- For parallel netcdf output the time axis must be limited. Return, if this
	249	!-- limit is exceeded. This could be the case, if the simulated time exceeds
	250	!-- the given end time by the length of the given output interval.
	251	IF ( netcdf_data_format > 4 ) THEN
	252	IF ( do3d_time_count(av) + 1 > ntdim_3d(av) ) THEN
	253	WRITE ( message_string, * ) 'Output of 3d data is not given at t=', &
	254	simulated_time, '&because the maximum ', &
	255	'number of output time levels is ', &
	256	'exceeded.'
	257	CALL message( 'data_output_3d', 'PA0387', 0, 1, 0, 6, 0 )
	258	CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
	259	RETURN
	260	ENDIF
	261	ENDIF
	262
	263	!
[1031]	264	!-- Update the netCDF time axis
[1308]	265	!-- In case of parallel output, this is only done by PE0 to increase the
	266	!-- performance.
[1]	267	#if defined( __netcdf )
[1308]	268	do3d_time_count(av) = do3d_time_count(av) + 1
	269	IF ( myid == 0 ) THEN
[1327]	270	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
	271	(/ time_since_reference_point /), &
	272	start = (/ do3d_time_count(av) /), &
	273	count = (/ 1 /) )
[1783]	274	CALL netcdf_handle_error( 'data_output_3d', 376 )
[1]	275	ENDIF
	276	#endif
	277
	278	!
	279	!-- Loop over all variables to be written.
	280	if = 1
	281
	282	DO WHILE ( do3d(av,if)(1:1) /= ' ' )
[2007]	283
[1]	284	!
[2007]	285	!-- Temporary solution to account for data output within the new urban
	286	!-- surface model (urban_surface_mod.f90), see also SELECT CASE ( trimvar ).
[1]	287	!-- Store the array chosen on the temporary array.
[2007]	288	trimvar = TRIM( do3d(av,if) )
[2011]	289	IF ( urban_surface .AND. trimvar(1:4) == 'usm_' ) THEN
[2007]	290	trimvar = 'usm_output'
	291	resorted = .TRUE.
	292	nzb_do = nzub
	293	nzt_do = nzut
	294	ELSE
	295	resorted = .FALSE.
	296	nzb_do = nzb
	297	nzt_do = nz_do3d
	298	ENDIF
[1551]	299	!
[1980]	300	!-- Set flag to steer output of radiation, land-surface, or user-defined
	301	!-- quantities
	302	found = .FALSE.
	303	!
[1551]	304	!-- Allocate a temporary array with the desired output dimensions.
	305	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
	306
[2007]	307	SELECT CASE ( trimvar )
[1]	308
	309	CASE ( 'e' )
	310	IF ( av == 0 ) THEN
	311	to_be_resorted => e
	312	ELSE
	313	to_be_resorted => e_av
	314	ENDIF
	315
[771]	316	CASE ( 'lpt' )
	317	IF ( av == 0 ) THEN
	318	to_be_resorted => pt
	319	ELSE
	320	to_be_resorted => lpt_av
	321	ENDIF
	322
[1053]	323	CASE ( 'nr' )
	324	IF ( av == 0 ) THEN
	325	to_be_resorted => nr
	326	ELSE
	327	to_be_resorted => nr_av
	328	ENDIF
	329
[1]	330	CASE ( 'p' )
	331	IF ( av == 0 ) THEN
[727]	332	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
[1]	333	to_be_resorted => p
	334	ELSE
[727]	335	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
[1]	336	to_be_resorted => p_av
	337	ENDIF
	338
	339	CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
	340	IF ( av == 0 ) THEN
[1359]	341	IF ( simulated_time >= particle_advection_start ) THEN
	342	tend = prt_count
	343	CALL exchange_horiz( tend, nbgp )
	344	ELSE
	345	tend = 0.0_wp
	346	ENDIF
[667]	347	DO i = nxlg, nxrg
	348	DO j = nysg, nyng
[1551]	349	DO k = nzb_do, nzt_do
[1]	350	local_pf(i,j,k) = tend(k,j,i)
	351	ENDDO
	352	ENDDO
	353	ENDDO
	354	resorted = .TRUE.
	355	ELSE
[667]	356	CALL exchange_horiz( pc_av, nbgp )
[1]	357	to_be_resorted => pc_av
	358	ENDIF
	359
[1359]	360	CASE ( 'pr' ) ! mean particle radius (effective radius)
[1]	361	IF ( av == 0 ) THEN
[1359]	362	IF ( simulated_time >= particle_advection_start ) THEN
	363	DO i = nxl, nxr
	364	DO j = nys, nyn
[1551]	365	DO k = nzb_do, nzt_do
[1359]	366	number_of_particles = prt_count(k,j,i)
	367	IF (number_of_particles <= 0) CYCLE
	368	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	369	s_r2 = 0.0_wp
	370	s_r3 = 0.0_wp
	371	DO n = 1, number_of_particles
	372	IF ( particles(n)%particle_mask ) THEN
	373	s_r2 = s_r2 + particles(n)%radius*2 &
	374	particles(n)%weight_factor
	375	s_r3 = s_r3 + particles(n)%radius*3 &
	376	particles(n)%weight_factor
	377	ENDIF
	378	ENDDO
	379	IF ( s_r2 > 0.0_wp ) THEN
	380	mean_r = s_r3 / s_r2
	381	ELSE
	382	mean_r = 0.0_wp
	383	ENDIF
	384	tend(k,j,i) = mean_r
[1]	385	ENDDO
	386	ENDDO
	387	ENDDO
[1359]	388	CALL exchange_horiz( tend, nbgp )
	389	ELSE
	390	tend = 0.0_wp
	391	ENDIF
[667]	392	DO i = nxlg, nxrg
	393	DO j = nysg, nyng
[1551]	394	DO k = nzb_do, nzt_do
[1]	395	local_pf(i,j,k) = tend(k,j,i)
	396	ENDDO
	397	ENDDO
	398	ENDDO
	399	resorted = .TRUE.
	400	ELSE
[667]	401	CALL exchange_horiz( pr_av, nbgp )
[1]	402	to_be_resorted => pr_av
	403	ENDIF
	404
[1053]	405	CASE ( 'prr' )
	406	IF ( av == 0 ) THEN
	407	CALL exchange_horiz( prr, nbgp )
	408	DO i = nxlg, nxrg
	409	DO j = nysg, nyng
[1822]	410	DO k = nzb_do, nzt_do
[1053]	411	local_pf(i,j,k) = prr(k,j,i)
	412	ENDDO
	413	ENDDO
	414	ENDDO
	415	ELSE
	416	CALL exchange_horiz( prr_av, nbgp )
	417	DO i = nxlg, nxrg
	418	DO j = nysg, nyng
[1822]	419	DO k = nzb_do, nzt_do
[1053]	420	local_pf(i,j,k) = prr_av(k,j,i)
	421	ENDDO
	422	ENDDO
	423	ENDDO
	424	ENDIF
	425	resorted = .TRUE.
	426
[1]	427	CASE ( 'pt' )
	428	IF ( av == 0 ) THEN
	429	IF ( .NOT. cloud_physics ) THEN
	430	to_be_resorted => pt
	431	ELSE
[667]	432	DO i = nxlg, nxrg
	433	DO j = nysg, nyng
[1551]	434	DO k = nzb_do, nzt_do
[1320]	435	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
	436	pt_d_t(k) * &
[1]	437	ql(k,j,i)
	438	ENDDO
	439	ENDDO
	440	ENDDO
	441	resorted = .TRUE.
	442	ENDIF
	443	ELSE
	444	to_be_resorted => pt_av
	445	ENDIF
	446
	447	CASE ( 'q' )
	448	IF ( av == 0 ) THEN
	449	to_be_resorted => q
	450	ELSE
	451	to_be_resorted => q_av
	452	ENDIF
[691]	453
[1053]	454	CASE ( 'qc' )
[1]	455	IF ( av == 0 ) THEN
[1115]	456	to_be_resorted => qc
[1]	457	ELSE
[1115]	458	to_be_resorted => qc_av
[1]	459	ENDIF
	460
[1053]	461	CASE ( 'ql' )
	462	IF ( av == 0 ) THEN
[1115]	463	to_be_resorted => ql
[1053]	464	ELSE
[1115]	465	to_be_resorted => ql_av
[1053]	466	ENDIF
	467
[1]	468	CASE ( 'ql_c' )
	469	IF ( av == 0 ) THEN
	470	to_be_resorted => ql_c
	471	ELSE
	472	to_be_resorted => ql_c_av
	473	ENDIF
	474
	475	CASE ( 'ql_v' )
	476	IF ( av == 0 ) THEN
	477	to_be_resorted => ql_v
	478	ELSE
	479	to_be_resorted => ql_v_av
	480	ENDIF
	481
	482	CASE ( 'ql_vp' )
	483	IF ( av == 0 ) THEN
[1359]	484	IF ( simulated_time >= particle_advection_start ) THEN
	485	DO i = nxl, nxr
	486	DO j = nys, nyn
[1551]	487	DO k = nzb_do, nzt_do
[1359]	488	number_of_particles = prt_count(k,j,i)
	489	IF (number_of_particles <= 0) CYCLE
	490	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	491	DO n = 1, number_of_particles
	492	IF ( particles(n)%particle_mask ) THEN
	493	tend(k,j,i) = tend(k,j,i) + &
	494	particles(n)%weight_factor / &
	495	prt_count(k,j,i)
	496	ENDIF
	497	ENDDO
[1007]	498	ENDDO
	499	ENDDO
	500	ENDDO
[1359]	501	CALL exchange_horiz( tend, nbgp )
	502	ELSE
	503	tend = 0.0_wp
	504	ENDIF
[1007]	505	DO i = nxlg, nxrg
	506	DO j = nysg, nyng
[1551]	507	DO k = nzb_do, nzt_do
[1007]	508	local_pf(i,j,k) = tend(k,j,i)
	509	ENDDO
	510	ENDDO
	511	ENDDO
	512	resorted = .TRUE.
[1]	513	ELSE
[1007]	514	CALL exchange_horiz( ql_vp_av, nbgp )
[1]	515	to_be_resorted => ql_vp_av
	516	ENDIF
	517
[1053]	518	CASE ( 'qr' )
	519	IF ( av == 0 ) THEN
	520	to_be_resorted => qr
	521	ELSE
	522	to_be_resorted => qr_av
	523	ENDIF
	524
[1]	525	CASE ( 'qv' )
	526	IF ( av == 0 ) THEN
[667]	527	DO i = nxlg, nxrg
	528	DO j = nysg, nyng
[1551]	529	DO k = nzb_do, nzt_do
[1]	530	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
	531	ENDDO
	532	ENDDO
	533	ENDDO
	534	resorted = .TRUE.
	535	ELSE
	536	to_be_resorted => qv_av
	537	ENDIF
	538
[2031]	539	CASE ( 'rho_ocean' )
[96]	540	IF ( av == 0 ) THEN
[2031]	541	to_be_resorted => rho_ocean
[96]	542	ELSE
[2031]	543	to_be_resorted => rho_ocean_av
[96]	544	ENDIF
[691]	545
[1]	546	CASE ( 's' )
	547	IF ( av == 0 ) THEN
[1960]	548	to_be_resorted => s
[1]	549	ELSE
[355]	550	to_be_resorted => s_av
[1]	551	ENDIF
[691]	552
[96]	553	CASE ( 'sa' )
	554	IF ( av == 0 ) THEN
	555	to_be_resorted => sa
	556	ELSE
	557	to_be_resorted => sa_av
	558	ENDIF
[691]	559
[1]	560	CASE ( 'u' )
	561	IF ( av == 0 ) THEN
	562	to_be_resorted => u
	563	ELSE
	564	to_be_resorted => u_av
	565	ENDIF
	566
	567	CASE ( 'v' )
	568	IF ( av == 0 ) THEN
	569	to_be_resorted => v
	570	ELSE
	571	to_be_resorted => v_av
	572	ENDIF
	573
	574	CASE ( 'vpt' )
	575	IF ( av == 0 ) THEN
	576	to_be_resorted => vpt
	577	ELSE
	578	to_be_resorted => vpt_av
	579	ENDIF
	580
	581	CASE ( 'w' )
	582	IF ( av == 0 ) THEN
	583	to_be_resorted => w
	584	ELSE
	585	to_be_resorted => w_av
	586	ENDIF
[2007]	587	!
	588	!-- Block of urban surface model outputs
	589	CASE ( 'usm_output' )
	590	CALL usm_data_output_3d( av, do3d(av,if), found, local_pf, &
	591	nzb_do, nzt_do )
[1]	592
	593	CASE DEFAULT
[1972]	594
[1]	595	!
[1972]	596	!-- Land surface quantity
	597	IF ( land_surface ) THEN
	598	!
	599	!-- For soil model quantities, it is required to re-allocate local_pf
	600	nzb_do = nzb_soil
	601	nzt_do = nzt_soil
	602
	603	DEALLOCATE ( local_pf )
	604	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
	605
	606	CALL lsm_data_output_3d( av, do3d(av,if), found, local_pf )
	607	resorted = .TRUE.
[1976]	608
	609	!
	610	!-- If no soil model variable was found, re-allocate local_pf
	611	IF ( .NOT. found ) THEN
	612	nzb_do = nzb
	613	nzt_do = nz_do3d
	614
	615	DEALLOCATE ( local_pf )
	616	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb_do:nzt_do) )
	617	ENDIF
	618
[1972]	619	ENDIF
	620
	621	!
[1976]	622	!-- Radiation quantity
	623	IF ( .NOT. found .AND. radiation ) THEN
	624	CALL radiation_data_output_3d( av, do3d(av,if), found, &
	625	local_pf )
	626	resorted = .TRUE.
	627	ENDIF
	628
	629	!
[2209]	630	!-- Plant canopy model output
	631	IF ( .NOT. found .AND. plant_canopy ) THEN
	632	CALL pcm_data_output_3d( av, do3d(av,if), found, &
	633	local_pf )
	634	resorted = .TRUE.
	635	ENDIF
	636
	637	!
[1]	638	!-- User defined quantity
[1972]	639	IF ( .NOT. found ) THEN
	640	CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
	641	nzb_do, nzt_do )
	642	resorted = .TRUE.
	643	ENDIF
[1]	644
[254]	645	IF ( .NOT. found ) THEN
[1320]	646	message_string = 'no output available for: ' // &
[274]	647	TRIM( do3d(av,if) )
[254]	648	CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 )
[1]	649	ENDIF
	650
	651	END SELECT
	652
	653	!
	654	!-- Resort the array to be output, if not done above
	655	IF ( .NOT. resorted ) THEN
[667]	656	DO i = nxlg, nxrg
	657	DO j = nysg, nyng
[1551]	658	DO k = nzb_do, nzt_do
[1]	659	local_pf(i,j,k) = to_be_resorted(k,j,i)
	660	ENDDO
	661	ENDDO
	662	ENDDO
	663	ENDIF
	664
	665	!
[1327]	666	!-- Output of the 3D-array
	667	#if defined( __parallel )
	668	IF ( netcdf_data_format < 5 ) THEN
[1]	669	!
[1327]	670	!-- Non-parallel netCDF output. Data is output in parallel in
	671	!-- FORTRAN binary format here, and later collected into one file by
	672	!-- combine_plot_fields
	673	IF ( myid == 0 ) THEN
	674	WRITE ( 30 ) time_since_reference_point, &
	675	do3d_time_count(av), av
[1]	676	ENDIF
[1327]	677	DO i = 0, io_blocks-1
	678	IF ( i == io_group ) THEN
[1551]	679	WRITE ( 30 ) nxlg, nxrg, nysg, nyng, nzb_do, nzt_do
	680	WRITE ( 30 ) local_pf(:,:,nzb_do:nzt_do)
[1327]	681	ENDIF
[1972]	682
[1327]	683	CALL MPI_BARRIER( comm2d, ierr )
[1972]	684
[1327]	685	ENDDO
[559]	686
[1327]	687	ELSE
[646]	688	#if defined( __netcdf )
[493]	689	!
[1327]	690	!-- Parallel output in netCDF4/HDF5 format.
	691	!-- Do not output redundant ghost point data except for the
	692	!-- boundaries of the total domain.
	693	IF ( nxr == nx .AND. nyn /= ny ) THEN
	694	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	695	local_pf(nxl:nxr+1,nys:nyn,nzb_do:nzt_do), &
	696	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	697	count = (/ nxr-nxl+2, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
[1327]	698	ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
	699	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	700	local_pf(nxl:nxr,nys:nyn+1,nzb_do:nzt_do), &
	701	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	702	count = (/ nxr-nxl+1, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
[1327]	703	ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
	704	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	705	local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do ), &
	706	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	707	count = (/ nxr-nxl+2, nyn-nys+2, nzt_do-nzb_do+1, 1 /) )
[1327]	708	ELSE
	709	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	710	local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do), &
	711	start = (/ nxl+1, nys+1, nzb_do+1, do3d_time_count(av) /), &
	712	count = (/ nxr-nxl+1, nyn-nys+1, nzt_do-nzb_do+1, 1 /) )
[1327]	713	ENDIF
[1783]	714	CALL netcdf_handle_error( 'data_output_3d', 386 )
[646]	715	#endif
[1327]	716	ENDIF
[1]	717	#else
	718	#if defined( __netcdf )
[1327]	719	nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
[1551]	720	local_pf(nxl:nxr+1,nys:nyn+1,nzb_do:nzt_do), &
[1327]	721	start = (/ 1, 1, 1, do3d_time_count(av) /), &
[1551]	722	count = (/ nx+2, ny+2, nzt_do-nzb_do+1, 1 /) )
[1783]	723	CALL netcdf_handle_error( 'data_output_3d', 446 )
[1]	724	#endif
	725	#endif
	726
	727	if = if + 1
	728
	729	!
[1551]	730	!-- Deallocate temporary array
	731	DEALLOCATE ( local_pf )
[1]	732
[1551]	733	ENDDO
[1]	734
[1318]	735	CALL cpu_log( log_point(14), 'data_output_3d', 'stop' )
[1]	736
	737	!
	738	!-- Formats.
[1320]	739	3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &
[1]	740	'label = ',A,A)
	741
	742	END SUBROUTINE data_output_3d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |