Home

Context Navigation

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

Last change on this file since 2699 was 2696, checked in by kanani, 7 years ago
Merge of branch palm4u into trunk
Property svn:keywords set to `Id`
File size: 11.4 KB

Rev	Line
[2696]	1	!> @file src/inifor.f90
	2	!------------------------------------------------------------------------------!
	3	! This file is part of PALM/PALM-4U.
	4	!
	5	! PALM/PALM-4U is free software: you can redistribute it and/or modify it under
	6	! the 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.
	9	!
	10	! PALM/PALM-4U is distributed in the hope that it will be useful, but WITHOUT
	11	! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
	12	! FOR 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	!
	17	! Copyright 2017-2017 Leibniz Universitaet Hannover, Deutscher Wetterdienst
	18	! Offenbach
	19	!------------------------------------------------------------------------------!
	20	!
	21	! Current revisions:
	22	! -----------------
	23	!
	24	!
	25	! Former revisions:
	26	! -----------------
	27	! $Id: inifor.f90 2696 2017-12-14 17:12:51Z kanani $
	28	! Initial revision
	29	!
	30	!
	31	!
	32	! Authors:
	33	! --------
	34	! @author Eckhard Kadasch
	35	!
	36	! Description:
	37	! ------------
	38	!> INIFOR is an interpolation tool for generating meteorological initialization
	39	!> and forcing data for the urban climate model PALM-4U. The required
	40	!> meteorological fields are interpolated from output data of the mesoscale
	41	!> model COSMO-DE. This is the main program file.
	42	!------------------------------------------------------------------------------!
	43	PROGRAM inifor
	44
	45	USE control
	46	USE defs
	47	USE grid, &
	48	ONLY: setup_parameters, setup_grids, setup_variable_tables, &
	49	setup_io_groups, fini_grids, fini_variables, fini_io_groups, &
	50	fini_file_lists, preprocess, &
	51	output_file, io_group_list, output_var_table, &
	52	cosmo_grid, palm_grid, nx, ny, nz, ug, vg, p0, mode, &
	53	imin, imax, jmin, jmax
	54
	55	USE io
	56	USE transform, &
	57	ONLY: average_profile, average_2d, interpolate_2d, interpolate_3d
	58	USE types
	59
	60	IMPLICIT NONE
	61
	62	INTEGER :: igroup
	63	INTEGER :: ivar
	64	INTEGER :: iter
	65	REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr
	66	TYPE(nc_var), POINTER :: output_var
	67	TYPE(io_group), POINTER :: group
	68	TYPE(container), ALLOCATABLE :: input_buffer(:)
	69
	70	!> \mainpage About INIFOR
	71	!> ...
	72	!
	73	!------------------------------------------------------------------------------
	74	!- Section 1: Initialization
	75	!------------------------------------------------------------------------------
	76	CALL run_control('init', 'void')
	77
	78	! Initialize INIFOR's parameters from command-line interface and namelists
	79	CALL setup_parameters()
	80
	81	! Initialize all grids, including interpolation neighbours and weights
	82	CALL setup_grids()
	83	CALL run_control('time', 'init')
	84
	85	! Initialize the netCDF output file and define dimensions
	86	CALL setup_netcdf_dimensions(output_file, palm_grid)
	87	CALL run_control('time', 'write')
	88
	89	! Set up the tables containing the input and output variables and set
	90	! the corresponding netCDF dimensions for each output variable
	91	CALL setup_variable_tables(mode)
	92	CALL run_control('time', 'write')
	93
	94	! Add the output variables to the netCDF output file
	95	CALL setup_netcdf_variables(output_file % name, output_var_table)
	96
	97	CALL setup_io_groups()
	98	CALL run_control('time', 'init')
	99
	100	!------------------------------------------------------------------------------
	101	!- Section 2: Main loop
	102	!------------------------------------------------------------------------------
	103
	104	DO igroup = 1, SIZE(io_group_list)
	105
	106	group => io_group_list(igroup)
	107	IF ( group % to_be_processed ) THEN
	108
	109	DO iter = 1, group % nt
	110
	111	!------------------------------------------------------------------------------
	112	!- Section 2.1: Read and preprocess input data
	113	!------------------------------------------------------------------------------
	114	CALL read_input_variables(group, iter, input_buffer)
	115	CALL run_control('time', 'read')
	116
	117	CALL preprocess(group, input_buffer, cosmo_grid, iter)
	118	CALL run_control('time', 'comp')
	119
	120	IF ( .NOT. ALL(input_buffer(:) % is_preprocessed .AND. .TRUE.) ) THEN
	121	message = "Input buffers for group '" // TRIM(group % kind) // &
	122	"' could not be preprocessed sucessfully."
	123	CALL abort('main loop', message)
	124	END IF
	125
	126	!------------------------------------------------------------------------------
	127	!- Section 2.2: Interpolate each output variable of the group
	128	!------------------------------------------------------------------------------
	129	DO ivar = 1, group % nv
	130
	131	output_var => group % out_vars( ivar )
	132
	133	IF ( output_var % to_be_processed .AND. &
	134	iter .LE. output_var % nt ) THEN
	135
	136	message = "Processing '" // TRIM(output_var % name) // &
	137	"' (" // TRIM(output_var % kind) // &
	138	"), iteration " // TRIM(str(iter)) //" of " // &
	139	TRIM(str(output_var % nt))
	140	CALL report('main loop', message)
	141
	142	SELECT CASE( TRIM(output_var % task) )
	143
	144	CASE( 'interpolate_2d' )
	145
	146	SELECT CASE( TRIM(output_var % kind) )
	147
	148	CASE( 'init soil' )
	149
	150	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	151	0:output_var % grid % ny, &
	152	SIZE(output_var % grid % depths) ) )
	153
	154	CASE ( 'surface forcing' )
	155
	156	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	157	0:output_var % grid % ny, 1 ) )
	158
	159	CASE DEFAULT
	160
	161	CALL abort("main loop", 'Not a soil variable')
	162
	163	END SELECT
	164	CALL run_control('time', 'alloc')
	165
	166	CALL interpolate_2d(input_buffer(output_var % input_id) % array(:,:,:), &
	167	output_arr(:,:,:), output_var % intermediate_grid, output_var)
	168	CALL run_control('time', 'comp')
	169
	170
	171	CASE ( 'interpolate_3d' )
	172
	173	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	174	0:output_var % grid % ny, &
	175	0:output_var % grid % nz ) )
	176
	177	CALL run_control('time', 'alloc')
	178	CALL interpolate_3d( &
	179	input_buffer(output_var % input_id) % array(:,:,:), &
	180	output_arr(:,:,:), &
	181	output_var % intermediate_grid, &
	182	output_var % grid)
	183	CALL run_control('time', 'comp')
	184
	185	CASE ( 'average profile' )
	186
	187	ALLOCATE( output_arr( 0:output_var % grid % nx, &
	188	0:output_var % grid % ny, &
	189	0:output_var % grid % nz ) )
	190	CALL run_control('time', 'alloc')
	191
	192
	193	CALL average_profile( &
	194	input_buffer(output_var % input_id) % array(:,:,:), &
	195	output_arr(:,:,:), imin, imax, jmin, jmax, &
	196	output_var % intermediate_grid, &
	197	output_var % grid)
	198	CALL run_control('time', 'comp')
	199
	200	CASE ( 'average scalar' )
	201
	202	ALLOCATE( output_arr(1,1,1) )
	203	CALL run_control('time', 'alloc')
	204	output_arr(1,1,1) = p0
	205	CALL run_control('time', 'comp')
	206
	207	CASE ( 'profile' )
	208
	209	ALLOCATE( output_arr( 1, 1, 0:nz ) )
	210	CALL run_control('time', 'alloc')
	211
	212	SELECT CASE (TRIM(output_var % name))
	213
	214	CASE('ls_forcing_ug')
	215	output_arr(1, 1, :) = ug
	216
	217	CASE('ls_forcing_vg')
	218	output_arr(1, 1, :) = vg
	219
	220	CASE DEFAULT
	221	message = "'" // TRIM(output_var % name) // &
	222	"' is not a valid '" // TRIM(output_var % kind) //&
	223	"' variable kind."
	224	CALL abort('main loop', message)
	225	END SELECT
	226	CALL run_control('time', 'comp')
	227
	228	CASE DEFAULT
	229	message = "Processing task '" // TRIM(output_var % task) //&
	230	"' not recognized."
	231	CALL abort('', message)
	232
	233	END SELECT
	234	CALL run_control('time', 'comp')
	235
	236	!------------------------------------------------------------------------------
	237	!- Section 2.3: Write current time step of current variable
	238	!------------------------------------------------------------------------------
	239	message = "Writing variable '" // TRIM(output_var%name) // "'."
	240	CALL report('main loop', message)
	241	CALL update_output(output_var, output_arr, iter, output_file)
	242	CALL run_control('time', 'write')
	243
	244	DEALLOCATE(output_arr)
	245	CALL run_control('time', 'alloc')
	246
	247	END IF
	248
	249	END DO ! ouput variables
	250
	251	IF ( group % kind == 'running average' .OR. &
	252	group % kind == 'accumulated' ) THEN
	253	! Keep input buffer around for averaged (radiation) and
	254	! accumulated COSMO-DE quantities (precipitation).
	255	ELSE
	256	CALL report('main loop', 'Deallocating input buffer')
	257	DEALLOCATE(input_buffer)
	258	END IF
	259	CALL run_control('time', 'alloc')
	260
	261	END DO ! time steps / input files
	262
	263	IF (ALLOCATED(input_buffer)) THEN
	264	CALL report('main loop', 'Deallocating input buffer')
	265	DEALLOCATE(input_buffer)
	266	END IF
	267	CALL run_control('time', 'alloc')
	268
	269	ELSE
	270
	271	message = "Skipping IO group '" // TRIM(group % kind) // "'"
	272	IF ( ALLOCATED(group % in_var_list) ) THEN
	273	message = TRIM(message) // " with input variable '" // &
	274	TRIM(group % in_var_list(1) % name) // "'."
	275	END IF
	276
	277	CALL report('main loop', message)
	278
	279	END IF ! IO group % to_be_processed
	280
	281	END DO ! IO groups
	282
	283	!------------------------------------------------------------------------------
	284	!- Section 3: Clean up.
	285	!------------------------------------------------------------------------------
	286	CALL fini_file_lists()
	287	CALL fini_io_groups()
	288	CALL fini_variables()
	289	!CALL fini_grids()
	290	CALL run_control('time', 'alloc')
	291	CALL run_control('report', 'void')
	292
	293	message = "Finished writing forcing file '" // TRIM(output_file % name) // &
	294	"' successfully."
	295	CALL report('main loop', message)
	296
	297
	298	END PROGRAM inifor

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |