Home

Context Navigation

source: palm/trunk/UTIL/inifor/src/inifor.f90 @ 3494

Last change on this file since 3494 was 3456, checked in by eckhard, 6 years ago
inifor: Removed surface forcing and internal arrays from netCDF output
Property svn:keywords set to `Id`
File size: 21.0 KB

Rev	Line
[2696]	1	!> @file src/inifor.f90
	2	!------------------------------------------------------------------------------!
[2718]	3	! This file is part of the PALM model system.
[2696]	4	!
[2718]	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
[2696]	8	! version.
	9	!
[2718]	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.
[2696]	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	!
[2718]	17	! Copyright 2017-2018 Leibniz Universitaet Hannover
	18	! Copyright 2017-2018 Deutscher Wetterdienst Offenbach
[2696]	19	!------------------------------------------------------------------------------!
	20	!
	21	! Current revisions:
	22	! -----------------
[3183]	23	!
	24	!
	25	! Former revisions:
	26	! -----------------
	27	! $Id: inifor.f90 3456 2018-10-30 14:29:54Z suehring $
[3456]	28	! NetCDf output of internal arrays only with --debug option
	29	!
	30	!
	31	! 3401 2018-10-23 09:33:31Z eckhard
[3401]	32	! Re-compute geostrophic winds every time step
	33	!
	34	! 3395 2018-10-22 17:32:49Z eckhard
[3395]	35	! Added main loop support for computation of geostrophic winds and surface
	36	! pressure
	37	! Cleaned up terminal output, show some meVssages only with --debug option
	38	!
	39	! 3183 2018-07-27 14:25:55Z suehring
[3182]	40	! Introduced new PALM grid stretching
	41	! Renamend initial-condition mode variable 'mode' to 'ic_mode'
	42	! Improved log messages
[2696]	43	!
	44	!
[3183]	45	! 3182 2018-07-27 13:36:03Z suehring
[2696]	46	! Initial revision
	47	!
	48	!
	49	!
	50	! Authors:
	51	! --------
	52	! @author Eckhard Kadasch
	53	!
	54	! Description:
	55	! ------------
	56	!> INIFOR is an interpolation tool for generating meteorological initialization
	57	!> and forcing data for the urban climate model PALM-4U. The required
	58	!> meteorological fields are interpolated from output data of the mesoscale
	59	!> model COSMO-DE. This is the main program file.
	60	!------------------------------------------------------------------------------!
	61	PROGRAM inifor
	62
	63	USE control
	64	USE defs
	65	USE grid, &
	66	ONLY: setup_parameters, setup_grids, setup_variable_tables, &
	67	setup_io_groups, fini_grids, fini_variables, fini_io_groups, &
[3182]	68	fini_file_lists, preprocess, origin_lon, origin_lat, &
[2696]	69	output_file, io_group_list, output_var_table, &
[3395]	70	cosmo_grid, palm_grid, nx, ny, nz, p0, cfg, f3, &
	71	averaging_width_ns, averaging_width_ew, phi_n, lambda_n, &
	72	lam_centre, phi_centre
[2696]	73	USE io
	74	USE transform, &
[3395]	75	ONLY: average_profile, interpolate_2d, interpolate_3d, &
	76	geostrophic_winds, extrapolate_density, extrapolate_pressure, &
	77	get_surface_pressure
[2696]	78	USE types
	79
	80	IMPLICIT NONE
	81
	82	INTEGER :: igroup
	83	INTEGER :: ivar
	84	INTEGER :: iter
	85	REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr
[3395]	86	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_centre
	87	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: ug_arr
	88	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: vg_arr
	89	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_north
	90	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_south
	91	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_east
	92	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: rho_west
	93	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_north
	94	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_south
	95	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_east
	96	REAL(dp), ALLOCATABLE, DIMENSION(:), TARGET :: p_west
	97	REAL(dp), POINTER, DIMENSION(:) :: internal_arr
	98	REAL(dp), POINTER, DIMENSION(:) :: ug_vg_arr
[2696]	99	TYPE(nc_var), POINTER :: output_var
	100	TYPE(io_group), POINTER :: group
	101	TYPE(container), ALLOCATABLE :: input_buffer(:)
[3395]	102	LOGICAL, SAVE :: ug_vg_have_been_computed = .FALSE.
	103	LOGICAL, SAVE :: debugging_output = .TRUE.
[2696]	104
	105	!> \mainpage About INIFOR
	106	!> ...
	107	!
	108	!------------------------------------------------------------------------------
	109	!- Section 1: Initialization
	110	!------------------------------------------------------------------------------
	111	CALL run_control('init', 'void')
	112
	113	! Initialize INIFOR's parameters from command-line interface and namelists
	114	CALL setup_parameters()
	115
	116	! Initialize all grids, including interpolation neighbours and weights
	117	CALL setup_grids()
	118	CALL run_control('time', 'init')
	119
	120	! Initialize the netCDF output file and define dimensions
[3182]	121	CALL setup_netcdf_dimensions(output_file, palm_grid, cfg % start_date, &
	122	origin_lon, origin_lat)
[2696]	123	CALL run_control('time', 'write')
	124
	125	! Set up the tables containing the input and output variables and set
	126	! the corresponding netCDF dimensions for each output variable
[3182]	127	CALL setup_variable_tables(cfg % ic_mode)
[2696]	128	CALL run_control('time', 'write')
	129
	130	! Add the output variables to the netCDF output file
[3456]	131	CALL setup_netcdf_variables(output_file % name, output_var_table, &
	132	cfg % debug)
[2696]	133
[3182]	134	CALL setup_io_groups()
[2696]	135	CALL run_control('time', 'init')
	136
	137	!------------------------------------------------------------------------------
	138	!- Section 2: Main loop
	139	!------------------------------------------------------------------------------
	140
	141	DO igroup = 1, SIZE(io_group_list)
	142
	143	group => io_group_list(igroup)
	144	IF ( group % to_be_processed ) THEN
	145
	146	DO iter = 1, group % nt
	147
	148	!------------------------------------------------------------------------------
	149	!- Section 2.1: Read and preprocess input data
	150	!------------------------------------------------------------------------------
	151	CALL read_input_variables(group, iter, input_buffer)
	152	CALL run_control('time', 'read')
	153
	154	CALL preprocess(group, input_buffer, cosmo_grid, iter)
	155	CALL run_control('time', 'comp')
	156
[3182]	157	!TODO: move this assertion into 'preprocess'.
[2696]	158	IF ( .NOT. ALL(input_buffer(:) % is_preprocessed .AND. .TRUE.) ) THEN
	159	message = "Input buffers for group '" // TRIM(group % kind) // &
	160	"' could not be preprocessed sucessfully."
	161	CALL abort('main loop', message)
	162	END IF
	163
	164	!------------------------------------------------------------------------------
	165	!- Section 2.2: Interpolate each output variable of the group
	166	!------------------------------------------------------------------------------
	167	DO ivar = 1, group % nv
	168
	169	output_var => group % out_vars( ivar )
	170
	171	IF ( output_var % to_be_processed .AND. &
	172	iter .LE. output_var % nt ) THEN
	173
	174	message = "Processing '" // TRIM(output_var % name) // &
	175	"' (" // TRIM(output_var % kind) // &
	176	"), iteration " // TRIM(str(iter)) //" of " // &
	177	TRIM(str(output_var % nt))
	178	CALL report('main loop', message)
	179
	180	SELECT CASE( TRIM(output_var % task) )
	181
	182	CASE( 'interpolate_2d' )
	183
	184	SELECT CASE( TRIM(output_var % kind) )
	185
	186	CASE( 'init soil' )
	187
	188	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	189	0:output_var % grid % ny, &
	190	SIZE(output_var % grid % depths) ) )
	191
	192	CASE ( 'surface forcing' )
	193
	194	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	195	0:output_var % grid % ny, 1 ) )
	196
	197	CASE DEFAULT
	198
[3182]	199	message = "'" // TRIM(output_var % kind) // "' is not a soil variable"
	200	CALL abort("main loop", message)
[2696]	201
	202	END SELECT
	203	CALL run_control('time', 'alloc')
	204
	205	CALL interpolate_2d(input_buffer(output_var % input_id) % array(:,:,:), &
	206	output_arr(:,:,:), output_var % intermediate_grid, output_var)
	207	CALL run_control('time', 'comp')
	208
	209
	210	CASE ( 'interpolate_3d' )
	211
	212	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	213	0:output_var % grid % ny, &
[3182]	214	1:output_var % grid % nz ) )
[2696]	215
	216	CALL run_control('time', 'alloc')
	217	CALL interpolate_3d( &
	218	input_buffer(output_var % input_id) % array(:,:,:), &
	219	output_arr(:,:,:), &
	220	output_var % intermediate_grid, &
	221	output_var % grid)
	222	CALL run_control('time', 'comp')
	223
	224	CASE ( 'average profile' )
	225
	226	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	227	0:output_var % grid % ny, &
[3182]	228	1:output_var % grid % nz ) )
[2696]	229	CALL run_control('time', 'alloc')
	230
	231	CALL average_profile( &
	232	input_buffer(output_var % input_id) % array(:,:,:), &
[3395]	233	output_arr(0,0,:), &
	234	output_var % averaging_grid)
	235
	236	IF ( TRIM(output_var % name) == &
	237	'surface_forcing_surface_pressure' ) THEN
	238
	239	IF ( cfg % p0_is_set ) THEN
	240	output_arr(0,0,1) = p0
	241	ELSE
	242	CALL get_surface_pressure( &
	243	output_arr(0,0,:), rho_centre, &
	244	output_var % averaging_grid)
	245	END IF
	246
	247	END IF
[2696]	248	CALL run_control('time', 'comp')
	249
[3395]	250	CASE ( 'internal profile' )
	251
	252	message = "Averaging of internal profile for variable '" //&
	253	TRIM(output_var % name) // "' is not supported."
	254
	255	SELECT CASE (TRIM(output_var % name))
	256
	257	CASE('internal_density_centre')
	258	ALLOCATE( rho_centre( 1:output_var % grid % nz ) )
	259	internal_arr => rho_centre
	260
	261	CASE('internal_density_north')
	262	ALLOCATE( rho_north( 1:output_var % grid % nz ) )
	263	internal_arr => rho_north
	264
	265	CASE('internal_density_south')
	266	ALLOCATE( rho_south( 1:output_var % grid % nz ) )
	267	internal_arr => rho_south
	268
	269	CASE('internal_density_east')
	270	ALLOCATE( rho_east( 1:output_var % grid % nz) )
	271	internal_arr => rho_east
	272
	273	CASE('internal_density_west')
	274	ALLOCATE( rho_west( 1:output_var % grid % nz ) )
	275	internal_arr => rho_west
	276
	277	CASE('internal_pressure_north')
	278	ALLOCATE( p_north( 1:output_var % grid % nz ) )
	279	internal_arr => p_north
	280
	281	CASE('internal_pressure_south')
	282	ALLOCATE( p_south( 1:output_var % grid % nz ) )
	283	internal_arr => p_south
	284
	285	CASE('internal_pressure_east')
	286	ALLOCATE( p_east( 1:output_var % grid % nz) )
	287	internal_arr => p_east
	288
	289	CASE('internal_pressure_west')
	290	ALLOCATE( p_west( 1:output_var % grid % nz ) )
	291	internal_arr => p_west
	292
	293	CASE DEFAULT
	294	CALL abort('main loop', message)
	295
	296	END SELECT
	297	CALL run_control('time', 'alloc')
	298
	299
	300	CALL average_profile( &
	301	input_buffer(output_var % input_id) % array(:,:,:),&
	302	internal_arr(:), &
	303	output_var % averaging_grid)
	304
	305	SELECT CASE (TRIM(output_var % name))
	306
	307	CASE('internal_density_centre', &
	308	'internal_density_north', &
	309	'internal_density_south', &
	310	'internal_density_east', &
	311	'internal_density_west')
	312	CALL extrapolate_density(internal_arr, &
	313	output_var % averaging_grid)
	314
	315	CASE('internal_pressure_north')
	316	CALL extrapolate_pressure(internal_arr, rho_north, &
	317	output_var % averaging_grid)
	318
	319	CASE('internal_pressure_south')
	320	CALL extrapolate_pressure(internal_arr, rho_south, &
	321	output_var % averaging_grid)
	322
	323	CASE('internal_pressure_east')
	324	CALL extrapolate_pressure(internal_arr, rho_east, &
	325	output_var % averaging_grid)
	326
	327	CASE('internal_pressure_west')
	328	CALL extrapolate_pressure(internal_arr, rho_west, &
	329	output_var % averaging_grid)
	330
	331	CASE DEFAULT
	332	CALL abort('main loop', message)
	333
	334	END SELECT
	335
	336	IF (.TRUE.) THEN
	337	ALLOCATE( output_arr(1,1,1:output_var % grid % nz) )
	338	output_arr(1,1,:) = internal_arr(:)
	339	END IF
	340	CALL run_control('time', 'comp')
	341
	342
	343	! This case gets called twice, the first time for ug, the
	344	! second time for vg. We compute ug and vg at the first call
	345	! and keep vg (and ug for that matter) around for the second
	346	! call.
	347	CASE ( 'geostrophic winds' )
	348
	349	IF (.NOT. ug_vg_have_been_computed ) THEN
	350	ALLOCATE( ug_arr(output_var % grid % nz) )
	351	ALLOCATE( vg_arr(output_var % grid % nz) )
	352
	353	IF ( cfg % ug_is_set ) THEN
	354	ug_arr = cfg % ug
	355	vg_arr = cfg % vg
	356	ELSE
	357	CALL geostrophic_winds( p_north, p_south, p_east, &
	358	p_west, rho_centre, f3, &
	359	averaging_width_ew, &
	360	averaging_width_ns, &
	361	phi_n, lambda_n, phi_centre, lam_centre, &
	362	ug_arr, vg_arr )
	363	END IF
	364
	365	ug_vg_have_been_computed = .TRUE.
	366
	367	END IF
	368
	369	! Prepare output of geostrophic winds
	370	SELECT CASE(TRIM(output_var % name))
	371	CASE ('ls_forcing_ug')
	372	ug_vg_arr => ug_arr
	373	CASE ('ls_forcing_vg')
	374	ug_vg_arr => vg_arr
	375	END SELECT
	376
	377	ALLOCATE( output_arr(1,1,output_var % grid % nz) )
	378	output_arr(1,1,:) = ug_vg_arr(:)
	379
[2696]	380	CASE ( 'average scalar' )
	381
	382	ALLOCATE( output_arr(1,1,1) )
	383	CALL run_control('time', 'alloc')
	384	output_arr(1,1,1) = p0
	385	CALL run_control('time', 'comp')
	386
[3182]	387	CASE ( 'set profile' )
[2696]	388
[3182]	389	ALLOCATE( output_arr( 1, 1, 1:nz ) )
[2696]	390	CALL run_control('time', 'alloc')
	391
	392	SELECT CASE (TRIM(output_var % name))
	393
[3395]	394	!CASE('ls_forcing_ug')
	395	! output_arr(1, 1, :) = ug
[2696]	396
[3395]	397	!CASE('ls_forcing_vg')
	398	! output_arr(1, 1, :) = vg
[2696]	399
[3182]	400	CASE('nudging_tau')
	401	output_arr(1, 1, :) = NUDGING_TAU
	402
[2696]	403	CASE DEFAULT
	404	message = "'" // TRIM(output_var % name) // &
	405	"' is not a valid '" // TRIM(output_var % kind) //&
	406	"' variable kind."
	407	CALL abort('main loop', message)
	408	END SELECT
	409	CALL run_control('time', 'comp')
	410
[3182]	411	CASE('average large-scale profile')
	412	message = "Averaging of large-scale forcing profiles " //&
	413	"has not been implemented, yet."
	414	CALL abort('main loop', message)
	415	!ALLOCATE( output_arr( 1, 1, 1:nz ) )
	416
[2696]	417	CASE DEFAULT
	418	message = "Processing task '" // TRIM(output_var % task) //&
	419	"' not recognized."
	420	CALL abort('', message)
	421
	422	END SELECT
	423	CALL run_control('time', 'comp')
	424
	425	!------------------------------------------------------------------------------
	426	!- Section 2.3: Write current time step of current variable
	427	!------------------------------------------------------------------------------
[3395]	428	IF (.NOT. output_var % is_internal .OR. debugging_output) THEN
	429	message = "Writing variable '" // TRIM(output_var%name) // "'."
	430	CALL report('main loop', message)
[3456]	431	CALL update_output(output_var, output_arr, iter, &
	432	output_file, cfg)
[2696]	433	CALL run_control('time', 'write')
[3395]	434	END IF
[2696]	435
[3395]	436	IF (ALLOCATED(output_arr)) DEALLOCATE(output_arr)
[2696]	437	CALL run_control('time', 'alloc')
	438
	439	END IF
	440
	441	END DO ! ouput variables
	442
[3401]	443	ug_vg_have_been_computed = .FALSE.
[3395]	444	IF ( group % kind == 'thermodynamics' ) THEN
	445	DEALLOCATE( rho_centre )
[3401]	446	DEALLOCATE( ug_arr )
	447	DEALLOCATE( vg_arr )
[3395]	448	IF ( .NOT. cfg % ug_is_set ) THEN
	449	DEALLOCATE( rho_north )
	450	DEALLOCATE( rho_south )
	451	DEALLOCATE( rho_east )
	452	DEALLOCATE( rho_west )
	453	DEALLOCATE( p_north )
	454	DEALLOCATE( p_south )
	455	DEALLOCATE( p_east )
	456	DEALLOCATE( p_west )
	457	END IF
	458	END IF
	459
[2696]	460	IF ( group % kind == 'running average' .OR. &
	461	group % kind == 'accumulated' ) THEN
	462	! Keep input buffer around for averaged (radiation) and
	463	! accumulated COSMO-DE quantities (precipitation).
	464	ELSE
[3395]	465	CALL report('main loop', 'Deallocating input buffer', cfg % debug)
[2696]	466	DEALLOCATE(input_buffer)
	467	END IF
	468	CALL run_control('time', 'alloc')
	469
	470	END DO ! time steps / input files
	471
	472	IF (ALLOCATED(input_buffer)) THEN
[3395]	473	CALL report('main loop', 'Deallocating input buffer', cfg % debug)
[2696]	474	DEALLOCATE(input_buffer)
	475	END IF
	476	CALL run_control('time', 'alloc')
	477
	478	ELSE
	479
[3182]	480	message = "Skipping IO group " // TRIM(str(igroup)) // " '" // TRIM(group % kind) // "'"
[2696]	481	IF ( ALLOCATED(group % in_var_list) ) THEN
	482	message = TRIM(message) // " with input variable '" // &
	483	TRIM(group % in_var_list(1) % name) // "'."
	484	END IF
	485
[3395]	486	CALL report('main loop', message, cfg % debug)
[2696]	487
	488	END IF ! IO group % to_be_processed
	489
	490	END DO ! IO groups
	491
	492	!------------------------------------------------------------------------------
	493	!- Section 3: Clean up.
	494	!------------------------------------------------------------------------------
	495	CALL fini_file_lists()
	496	CALL fini_io_groups()
	497	CALL fini_variables()
	498	!CALL fini_grids()
	499	CALL run_control('time', 'alloc')
	500	CALL run_control('report', 'void')
	501
[3182]	502	message = "Finished writing dynamic driver '" // TRIM(output_file % name) // &
[2696]	503	"' successfully."
	504	CALL report('main loop', message)
	505
	506
	507	END PROGRAM inifor

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |