Home

Context Navigation

source: palm/trunk/SOURCE/chemistry_model_mod.f90 @ 3137

Last change on this file since 3137 was 3045, checked in by Giersch, 7 years ago
Code adjusted according to coding standards, renamed namelists, error messages revised until PA0347, output CASE 108 disabled
Property svn:keywords set to `Id`
File size: 75.0 KB

Rev	Line
[2657]	1	!> @file chemistry_model_mod.f90
	2	!------------------------------------------------------------------------------!
[2696]	3	! This file is part of the PALM model system.
[2657]	4	!
	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.
	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	!
[2718]	17	! Copyright 1997-2018 Leibniz Universitaet Hannover
	18	! Copyright 2017-2018 Karlsruhe Institute of Technology
	19	! Copyright 2017-2018 Freie Universitaet Berlin
[2657]	20	!------------------------------------------------------------------------------!
	21	!
	22	! Current revisions:
	23	! -----------------
	24	!
[2696]	25	!
[2657]	26	! Former revisions:
	27	! -----------------
[2696]	28	! $Id: chemistry_model_mod.f90 3045 2018-05-28 07:55:41Z maronga $
[3045]	29	! error messages revised
	30	!
	31	! 3014 2018-05-09 08:42:38Z maronga
[3014]	32	! Bugfix: nzb_do and nzt_do were not used for 3d data output
	33	!
	34	! 3004 2018-04-27 12:33:25Z Giersch
[3004]	35	! Comment concerning averaged data output added
	36	!
	37	! 2932 2018-03-26 09:39:22Z maronga
[2932]	38	! renamed chemistry_par to chemistry_parameters
	39	!
	40	! 2894 2018-03-15 09:17:58Z Giersch
[2894]	41	! Calculations of the index range of the subdomain on file which overlaps with
	42	! the current subdomain are already done in read_restart_data_mod,
	43	! chem_last_actions was renamed to chem_wrd_local, chem_read_restart_data was
	44	! renamed to chem_rrd_local, chem_write_var_list was renamed to
	45	! chem_wrd_global, chem_read_var_list was renamed to chem_rrd_global,
	46	! chem_skip_var_list has been removed, variable named found has been
	47	! introduced for checking if restart data was found, reading of restart strings
	48	! has been moved completely to read_restart_data_mod, chem_rrd_local is already
	49	! inside the overlap loop programmed in read_restart_data_mod, todo list has
	50	! bees extended, redundant characters in chem_wrd_local have been removed,
	51	! the marker * end chemistry * is not necessary anymore, strings and their
	52	! respective lengths are written out and read now in case of restart runs to
	53	! get rid of prescribed character lengths
	54	!
	55	! 2815 2018-02-19 11:29:57Z suehring
[2815]	56	! Bugfix in restart mechanism,
	57	! rename chem_tendency to chem_prognostic_equations,
	58	! implement vector-optimized version of chem_prognostic_equations,
	59	! some clean up (incl. todo list)
	60	!
	61	! 2773 2018-01-30 14:12:54Z suehring
[2773]	62	! Declare variables required for nesting as public
	63	!
	64	! 2772 2018-01-29 13:10:35Z suehring
[2772]	65	! Bugfix in string handling
	66	!
	67	! 2768 2018-01-24 15:38:29Z kanani
[2768]	68	! Shorten lines to maximum length of 132 characters
	69	!
	70	! 2766 2018-01-22 17:17:47Z kanani
[2766]	71	! Removed preprocessor directive __chem
	72	!
	73	! 2756 2018-01-16 18:11:14Z suehring
[2756]	74	! Fill values in 3D output introduced.
	75	!
	76	! 2718 2018-01-02 08:49:38Z maronga
[2696]	77	! Initial revision
	78	!
[2657]	79	!
[2696]	80	!
	81	!
	82	! Authors:
	83	! --------
	84	! @author Renate Forkel
	85	! @author Farah Kanani-Suehring
	86	! @author Klaus Ketelsen
	87	! @author Basit Khan
	88	!
	89	!
[2657]	90	!------------------------------------------------------------------------------!
	91	! Description:
	92	! ------------
	93	!> Chemistry model for PALM-4U
[2894]	94	!> @todo Adjust chem_rrd_local to CASE structure of others modules. It is not
	95	!> allowed to use the chemistry model in a precursor run and additionally
	96	!> not using it in a main run
[2668]	97	!> @todo Update/clean-up todo list! (FK)
	98	!> @todo Set proper fill values (/= 0) for chem output arrays! (FK)
	99	!> @todo Add routine chem_check_parameters, add checks for inconsistent or
[2815]	100	!> unallowed parameter settings.
	101	!> CALL of chem_check_parameters from check_parameters. (FK)
[2668]	102	!> @todo Make routine chem_header available, CALL from header.f90
	103	!> (see e.g. how it is done in routine lsm_header in
	104	!> land_surface_model_mod.f90). chem_header should include all setup
	105	!> info about chemistry parameter settings. (FK)
[2657]	106	!> @todo Implement turbulent inflow of chem spcs in inflow_turbulence.
	107	!> @todo Separate boundary conditions for each chem spcs to be implemented
	108	!> @todo Currently only total concentration are calculated. Resolved, parameterized
	109	!> and chemistry fluxes although partially and some completely coded but
	110	!> are not operational/activated in this version. bK.
	111	!> @todo slight differences in passive scalar and chem spcs when chem reactions
	112	!> turned off. Need to be fixed. bK
[2815]	113	!> @todo test nesting for chem spcs, was implemented by suehring (kanani)
[2657]	114	!> @todo subroutine set_const_initial_values to be taken out from chemistry_model_mod !bK.
	115	!> @todo chemistry error messages
	116	!> @todo Format this module according to PALM coding standard (see e.g. module
	117	!> template under http://palm.muk.uni-hannover.de/mosaik/downloads/8 or
	118	!> D3_coding_standard.pdf under https://palm.muk.uni-hannover.de/trac/downloads/16)
	119	!
	120	!------------------------------------------------------------------------------!
	121
	122	MODULE chemistry_model_mod
[2766]	123
[2657]	124	USE kinds, ONLY: wp, iwp
	125	USE indices, ONLY: nz, nzb,nzt,nysg,nyng,nxlg,nxrg,nys,nyn
	126	USE pegrid, ONLY: myid, threads_per_task
	127	USE control_parameters, ONLY: dt_3d, ws_scheme_sca, initializing_actions, message_string, &
	128	omega, tsc, intermediate_timestep_count, &
	129	intermediate_timestep_count_max, &
	130	timestep_scheme, use_prescribed_profile_data
	131	USE arrays_3d, ONLY: hyp, pt, rdf_sc, tend, zu
	132	USE chem_gasphase_mod, ONLY: nspec, spc_names, nkppctrl, nmaxfixsteps, &
	133	t_steps, fill_temp, chem_gasphase_integrate, &
	134	nvar, atol, rtol, nphot, phot_names
	135	USE cpulog, ONLY: cpu_log, log_point
	136
	137	USE chem_modules
	138
	139
	140	IMPLICIT NONE
	141	PRIVATE
	142	SAVE
	143
	144	!- Define chemical variables
	145
	146	TYPE species_def
	147	CHARACTER(LEN=8) :: name
	148	CHARACTER(LEN=16) :: unit
	149	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: conc
	150	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: conc_av
	151	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: conc_p
	152	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: tconc_m
	153	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:) :: cssws_av
	154	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:) :: flux_s_cs
	155	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:) :: diss_s_cs
	156	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:) :: flux_l_cs
	157	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:) :: diss_l_cs
	158	REAL(kind=wp),ALLOCATABLE,DIMENSION(:) :: conc_pr_init
	159	END TYPE species_def
	160
	161
	162	TYPE photols_def
	163	CHARACTER(LEN=8) :: name
	164	CHARACTER(LEN=16) :: unit
	165	REAL(kind=wp),POINTER,DIMENSION(:,:,:) :: freq
	166	END TYPE photols_def
	167
	168
	169	PUBLIC species_def
	170	PUBLIC photols_def
	171
	172
	173	TYPE(species_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC :: chem_species
	174	TYPE(photols_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC :: phot_frequen
	175
	176	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET :: spec_conc_1
	177	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET :: spec_conc_2
	178	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET :: spec_conc_3
	179	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET :: spec_conc_av
	180	REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET :: freq_1
	181
	182	INTEGER,DIMENSION(nkppctrl) :: icntrl ! Fine tuning kpp
	183	REAL(kind=wp),DIMENSION(nkppctrl) :: rcntrl ! Fine tuning kpp
	184
	185	CHARACTER(10), PUBLIC :: photolysis_scheme
	186	! 'constant',
	187	! 'simple' (Simple parameterisation from MCM, Saunders et al., 2003, Atmos. Chem. Phys., 3, 161-180
	188	! 'fastj' (Wild et al., 2000, J. Atmos. Chem., 37, 245-282) STILL NOT IMPLEMENTED
	189
	190	PUBLIC nspec
	191	PUBLIC nvar
[2773]	192	PUBLIC spc_names
	193	PUBLIC spec_conc_2
[2657]	194
	195	!- Interface section
	196	INTERFACE chem_boundary_conds
	197	MODULE PROCEDURE chem_boundary_conds
	198	END INTERFACE chem_boundary_conds
	199
	200	INTERFACE chem_init
	201	MODULE PROCEDURE chem_init
	202	END INTERFACE chem_init
	203
	204	INTERFACE chem_init_profiles
	205	MODULE PROCEDURE chem_init_profiles
[2682]	206	END INTERFACE chem_init_profiles
[2657]	207
	208	INTERFACE chem_parin
	209	MODULE PROCEDURE chem_parin
	210	END INTERFACE chem_parin
	211
	212	INTERFACE chem_integrate
	213	MODULE PROCEDURE chem_integrate_ij
	214	END INTERFACE chem_integrate
	215
	216	INTERFACE chem_swap_timelevel
	217	MODULE PROCEDURE chem_swap_timelevel
	218	END INTERFACE chem_swap_timelevel
	219
	220	INTERFACE chem_define_netcdf_grid
	221	MODULE PROCEDURE chem_define_netcdf_grid
	222	END INTERFACE chem_define_netcdf_grid
	223
	224	INTERFACE chem_data_output_3d
	225	MODULE PROCEDURE chem_data_output_3d
	226	END INTERFACE chem_data_output_3d
	227
	228	INTERFACE chem_check_data_output
	229	MODULE PROCEDURE chem_check_data_output
	230	END INTERFACE chem_check_data_output
	231
	232	INTERFACE chem_check_data_output_pr
	233	MODULE PROCEDURE chem_check_data_output_pr
	234	END INTERFACE chem_check_data_output_pr
	235
	236	INTERFACE chem_3d_data_averaging
	237	MODULE PROCEDURE chem_3d_data_averaging
	238	END INTERFACE chem_3d_data_averaging
	239
[2894]	240	INTERFACE chem_wrd_local
	241	MODULE PROCEDURE chem_wrd_local
	242	END INTERFACE chem_wrd_local
[2657]	243
[2894]	244	INTERFACE chem_rrd_local
	245	MODULE PROCEDURE chem_rrd_local
	246	END INTERFACE chem_rrd_local
[2657]	247
[2815]	248	INTERFACE chem_prognostic_equations
	249	MODULE PROCEDURE chem_prognostic_equations
	250	MODULE PROCEDURE chem_prognostic_equations_ij
	251	END INTERFACE chem_prognostic_equations
[2657]	252
	253	INTERFACE chem_header
	254	MODULE PROCEDURE chem_header
	255	END INTERFACE chem_header
	256
[2668]	257	INTERFACE chem_emissions
	258	MODULE PROCEDURE chem_emissions
	259	END INTERFACE chem_emissions
[2657]	260
[2894]	261	! INTERFACE chem_wrd_global
	262	! MODULE PROCEDURE chem_wrd_global
	263	! END INTERFACE chem_wrd_global
[2668]	264	!
[2894]	265	! INTERFACE chem_rrd_global
	266	! MODULE PROCEDURE chem_rrd_global
	267	! END INTERFACE chem_rrd_global
[2657]	268
	269
[2815]	270	PUBLIC chem_3d_data_averaging, chem_boundary_conds, chem_check_data_output, &
[2657]	271	chem_check_data_output_pr, chem_data_output_3d, &
[2815]	272	chem_define_netcdf_grid, chem_emissions, chem_header, chem_init, &
[2894]	273	chem_init_profiles, chem_integrate, chem_wrd_local, &
[2815]	274	chem_parin, chem_prognostic_equations, &
[2894]	275	chem_rrd_local, chem_swap_timelevel
[2815]	276
[2657]	277
	278	CONTAINS
	279
	280	!------------------------------------------------------------------------------!
	281	!
	282	! Description:
	283	! ------------
	284	!> Subroutine to initialize and set all boundary conditions for chemical species
	285	!------------------------------------------------------------------------------!
	286
	287	SUBROUTINE chem_boundary_conds( mode )
	288
	289	USE control_parameters, &
	290	ONLY: air_chemistry, outflow_l, outflow_n, outflow_r, outflow_s
	291	USE indices, &
	292	ONLY: nxl, nxr, nxlg, nxrg, nyng, nysg, nzt
	293
	294	! USE prognostic_equations_mod, &
	295
	296	USE arrays_3d, &
	297	ONLY: dzu
	298	USE surface_mod, &
	299	ONLY: bc_h
	300
	301	CHARACTER (len=*), INTENT(IN) :: mode
	302	INTEGER(iwp) :: i !< grid index x direction.
	303	INTEGER(iwp) :: j !< grid index y direction.
	304	INTEGER(iwp) :: k !< grid index z direction.
	305	INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on facing.
	306	INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls.
	307	INTEGER(iwp) :: m !< running index surface elements.
	308	INTEGER(iwp) :: lsp !< running index for chem spcs.
	309	INTEGER(iwp) :: lph !< running index for photolysis frequencies
	310
	311
	312	SELECT CASE ( TRIM( mode ) )
	313	CASE ( 'init' )
	314	DO lsp = 1, nspec
	315	IF ( surface_csflux(lsp) == 9999999.9_wp ) THEN
	316	constant_csflux(lsp) = .FALSE.
	317	ENDIF
	318	ENDDO
	319
	320	IF ( bc_cs_b == 'dirichlet' ) THEN
	321	ibc_cs_b = 0
	322	ELSEIF ( bc_cs_b == 'neumann' ) THEN
	323	ibc_cs_b = 1
	324	ELSE
	325	! message_string = 'unknown boundary condition: bc_cs_b ="' // TRIM( bc_cs_b ) // '"' ! bK commented
[2815]	326	CALL message( 'chem_boundary_conds', 'CM0010', 1, 2, 0, 6, 0 ) !< chemistry_model_mod should have special error numbers --> "CHEM###",
[2657]	327	ENDIF
	328	!
	329	!-- Set Integer flags and check for possible erroneous settings for top
	330	!-- boundary condition. bK added _cs_ here.
	331	IF ( bc_cs_t == 'dirichlet' ) THEN
	332	ibc_cs_t = 0
	333	ELSEIF ( bc_cs_t == 'neumann' ) THEN
	334	ibc_cs_t = 1
	335	ELSEIF ( bc_cs_t == 'initial_gradient' ) THEN
	336	ibc_cs_t = 2
	337	ELSEIF ( bc_cs_t == 'nested' ) THEN
	338	ibc_cs_t = 3
	339	ELSE
	340	! message_string = 'unknown boundary condition: bc_c_t ="' // TRIM( bc_cs_t ) // '"'
[2815]	341	CALL message( 'check_parameters', 'CM0011', 1, 2, 0, 6, 0 )
[2657]	342	ENDIF
	343
	344
	345	CASE ( 'set_bc_bottomtop' )
	346	!-- Bottom boundary condtions for chemical species
	347	DO lsp = 1, nspec
	348	IF ( ibc_cs_b == 0 ) THEN
	349	DO l = 0, 1
	350	!-- Set index kb: For upward-facing surfaces (l=0), kb=-1, i.e.
	351	!-- the chem_species(nsp)%conc_p value at the topography top (k-1)
	352	!-- is set; for downward-facing surfaces (l=1), kb=1, i.e. the
	353	!-- value at the topography bottom (k+1) is set.
	354
	355	kb = MERGE( -1, 1, l == 0 )
	356	!$OMP PARALLEL DO PRIVATE( i, j, k )
	357	DO m = 1, bc_h(l)%ns
	358	i = bc_h(l)%i(m)
	359	j = bc_h(l)%j(m)
	360	k = bc_h(l)%k(m)
	361	chem_species(lsp)%conc_p(k+kb,j,i) = chem_species(lsp)%conc(k+kb,j,i)
	362	ENDDO
	363	ENDDO
	364
	365	ELSEIF ( ibc_cs_b == 1 ) THEN
	366	! in boundary_conds there is som extra loop over m here for passive tracer
	367	DO l = 0, 1
	368	kb = MERGE( -1, 1, l == 0 )
	369	!$OMP PARALLEL DO PRIVATE( i, j, k )
	370	DO m = 1, bc_h(l)%ns
	371	i = bc_h(l)%i(m)
	372	j = bc_h(l)%j(m)
	373	k = bc_h(l)%k(m)
	374	chem_species(lsp)%conc_p(k+kb,j,i) = chem_species(lsp)%conc_p(k,j,i)
	375
	376	!< @todo: chem_species(nsp)%conc_p(k+kb,j,i) = chem_species(nsp)%conc(k+kb,j,i), &
	377	!< pls loop over nsp=1, NSPEC.
	378	!< @todo: We should also think about the possibility to have &
	379	!< individual boundary conditions for each species? This means, bc_cs_b, &
	380	!< bc_cs_t, ibc_cs_b, ibc_cs_t would need to be added to TYPE chem_species(nsp)%, &
	381	!< and the loop over nsp would have to be put outside of this IF-clause.
	382	!< i think its better we keep the same bonundary cond i.e. dirichlet or neumann
	383	!< for all chem spcs. ... !bK
	384
	385	ENDDO
	386	ENDDO
	387	ENDIF
	388	ENDDO ! end lsp loop
	389
	390	!-- Top boundary conditions for chemical species - Should this not be done for all species?
	391	IF ( ibc_cs_t == 0 ) THEN
	392	DO lsp = 1, nspec
	393	chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc(nzt+1,:,:)
	394	ENDDO
	395	ELSEIF ( ibc_cs_t == 1 ) THEN
	396	DO lsp = 1, nspec
[2678]	397	chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:)
[2657]	398	ENDDO
	399	ELSEIF ( ibc_cs_t == 2 ) THEN
	400	DO lsp = 1, nspec
[2678]	401	chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:) + bc_cs_t_val(lsp) * dzu(nzt+1)
[2657]	402	ENDDO
	403	!@todo: bc_cs_t_val needs to be calculated,
	404	!see bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1)
	405	!(in time_integration). pt_init would be the counterpart to
	406	!chem_species(i)%conc_pr_init (see kchem_driver_FKa1408.f90 of my
	407	!"Hints: prescribing initial concentration.
	408	ENDIF
	409	!
	410	CASE ( 'set_bc_lateral' ) ! bK commented it
	411	!-- Lateral boundary conditions for chem species at inflow boundary
	412	!-- are automatically set when chem_species concentration is
	413	!-- initialized. The initially set value at the inflow boundary is not
	414	!-- touched during time integration, hence, this boundary value remains
	415	!-- at a constant value, which is the concentration that flows into the
	416	!-- domain.
	417	!-- Lateral boundary conditions for chem species at outflow boundary
	418
	419	IF ( outflow_s ) THEN
	420	DO lsp = 1, nspec
	421	chem_species(lsp)%conc_p(:,nys-1,:) = chem_species(lsp)%conc_p(:,nys,:)
	422	ENDDO
	423	ELSEIF ( outflow_n ) THEN
	424	DO lsp = 1, nspec
	425	chem_species(lsp)%conc_p(:,nyn+1,:) = chem_species(lsp)%conc_p(:,nyn,:)
	426	ENDDO
	427	ELSEIF ( outflow_l ) THEN
	428	DO lsp = 1, nspec
	429	chem_species(lsp)%conc_p(:,:,nxl-1) = chem_species(lsp)%conc_p(:,:,nxl)
	430	ENDDO
	431	ELSEIF ( outflow_r ) THEN
	432	DO lsp = 1, nspec
	433	chem_species(lsp)%conc_p(:,:,nxr+1) = chem_species(lsp)%conc_p(:,:,nxr)
	434	ENDDO
	435	ENDIF
	436
	437	END SELECT
	438
	439	END SUBROUTINE chem_boundary_conds
	440	!
	441	!------------------------------------------------------------------------------!
	442	!
	443	! Description:
	444	! ------------
	445	!> Subroutine defining initial vertical profiles of chemical species (given by
	446	!> namelist parameters chem_profiles and chem_heights) --> which should work
	447	!> analogue to parameters u_profile, v_profile and uv_heights)
	448	!------------------------------------------------------------------------------!
	449	SUBROUTINE chem_init_profiles !< SUBROUTINE is called from chem_init in case of
	450	!< TRIM( initializing_actions ) /= 'read_restart_data'
	451	!< We still need to see what has to be done in case of restart run
	452	USE chem_modules
	453
	454	IMPLICIT NONE
	455
	456	!-- Local variables
	457	INTEGER :: lsp !< running index for number of species in derived data type species_def
	458	INTEGER :: lsp_pr !< running index for number of species in cs_names, cs_profiles etc
	459	INTEGER :: lpr_lev !< running index for profile level for each chem spcs.
	460	INTEGER :: npr_lev !< the next available profile lev
	461
	462	!-----------------
	463	!-- To prescribe/initialize a vertically constant 'cs_profile', another parameter
	464	!-- "cs_surface" is introduced. If "cs_profile" and "cs_heights" are prescribed,
	465	!-- their values will override the constant profile given by "cs_surface".
	466
[2668]	467	! IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
[2657]	468	lsp_pr = 1
	469	DO WHILE ( TRIM( cs_name( lsp_pr ) ) /= 'novalue' ) !'novalue' is the default
	470	DO lsp = 1, nspec !
	471	!-- Create initial profile (conc_pr_init) for each chemical species
	472	IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_pr) ) ) THEN !
[2682]	473	! IF ( cs_profile(1,1) == 9999999.9_wp ) THEN
[2657]	474	!-- Set a vertically constant profile based on the surface conc (cs_surface(lsp_pr)) of each species
	475	DO lpr_lev = 0, nzt+1
	476	chem_species(lsp)%conc_pr_init(lpr_lev) = cs_surface(lsp_pr)
	477	ENDDO
	478
[2682]	479	! ELSE
	480	! IF ( cs_heights(lsp,1) /= 0.0_wp ) THEN
	481	! message_string = 'cs_heights(1,1) must be 0.0'
[2815]	482	! CALL message( 'chem_check_parameters', 'CM0012', 1, 2, 0, 6, 0 )
[2682]	483	! ENDIF
	484	!
	485	! IF ( omega /= 0.0_wp ) THEN
	486	! message_string = 'Coriolis force must be switched off (by setting omega=0.0)' // &
	487	! ' when prescribing the forcing by u_profile and v_profile'
	488	! CALL message( 'check_parameters', 'PA0347', 1, 2, 0, 6, 0 )
	489	! ENDIF
	490	!
	491	! use_prescribed_profile_data = .TRUE.
	492	!
	493	! npr_lev = 1
	494	! ! chem_sddpecies(lsp)%conc_pr_init(0) = 0.0_wp
	495	! DO lpr_lev = 1, nz+1
	496	! IF ( npr_lev < 100 ) THEN
	497	! DO WHILE ( cs_heights(lsp, npr_lev+1) <= zu(lpr_lev) )
	498	! npr_lev = npr_lev + 1
	499	! IF ( npr_lev == 100 ) EXIT
	500	! ENDDO
	501	! ENDIF
	502	!
	503	! IF ( npr_lev < 100 .AND. cs_heights(lsp, npr_lev + 1) /= 9999999.9_wp ) THEN
	504	! chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp, npr_lev) + &
	505	! ( zu(lpr_lev) - cs_heights(lsp, npr_lev) ) / &
	506	! ( cs_heights(lsp, npr_lev + 1) - cs_heights(lsp, npr_lev ) ) * &
	507	! ( cs_profile(lsp, npr_lev + 1) - cs_profile(lsp, npr_lev ) )
	508	! ELSE
	509	! chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp, npr_lev)
	510	! ENDIF
	511	! ENDDO
	512	! ENDIF
[2657]	513	!-- If a profile is prescribed explicity using cs_profiles and cs_heights, we then have to fill the
	514	!-- chem_species(lsp)%conc_pr_init for the specific "lsp" based on the cs_profiles(lsp_pr,:)
	515	!-- and cs_heights(lsp_pr,:).
	516	ENDIF
	517	ENDDO
	518	lsp_pr = lsp_pr + 1
	519	ENDDO
[2668]	520	! ELSE
[2657]	521	! IF (chem_debug1 ) print*,'code to be added for initializing_actions == read_restart_data' !bK
[2668]	522	! ENDIF
[2657]	523
	524	!-- Now, go back to chem_init and use the contents of chem_species(lsp)%conc_pr_init to
	525	!-- initialize the 3D conc arrays, as it is currently taken care of in chem_set_constant_values.
	526	!-- After initializing the 3D arrays, these can be used to set the boundary conditions in the
	527	!-- subroutine kchem_boundary_conds, which should be called from boundary_conds.f90.
	528
	529
	530	END SUBROUTINE chem_init_profiles
	531	!
	532	!------------------------------------------------------------------------------!
	533	!
	534	! Description:
	535	! ------------
	536	!> Subroutine initializating chemistry_model_mod
	537	!------------------------------------------------------------------------------!
	538	SUBROUTINE chem_init
	539
	540
	541	USE control_parameters, &
	542	ONLY: message_string, io_blocks, io_group, turbulent_inflow
	543
	544	USE arrays_3d, &
	545	ONLY: mean_inflow_profiles
	546
	547	USE pegrid
	548
	549	IMPLICIT none
	550	!-- local variables
	551	INTEGER :: i,j !< running index for for horiz numerical grid points
	552	INTEGER :: lsp !< running index for chem spcs
	553	INTEGER :: lpr_lev !< running index for chem spcs profile level
	554	!
	555	!-- NOPOINTER version not implemented yet
[2682]	556	! #if defined( __nopointer )
	557	! message_string = 'The chemistry module only runs with POINTER version'
	558	! CALL message( 'chemistry_model_mod', 'CM0001', 1, 2, 0, 6, 0 )
	559	! #endif
	560	!
	561	!-- Allocate memory for chemical species
	562	ALLOCATE( chem_species(nspec) )
	563	ALLOCATE( spec_conc_1 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
	564	ALLOCATE( spec_conc_2 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
	565	ALLOCATE( spec_conc_3 (nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
	566	ALLOCATE( spec_conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nspec) )
	567	ALLOCATE( phot_frequen(nphot) )
	568	ALLOCATE( freq_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nphot) )
	569	ALLOCATE( bc_cs_t_val(nspec) )
	570	!
	571	!-- Initialize arrays
	572	spec_conc_1 (:,:,:,:) = 0.0_wp
	573	spec_conc_2 (:,:,:,:) = 0.0_wp
	574	spec_conc_3 (:,:,:,:) = 0.0_wp
	575	spec_conc_av(:,:,:,:) = 0.0_wp
[2657]	576
[2682]	577
[2657]	578	DO lsp = 1, nspec
	579	chem_species(lsp)%name = spc_names(lsp)
	580
	581	chem_species(lsp)%conc (nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_1 (:,:,:,lsp)
	582	chem_species(lsp)%conc_p (nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_2 (:,:,:,lsp)
	583	chem_species(lsp)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_3 (:,:,:,lsp)
	584	chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_av(:,:,:,lsp)
	585
	586	ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg))
[2682]	587	chem_species(lsp)%cssws_av = 0.0_wp
	588	!
	589	!-- (todo (FK): This needs to be revised. This block must go somewhere else)
[2657]	590	! IF ( ws_scheme_sca ) THEN
	591	ALLOCATE (chem_species(lsp)%flux_s_cs(nzb+1:nzt,0:threads_per_task-1))
	592	ALLOCATE (chem_species(lsp)%diss_s_cs(nzb+1:nzt,0:threads_per_task-1))
	593	ALLOCATE (chem_species(lsp)%flux_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1))
	594	ALLOCATE (chem_species(lsp)%diss_l_cs(nzb+1:nzt,nys:nyn,0:threads_per_task-1))
	595	chem_species(lsp)%flux_s_cs = 0.0_wp
	596	chem_species(lsp)%flux_l_cs = 0.0_wp
	597	chem_species(lsp)%diss_s_cs = 0.0_wp
	598	chem_species(lsp)%diss_l_cs = 0.0_wp
	599	! ENDIF
[2682]	600	!
	601	!-- Allocate memory for initial concentration profiles
	602	!-- (concentration values come from namelist)
	603	!-- (todo (FK): Because of this, chem_init is called in palm before
	604	!-- check_parameters, since conc_pr_init is used there.
	605	!-- We have to find another solution since chem_init should
	606	!-- eventually be called from init_3d_model!!)
	607	ALLOCATE ( chem_species(lsp)%conc_pr_init(0:nz+1) )
	608	chem_species(lsp)%conc_pr_init(:) = 0.0_wp
[2657]	609
	610	ENDDO
	611
	612	!
	613	!-- Set initial concentration of profiles prescribed by parameters cs_profile
[2932]	614	!-- and cs_heights in the namelist &chemistry_parameters
[2682]	615	!-- (todo (FK): chem_init_profiles not ready yet, has some bugs)
	616	! CALL chem_init_profiles
[2657]	617	!
	618	!-- Initialize model variables
	619
	620
	621	IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. &
	622	TRIM( initializing_actions ) /= 'cyclic_fill' ) THEN
	623
	624
	625	!-- First model run of a possible job queue.
	626	!-- Initial profiles of the variables must be computes.
	627	IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN
[2668]	628	! CALL location_message( 'initializing with 1D model profiles', .FALSE. )
[2657]	629	!
	630	! CALL init_1d_model ...... decide to call or not later !bK
	631
	632	!-- Transfer initial profiles to the arrays of the 3D model
	633	DO lsp = 1, nspec
	634	DO i = nxlg, nxrg
	635	DO j = nysg, nyng
	636	DO lpr_lev = 1, nz + 1
	637	chem_species(lsp)%conc(lpr_lev,j,i) = chem_species(lsp)%conc_pr_init(lpr_lev)
	638	ENDDO
	639	ENDDO
	640	ENDDO
	641	ENDDO
	642
	643	ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 ) &
	644	THEN
[2668]	645	! CALL location_message( 'initializing with constant profiles', .FALSE. )
[2657]	646
	647
	648
	649	!-- Set initial horizontal velocities at the lowest computational grid
	650	!-- levels to zero in order to avoid too small time steps caused by the
	651	!-- diffusion limit in the initial phase of a run (at k=1, dz/2 occurs
	652	!-- in the limiting formula!).
	653
	654	DO lsp = 1, nspec
	655	DO i = nxlg, nxrg
	656	DO j = nysg, nyng
	657	chem_species(lsp)%conc(:,j,i) = chem_species(lsp)%conc_pr_init !ITS THERE bK
	658	ENDDO
	659	ENDDO
	660	ENDDO
	661
[2668]	662	! ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 ) &
	663	! THEN
	664	! CALL location_message( 'initializing by user', .FALSE. )
[2657]	665	!
	666	!-- Initialization will completely be done by the user
[2668]	667	!-- (FK: This should be called only once, in init_3d_model, i.e. remove it here)
	668	! CALL user_init_3d_model
	669	! CALL location_message( 'finished', .TRUE. )
[2657]	670
	671	ENDIF
	672
	673	!-- Store initial chem spcs profile
	674	! DO lsp = 1, nvar
	675	! hom_cs(:,1,115,:) = SPREAD( chem_species(lsp)%conc(:,nys,nxl), 2, statistic_regions+1 )
	676	! ENDDO
	677	!
	678	!-- If required, change the surface chem spcs at the start of the 3D run
	679	IF ( cs_surface_initial_change(1) /= 0.0_wp ) THEN
	680	DO lsp = 1, nspec
	681	chem_species(lsp)%conc(nzb,:,:) = chem_species(lsp)%conc(nzb,:,:) + &
	682	cs_surface_initial_change(lsp)
	683	ENDDO
	684	ENDIF
	685	!
	686	!-- Initiale old and new time levels.
	687	DO lsp = 1, nvar
	688	chem_species(lsp)%tconc_m = 0.0_wp
[2682]	689	chem_species(lsp)%conc_p = chem_species(lsp)%conc
[2657]	690	ENDDO
	691
	692	ENDIF
	693
[2682]	694
	695
[2657]	696	!--- new code add above this line
	697	DO lsp = 1, nphot
	698	phot_frequen(lsp)%name = phot_names(lsp)
	699	! IF( myid == 0 ) THEN
	700	! WRITE(6,'(a,i4,3x,a)') 'Photolysis: ',lsp,trim(phot_names(lsp))
	701	! ENDIF
	702	phot_frequen(lsp)%freq(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => freq_1(:,:,:,lsp)
	703	ENDDO
	704
	705	!-- Set initial values
	706	! Not required any more, this can now be done with the namelist by setting cs_surface
	707	! and cs_name without specifying cs_profile (Nevertheless, we still want to keep it for a while)
	708	! IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
	709	! CALL set_const_initial_values
	710	! ENDIF
[2682]	711
[2657]	712	RETURN
	713
	714	CONTAINS
	715	!------------------------------------------------------------------------------!
	716	!
	717	! Description:
	718	! ------------
	719	!> Subroutine setting constant initial values of chemical species
	720	!------------------------------------------------------------------------------!
	721	SUBROUTINE set_const_initial_values
	722	! Not required any more, this can now be done with the namelist by setting cs_surface
	723	! and cs_name without specifying cs_profile (Nevertheless, we still want to keep it for a while)
	724	IMPLICIT none
	725
	726	!-- local variables
	727	INTEGER :: lsp
	728
	729	IF(myid == 0) THEN
	730	write(6,'(/,a,/)') ' chemics >>>> Set constant Initial Values: '
	731	ENDIF
	732
	733	! Default values are taken from smog.def from supplied kpp example
	734	DO lsp = 1, nspec
	735	IF(trim(chem_species(lsp)%name) == 'NO') THEN
	736	! chem_species(lsp)%conc = 8.725*1.0E+08
	737	! chem_species(lsp)%conc = 0.05_wp !added by bK
	738	chem_species(lsp)%conc = 0.01_wp !added by RFo
	739	ELSEIF (trim(chem_species(lsp)%name) == 'NO2') THEN
	740	! chem_species(lsp)%conc = 2.240*1.0E+08
	741	! chem_species(lsp)%conc = 0.01_wp !added by bK
	742	chem_species(lsp)%conc = 0.05_wp !added by RFo
	743	ELSEIF( trim( chem_species(lsp)%name ) == 'O3' ) THEN
	744	chem_species(lsp)%conc = 0.05_wp !added by bK
	745	ELSEIF(trim(chem_species(lsp)%name) == 'H2O') THEN
	746	! chem_species(lsp)%conc = 5.326*1.0E+11
	747	chem_species(lsp)%conc = 1.30*1.0E+4_wp !added by bK
	748	ELSEIF(trim(chem_species(lsp)%name) == 'O2') THEN
	749	chem_species(lsp)%conc = 2.0*1.0E+5_wp !added by bK
	750	ELSEIF(trim(chem_species(lsp)%name) == 'RH') THEN
	751	chem_species(lsp)%conc = 0.001_wp !added by RFo
	752	ELSEIF(trim(chem_species(lsp)%name) == 'CO') THEN
	753	chem_species(lsp)%conc = 0.5_wp !added by RFo
	754	ELSEIF(trim(chem_species(lsp)%name) == 'RCHO') THEN
	755	! chem_species(lsp)%conc = 2.0_wp !added by bK
	756	chem_species(lsp)%conc = 0.01_wp !added by RFo
	757	! ELSEIF(trim(chem_species(lsp)%name) == 'OH') THEN
	758	! chem_species(lsp)%conc = 1.0*1.0E-07_wp !added by bK
	759	! ELSEIF(trim(chem_species(lsp)%name) == 'HO2') THEN
	760	! chem_species(lsp)%conc = 1*1.0E-7_wp !added by bK
	761	! ELSEIF(trim(chem_species(lsp)%name) == 'RCOO2') THEN ! corrected RFo
	762	! chem_species(lsp)%conc = 1.0*1.0E-7_wp !added by bK
	763	! ELSEIF(trim(chem_species(lsp)%name) == 'RCOO2NO2') THEN
	764	! chem_species(lsp)%conc = 1.0*1.0E-7_wp !added by bK
	765	ELSE
	766	! H2O = 2.0e+04;
	767	chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) = 0.0_wp
	768	ENDIF
	769
	770	IF(myid == 0) THEN
[2772]	771	WRITE(6,'(a,3x,a,3x,a,e12.4)') ' Species: ',chem_species(lsp)%name(1:7), &
	772	'Initial Value = ',chem_species(lsp)%conc(nzb,nysg,nxlg)
[2657]	773	ENDIF
	774	ENDDO
	775
	776	! #if defined( __nopointer )
	777	! !kk Hier mit message abbrechen
	778	! if(myid == 0) then
	779	! write(6,*) ' KPP does only run with POINTER Version'
	780	! end if
	781	! stop 'error'
	782	! #endif
	783
	784	RETURN
	785	END SUBROUTINE set_const_initial_values
	786
	787
	788	END SUBROUTINE chem_init
	789	!
	790	!------------------------------------------------------------------------------!
	791	!
	792	! Description:
	793	! ------------
[2932]	794	!> Subroutine defining parin for &chemistry_parameters for chemistry model
[2657]	795	!------------------------------------------------------------------------------!
	796	SUBROUTINE chem_parin
[2682]	797
[2657]	798	USE control_parameters, &
	799	ONLY: air_chemistry
[2682]	800
[2657]	801	USE chem_modules
[2682]	802
	803	USE kinds
[2657]	804
	805	IMPLICIT none
	806
[2682]	807	CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file
	808
	809	REAL(wp), DIMENSION(nmaxfixsteps) :: my_steps !< List of fixed timesteps my_step(1) = 0.0 automatic stepping
[2657]	810
[2932]	811	NAMELIST /chemistry_parameters/ bc_cs_b, &
	812	bc_cs_t, &
	813	call_chem_at_all_substeps, &
	814	chem_debug0, &
	815	chem_debug1, &
	816	chem_debug2, &
	817	chem_gasphase_on, &
	818	cs_heights, &
	819	cs_name, &
	820	cs_profile, &
	821	cs_profile_name, &
	822	cs_surface, &
	823	emiss_factor_main, &
	824	emiss_factor_side, &
	825	icntrl, &
	826	main_street_id, &
	827	max_street_id, &
	828	my_steps, &
	829	rcntrl, &
	830	side_street_id, &
	831	photolysis_scheme, &
	832	wall_csflux, &
	833	cs_vertical_gradient, &
	834	top_csflux, &
	835	surface_csflux, &
	836	surface_csflux_name, &
	837	cs_surface_initial_change, &
	838	cs_vertical_gradient_level
[2657]	839
	840	!-- analogue to chem_names(nspj) we could invent chem_surfaceflux(nspj) and chem_topflux(nspj)
	841	!-- so this way we could prescribe a specific flux value for each species
[2932]	842	!> chemistry_parameters for initial profiles
[2657]	843	!> cs_names = 'O3', 'NO2', 'NO', ... to set initial profiles)
	844	!> cs_heights(1,:) = 0.0, 100.0, 500.0, 2000.0, .... (height levels where concs will be prescribed for O3)
	845	!> cs_heights(2,:) = 0.0, 200.0, 400.0, 1000.0, .... (same for NO2 etc.)
	846	!> cs_profiles(1,:) = 10.0, 20.0, 20.0, 30.0, ..... (chem spcs conc at height lvls chem_heights(1,:)) etc.
	847	!> If the respective concentration profile should be constant with height, then use "cs_surface( number of spcs)"
	848	!> then write these cs_surface values to chem_species(lsp)%conc_pr_init(:)
	849
[2668]	850	!
	851	!-- Read chem namelist
	852	!-- (todo: initialize these parameters in declaration part, do this for
[2932]	853	!-- all chemistry_parameters namelist parameters)
[2657]	854	icntrl = 0
	855	rcntrl = 0.0_wp
	856	my_steps = 0.0_wp
	857	icntrl(2) = 1
	858	photolysis_scheme = 'simple'
	859	atol = 1.0_wp
	860	rtol = 0.01_wp
	861	!
	862	!-- Try to find chemistry package
	863	REWIND ( 11 )
	864	line = ' '
[2932]	865	DO WHILE ( INDEX( line, '&chemistry_parameters' ) == 0 )
[2668]	866	READ ( 11, '(A)', END=10 ) line
[2657]	867	ENDDO
	868	BACKSPACE ( 11 )
	869	!
[2668]	870	!-- Read chemistry namelist
[2932]	871	READ ( 11, chemistry_parameters )
[2668]	872	!
	873	!-- Enable chemistry model
	874	air_chemistry = .TRUE.
[2657]	875
[2668]	876
[2657]	877	10 CONTINUE
	878
[2668]	879	t_steps = my_steps !(todo: Why not directly make t_steps a
	880	! namelist parameter?)
[2657]	881
	882	END SUBROUTINE chem_parin
	883
	884	!
	885	!------------------------------------------------------------------------------!
	886	!
	887	! Description:
	888	! ------------
	889	!> Subroutine to integrate chemical species in the given chemical mechanism
	890	!------------------------------------------------------------------------------!
	891
	892	SUBROUTINE chem_integrate_ij (i, j)
	893
	894	USE cpulog, &
	895	ONLY: cpu_log, log_point
	896	USE statistics, & ! ## RFo
	897	ONLY: weight_pres
	898	USE control_parameters, & ! ## RFo
	899	ONLY: dt_3d, intermediate_timestep_count
	900
	901	IMPLICIT none
	902	INTEGER,INTENT(IN) :: i,j
	903
	904	!-- local variables
	905	INTEGER(iwp) :: lsp !< running index for chem spcs.
	906	INTEGER(iwp) :: lph !< running index for photolysis frequencies
	907	INTEGER :: k,m,istatf
	908	INTEGER,dimension(20) :: istatus
	909	REAL(kind=wp),dimension(nzb+1:nzt,nspec) :: tmp_conc
	910	REAL(kind=wp),dimension(nzb+1:nzt) :: tmp_temp
	911	REAL(kind=wp),dimension(nzb+1:nzt,nphot) :: tmp_phot
	912	REAL(kind=wp),dimension(nzb+1:nzt) :: tmp_fact
	913	REAL(kind=wp),dimension(nzb+1:nzt) :: tmp_fact_i !< conversion factor between molecules cm^{-3} and ppm
	914	REAL(wp) :: conv !< conversion factor
	915	REAL(wp), PARAMETER :: ppm2fr = 1.0e-6_wp !< Conversion factor ppm to fraction
	916	REAL(wp), PARAMETER :: pref_i = 1._wp / 100000.0_wp !< inverse reference pressure (1/Pa)
	917	REAL(wp), PARAMETER :: t_std = 273.15_wp !< standard pressure (Pa)
	918	REAL(wp), PARAMETER :: p_std = 101325.0_wp !< standard pressure (Pa)
	919	REAL(wp), PARAMETER :: r_cp = 0.286_wp !< R / cp (exponent for potential temperature)
	920	REAL(wp), PARAMETER :: vmolcm = 22.414e3_wp !< Mole volume (22.414 l) in cm^{-3}
	921	REAL(wp), PARAMETER :: xna = 6.022e23_wp !< Avogadro number (molecules/mol)
	922
	923
	924	REAL(kind=wp) :: dt_chem
	925
	926	CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'start' )
	927	!< Set chem_gasphase_on to .FALSE. if you want to skip computation of gas phase chemistry
	928	IF (chem_gasphase_on) THEN
	929
	930	tmp_temp(:) = pt(:,j,i) * ( hyp(nzb+1:nzt) / 100000.0_wp )**0.286_wp
	931	! ppm to molecules/cm**3
	932	! tmp_fact = 1.e-6_wp6.022e23_wp/(22.414_wp1000._wp) * 273.15_wp * hyp(nzb+1:nzt)/( 101300.0_wp * tmp_temp )
	933	conv = ppm2fr * xna / vmolcm
	934	tmp_fact(:) = conv * t_std * hyp(nzb+1:nzt) / (tmp_temp(:) * p_std)
	935	tmp_fact_i = 1.0_wp/tmp_fact
	936
	937	CALL fill_temp (istatf, tmp_temp) !< Load constant temperature into kpp context
	938	! CALL fill_temp (istatf, pt(nzb+1:nzt,j,i)) !< Load temperature into kpp context
	939
	940	DO lsp = 1,nspec
	941	tmp_conc(:,lsp) = chem_species(lsp)%conc(nzb+1:nzt,j,i) * tmp_fact(:)
	942	ENDDO
	943
	944	DO lph = 1,nphot
	945	tmp_phot(:,lph) = phot_frequen(lph)%freq(nzb+1:nzt,j,i)
	946	ENDDO
	947
	948	IF(myid == 0 .AND. chem_debug0 ) THEN
	949	IF (i == 10 .and. j == 10) WRITE(0,*) 'begin chemics step ',dt_3d
	950	ENDIF
	951
	952	!-- Compute length of time step # RFo
	953	IF ( call_chem_at_all_substeps ) THEN
	954	dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
	955	ELSE
	956	dt_chem = dt_3d
	957	ENDIF
	958
	959	CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'start' )
	960
	961
	962	CALL chem_gasphase_integrate (dt_chem, tmp_conc, tmp_temp, tmp_phot, istatus=istatus)
	963
	964
	965	CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'stop' )
	966
	967	DO lsp = 1,nspec
	968	chem_species(lsp)%conc (nzb+1:nzt,j,i) = tmp_conc(:,lsp) * tmp_fact_i(:) ! RFo
	969	ENDDO
	970
	971	! IF (myid == 0 .AND. chem_debug2 ) THEN
	972	! IF (i == 10 .and. j == 10) WRITE(6,'(a,8i7)') ' KPP Status ',istatus(1:8)
	973	! write(6,'(a,8i7)') ' KPP Status ',istatus(1:8)
	974	! ENDIF
	975
	976	ENDIF
	977	CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'stop' )
	978
	979	RETURN
	980	END SUBROUTINE chem_integrate_ij
	981	!
	982	!------------------------------------------------------------------------------!
	983	!
	984	! Description:
	985	! ------------
	986	!> Subroutine for swapping of timelevels for chemical species
	987	!> called out from subroutine swap_timelevel
	988	!------------------------------------------------------------------------------!
	989
	990	SUBROUTINE chem_swap_timelevel (level)
	991	IMPLICIT none
	992
	993	INTEGER,INTENT(IN) :: level
	994
	995	!-- local variables
	996
	997	INTEGER :: lsp
	998
	999	! print,' entering chem_swap_timelevel *) '
	1000	if(level == 0) then
	1001	do lsp=1, nvar
	1002	chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_1(:,:,:,lsp)
	1003	chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_2(:,:,:,lsp)
	1004	end do
	1005	else
	1006	do lsp=1, nvar
	1007	chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_2(:,:,:,lsp)
	1008	chem_species(lsp)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => spec_conc_1(:,:,:,lsp)
	1009	end do
	1010	end if
	1011
	1012	RETURN
	1013	END SUBROUTINE chem_swap_timelevel
	1014
	1015	!------------------------------------------------------------------------------!
	1016	!
	1017	! Description:
	1018	! ------------
	1019	!> Subroutine defining appropriate grid for netcdf variables.
	1020	!> It is called out from subroutine netcdf.
	1021	!------------------------------------------------------------------------------!
	1022	SUBROUTINE chem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
	1023
	1024	IMPLICIT NONE
	1025
	1026	CHARACTER (LEN=*), INTENT(IN) :: var !<
	1027	LOGICAL, INTENT(OUT) :: found !<
	1028	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
	1029	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
	1030	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
	1031
	1032	found = .TRUE.
	1033
	1034	if(var(1:3) == 'kc_') then !< always the same grid for chemistry variables
	1035	grid_x = 'x'
	1036	grid_y = 'y'
	1037	grid_z = 'zu' !< kk Use same z axis as u variables. Has to be checked if OK
	1038	else
	1039	found = .FALSE.
	1040	grid_x = 'none'
	1041	grid_y = 'none'
	1042	grid_z = 'none'
	1043	end if
	1044
	1045	! write(6,*) 'chem_define_netcdf_grid ',TRIM(var),' ',trim(grid_x),' ',found
	1046
	1047	END SUBROUTINE chem_define_netcdf_grid
	1048	!
	1049	!------------------------------------------------------------------------------!
	1050	!
	1051	! Description:
	1052	! ------------
	1053	!> Subroutine for checking data output for chemical species
	1054	!------------------------------------------------------------------------------!
	1055
	1056	SUBROUTINE chem_check_data_output( var, unit, i, ilen, k )
	1057
	1058
	1059	USE control_parameters, &
	1060	ONLY: data_output, message_string
	1061
	1062	IMPLICIT NONE
	1063
	1064	CHARACTER (LEN=*) :: unit !<
	1065	CHARACTER (LEN=*) :: var !<
	1066
	1067	INTEGER(iwp) :: i, lsp
	1068	INTEGER(iwp) :: ilen
	1069	INTEGER(iwp) :: k
	1070
	1071	CHARACTER(len=16) :: spec_name
	1072
	1073	unit = 'illegal'
	1074
	1075	spec_name = TRIM(var(4:)) !< var 1:3 is 'kc_'.
	1076
	1077	DO lsp=1,nspec
	1078	IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name)) THEN
	1079	unit = 'ppm'
	1080	ENDIF
	1081	! It is possible to plant PM10 and PM25 into the gasphase chemistry code
	1082	! ! as passive species (e.g. 'passive' in GASPHASE_PREPROC/mechanisms):
	1083	! ! set unit to micrograms per m**3 for PM10 and PM25 (PM2.5)
	1084	IF (spec_name(1:2) == 'PM') THEN
	1085	unit = 'ug m-3'
	1086	ENDIF
	1087	ENDDO
	1088
	1089	DO lsp=1,nphot
	1090	IF (TRIM(spec_name) == TRIM(phot_frequen(lsp)%name)) THEN
	1091	unit = 'sec-1'
	1092	ENDIF
	1093	ENDDO
	1094
	1095
	1096	RETURN
	1097	END SUBROUTINE chem_check_data_output
	1098	!
	1099	!------------------------------------------------------------------------------!
	1100	!
	1101	! Description:
	1102	! ------------
	1103	!> Subroutine for checking data output of profiles for chemistry model
	1104	!------------------------------------------------------------------------------!
	1105
	1106	SUBROUTINE chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
	1107
	1108
	1109	USE arrays_3d, &
	1110	ONLY: zu
	1111
	1112	USE control_parameters, &
	1113	ONLY: data_output_pr, message_string, air_chemistry
	1114
	1115	USE indices
	1116
	1117	USE profil_parameter
	1118
	1119	USE statistics
	1120
	1121
	1122	IMPLICIT NONE
	1123
	1124	CHARACTER (LEN=*) :: unit !<
	1125	CHARACTER (LEN=*) :: variable !<
	1126	CHARACTER (LEN=*) :: dopr_unit
	1127	CHARACTER(len=16) :: spec_name
	1128
	1129	INTEGER(iwp) :: var_count, lsp !<
	1130
	1131
	1132	spec_name = TRIM(variable(4:))
	1133	! write(9,*) 'fm #32 .. air_chemistry ', air_chemistry
	1134
	1135	IF ( .NOT. air_chemistry ) THEN
	1136	message_string = 'data_output_pr = ' // &
	1137	TRIM( data_output_pr(var_count) ) // ' is not imp' // &
	1138	'lemented for air_chemistry = .FALSE.'
[3045]	1139	! CALL message( 'check_parameters', 'PA0XXX', 1, 2, 0, 6, 0 )
[2657]	1140	ELSE
	1141	DO lsp = 1, nspec
	1142	IF (TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN
	1143	dopr_index(var_count) = 900
	1144	dopr_unit = 'ppm'
	1145	hom(:,2,900,:) = SPREAD( zu, 2, statistic_regions+1 )
	1146	ENDIF
	1147	ENDDO
	1148	ENDIF
	1149
	1150	END SUBROUTINE chem_check_data_output_pr
	1151	!
	1152	!------------------------------------------------------------------------------!
	1153	!
	1154	! Description:
	1155	! ------------
	1156	!> Subroutine defining 3D output variables for chemical species
	1157	!------------------------------------------------------------------------------!
	1158
	1159
[3014]	1160	SUBROUTINE chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
[2657]	1161
	1162
	1163	USE indices
	1164
	1165	USE kinds
	1166
	1167
	1168	IMPLICIT NONE
	1169
	1170	CHARACTER (LEN=*) :: variable !<
[3014]	1171
[2657]	1172	INTEGER(iwp) :: av !<
[3014]	1173	INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0)
	1174	INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d)
[2657]	1175
[3014]	1176	LOGICAL :: found !<
	1177
[2756]	1178	REAL(wp) :: fill_value !<
[3014]	1179	REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf
[2756]	1180
	1181
[2657]	1182	!-- local variables
	1183
	1184	INTEGER :: i, j, k, lsp
	1185	CHARACTER(len=16) :: spec_name
	1186
	1187
	1188	found = .FALSE.
	1189
	1190	spec_name = TRIM(variable(4:))
	1191	!av == 0
	1192
	1193	DO lsp=1,nspec
	1194	IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name)) THEN
[2772]	1195	IF(myid == 0 .AND. chem_debug0 ) WRITE(6,*) 'Output of species ' // TRIM(variable) // &
	1196	TRIM(chem_species(lsp)%name)
[2657]	1197
	1198	IF (av == 0) THEN
	1199	DO i = nxl, nxr
	1200	DO j = nys, nyn
[3014]	1201	DO k = nzb_do, nzt_do
[2756]	1202	local_pf(i,j,k) = MERGE( &
	1203	chem_species(lsp)%conc(k,j,i), &
	1204	REAL( fill_value, KIND = wp ), &
	1205	BTEST( wall_flags_0(k,j,i), 0 ) )
[2657]	1206	ENDDO
	1207	ENDDO
	1208	ENDDO
	1209
	1210	ELSE
	1211	DO i = nxl, nxr
	1212	DO j = nys, nyn
[3014]	1213	DO k = nzb_do, nzt_do
[2756]	1214	local_pf(i,j,k) = MERGE( &
	1215	chem_species(lsp)%conc_av(k,j,i),&
	1216	REAL( fill_value, KIND = wp ), &
	1217	BTEST( wall_flags_0(k,j,i), 0 ) )
[2657]	1218	ENDDO
	1219	ENDDO
	1220	ENDDO
	1221	ENDIF
	1222
	1223	found = .TRUE.
	1224	ENDIF
	1225	ENDDO
	1226
	1227	RETURN
	1228	END SUBROUTINE chem_data_output_3d
	1229	!
	1230	!------------------------------------------------------------------------------!
	1231	!
	1232	! Description:
	1233	! ------------
[3004]	1234	!> Subroutine for averaging 3D data of chemical species. Due to the fact that
	1235	!> the averaged chem arrays are allocated in chem_init, no if-query concerning
	1236	!> the allocation is required (in any mode). Attention: If you just specify an
	1237	!> averaged output quantity in the _p3dr file during restarts the first output
	1238	!> includes the time between the beginning of the restart run and the first
	1239	!> output time (not necessarily the whole averaging_interval you have
	1240	!> specified in your _p3d/_p3dr file )
[2657]	1241	!------------------------------------------------------------------------------!
	1242
	1243	SUBROUTINE chem_3d_data_averaging ( mode, variable )
	1244
	1245	USE control_parameters
	1246
	1247	USE indices
	1248
	1249	USE kinds
	1250
	1251	USE surface_mod, &
	1252	ONLY: surf_def_h, surf_lsm_h, surf_usm_h
	1253
	1254	IMPLICIT NONE
	1255
	1256	CHARACTER (LEN=*) :: mode !<
	1257	CHARACTER (LEN=*) :: variable !<
	1258
	1259
	1260	INTEGER(iwp) :: i !< grid index x direction
	1261	INTEGER(iwp) :: j !< grid index y direction
	1262	INTEGER(iwp) :: k !< grid index z direction
	1263	INTEGER(iwp) :: m !< running index surface type
	1264	INTEGER(iwp) :: lsp !< running index for chem spcs
	1265	INTEGER(iwp) :: lsp_2 !< it looks like redundent .. will be delted ..bK
	1266
	1267	IF ( mode == 'allocate' ) THEN
	1268	DO lsp = 1, nspec
	1269	IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
	1270	! lsp_2 = lsp
	1271	chem_species(lsp)%conc_av = 0.0_wp
	1272
	1273	ENDIF
	1274	ENDDO
	1275
	1276	ELSEIF ( mode == 'sum' ) THEN
	1277
	1278	DO lsp = 1, nspec
	1279	IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
	1280	! lsp_2 = lsp
	1281	DO i = nxlg, nxrg
	1282	DO j = nysg, nyng
	1283	DO k = nzb, nzt+1
	1284	chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) + &
	1285	chem_species(lsp)%conc(k,j,i)
	1286	ENDDO
	1287	ENDDO
	1288	ENDDO
	1289	ELSEIF ( TRIM(variable(4:)) == TRIM('cssws*') ) THEN
	1290	DO m = 1, surf_def_h(0)%ns
	1291	i = surf_def_h(0)%i(m)
	1292	j = surf_def_h(0)%j(m)
	1293	chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + surf_def_h(0)%cssws(lsp,m)
	1294	ENDDO
	1295	DO m = 1, surf_lsm_h%ns
	1296	i = surf_lsm_h%i(m)
	1297	j = surf_lsm_h%j(m)
	1298	chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + surf_lsm_h%cssws(lsp,m)
	1299	ENDDO
	1300	DO m = 1, surf_usm_h%ns
	1301	i = surf_usm_h%i(m)
	1302	j = surf_usm_h%j(m)
	1303	chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + surf_usm_h%cssws(lsp,m)
	1304	ENDDO
	1305
	1306	ENDIF
	1307	ENDDO
	1308
	1309	ELSEIF ( mode == 'average' ) THEN
	1310	DO lsp = 1, nspec
	1311	IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
	1312	! lsp_2 = lsp
	1313	DO i = nxlg, nxrg
	1314	DO j = nysg, nyng
	1315	DO k = nzb, nzt+1
	1316	chem_species(lsp)%conc_av(k,j,i) = chem_species(lsp)%conc_av(k,j,i) / REAL( average_count_3d, KIND=wp )
	1317	ENDDO
	1318	ENDDO
	1319	ENDDO
	1320
	1321	ELSEIF (TRIM(variable(4:)) == TRIM('cssws*') ) THEN
	1322	DO i = nxlg, nxrg
	1323	DO j = nysg, nyng
	1324	chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) / REAL( average_count_3d, KIND=wp )
	1325	ENDDO
	1326	ENDDO
	1327	CALL exchange_horiz_2d( chem_species(lsp)%cssws_av, nbgp )
	1328	ENDIF
	1329	ENDDO
	1330
	1331	ENDIF
	1332
	1333	END SUBROUTINE chem_3d_data_averaging
	1334
	1335	!------------------------------------------------------------------------------!
	1336	!
	1337	! Description:
	1338	! ------------
	1339	!> Subroutine to write restart data for chemistry model
	1340	!------------------------------------------------------------------------------!
[2894]	1341	SUBROUTINE chem_wrd_local
[2657]	1342
	1343
	1344	IMPLICIT NONE
	1345
[2815]	1346	INTEGER(iwp) :: lsp !<
[2894]	1347
[2657]	1348	! REAL(kind=wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: chems_conc
[2815]	1349
	1350
[2894]	1351	DO lsp = 1, nspec
[2668]	1352
[2894]	1353	CALL wrd_write_string( TRIM( chem_species(lsp)%name ))
	1354	WRITE ( 14 ) chem_species(lsp)%conc
[2657]	1355
[2894]	1356	CALL wrd_write_string( TRIM( chem_species(lsp)%name )//'_av' )
	1357	WRITE ( 14 ) chem_species(lsp)%conc_av
[2657]	1358
[2894]	1359	ENDDO
[2657]	1360
[2894]	1361
	1362	END SUBROUTINE chem_wrd_local
	1363
[2657]	1364	!------------------------------------------------------------------------------!
	1365	!
	1366	! Description:
	1367	! ------------
	1368	!> Subroutine to read restart data of chemical species
	1369	!------------------------------------------------------------------------------!
	1370
[2894]	1371	SUBROUTINE chem_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, &
	1372	nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc, &
	1373	nys_on_file, tmp_3d, found )
[2657]	1374
	1375	USE control_parameters
	1376
	1377	USE indices
	1378
	1379	USE pegrid
	1380
	1381	IMPLICIT NONE
	1382
	1383	CHARACTER (LEN=20) :: spc_name_av !<
	1384
	1385	INTEGER(iwp) :: i, lsp !<
	1386	INTEGER(iwp) :: k !<
	1387	INTEGER(iwp) :: nxlc !<
	1388	INTEGER(iwp) :: nxlf !<
	1389	INTEGER(iwp) :: nxl_on_file !<
	1390	INTEGER(iwp) :: nxrc !<
	1391	INTEGER(iwp) :: nxrf !<
	1392	INTEGER(iwp) :: nxr_on_file !<
	1393	INTEGER(iwp) :: nync !<
	1394	INTEGER(iwp) :: nynf !<
	1395	INTEGER(iwp) :: nyn_on_file !<
	1396	INTEGER(iwp) :: nysc !<
	1397	INTEGER(iwp) :: nysf !<
	1398	INTEGER(iwp) :: nys_on_file !<
[2815]	1399
[2894]	1400	LOGICAL, INTENT(OUT) :: found
[2657]	1401
[2894]	1402	REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< 3D array to temp store data
[2657]	1403
[2815]	1404
[2894]	1405	found = .FALSE.
[2657]	1406
[2815]	1407
[2894]	1408	IF ( ALLOCATED(chem_species) ) THEN
[2657]	1409
[2894]	1410	DO lsp = 1, nspec
[2815]	1411
[2894]	1412	!< for time-averaged chemical conc.
	1413	spc_name_av = TRIM(chem_species(lsp)%name)//'_av'
[2657]	1414
[2894]	1415	IF (restart_string(1:length) == TRIM(chem_species(lsp)%name) ) &
	1416	THEN
	1417	!< read data into tmp_3d
	1418	IF ( k == 1 ) READ ( 13 ) tmp_3d
	1419	!< fill ..%conc in the restart run
	1420	chem_species(lsp)%conc(:,nysc-nbgp:nync+nbgp, &
	1421	nxlc-nbgp:nxrc+nbgp) = &
	1422	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
	1423	found = .TRUE.
	1424	ELSEIF (restart_string(1:length) == spc_name_av ) THEN
	1425	IF ( k == 1 ) READ ( 13 ) tmp_3d
	1426	chem_species(lsp)%conc_av(:,nysc-nbgp:nync+nbgp, &
	1427	nxlc-nbgp:nxrc+nbgp) = &
	1428	tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
	1429	found = .TRUE.
[2815]	1430	ENDIF
[2894]	1431
[2657]	1432	ENDDO
	1433
[2894]	1434	ENDIF
[2657]	1435
	1436
[2894]	1437	END SUBROUTINE chem_rrd_local
[2657]	1438
	1439
	1440	!------------------------------------------------------------------------------!
	1441	!
	1442	! Description:
	1443	! ------------
[2815]	1444	!> Subroutine calculating prognostic equations for chemical species
	1445	!> (cache-optimized).
	1446	!> Routine is called separately for each chemical species over a loop from
	1447	!> prognostic_equations.
[2657]	1448	!------------------------------------------------------------------------------!
[2815]	1449	SUBROUTINE chem_prognostic_equations_ij ( cs_scalar_p, cs_scalar, tcs_scalar_m, pr_init_cs, &
[2768]	1450	i, j, i_omp_start, tn, ilsp, flux_s_cs, diss_s_cs, &
	1451	flux_l_cs, diss_l_cs )
[2657]	1452	USE pegrid
	1453	USE advec_ws, ONLY: advec_s_ws
	1454	USE advec_s_pw_mod, ONLY: advec_s_pw
	1455	USE advec_s_up_mod, ONLY: advec_s_up
	1456	USE diffusion_s_mod, ONLY: diffusion_s
	1457	USE indices, ONLY: wall_flags_0
[2768]	1458	USE surface_mod, ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
	1459	surf_usm_v
[2657]	1460
[2815]	1461
[2657]	1462	IMPLICIT NONE
	1463
[2768]	1464	REAL(wp), DIMENSION(:,:,:), POINTER :: cs_scalar_p, cs_scalar, tcs_scalar_m
[2657]	1465
	1466	INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn, ilsp
	1467	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s_cs !<
	1468	REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s_cs !<
	1469	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l_cs !<
	1470	REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l_cs !<
	1471	REAL(wp), DIMENSION(0:nz+1) :: pr_init_cs !<
	1472
	1473	!-- local variables
	1474
	1475	INTEGER :: k
	1476	!
	1477	!-- Tendency-terms for chem spcs.
	1478	tend(:,j,i) = 0.0_wp
	1479	!
	1480	!-- Advection terms
	1481	IF ( timestep_scheme(1:5) == 'runge' ) THEN
	1482	IF ( ws_scheme_sca ) THEN
	1483	CALL advec_s_ws( i, j, cs_scalar, 'kc', flux_s_cs, diss_s_cs, &
	1484	flux_l_cs, diss_l_cs, i_omp_start, tn )
	1485	ELSE
	1486	CALL advec_s_pw( i, j, cs_scalar )
	1487	ENDIF
	1488	ELSE
	1489	CALL advec_s_up( i, j, cs_scalar )
	1490	ENDIF
	1491
	1492	!
	1493
[2815]	1494	!-- Diffusion terms (the last three arguments are zero)
[2657]	1495
	1496	CALL diffusion_s( i, j, cs_scalar, &
	1497	surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:), &
	1498	surf_def_h(2)%cssws(ilsp,:), &
	1499	surf_lsm_h%cssws(ilsp,:), surf_usm_h%cssws(ilsp,:), &
	1500	surf_def_v(0)%cssws(ilsp,:), surf_def_v(1)%cssws(ilsp,:), &
	1501	surf_def_v(2)%cssws(ilsp,:), surf_def_v(3)%cssws(ilsp,:), &
	1502	surf_lsm_v(0)%cssws(ilsp,:), surf_lsm_v(1)%cssws(ilsp,:), &
	1503	surf_lsm_v(2)%cssws(ilsp,:), surf_lsm_v(3)%cssws(ilsp,:), &
	1504	surf_usm_v(0)%cssws(ilsp,:), surf_usm_v(1)%cssws(ilsp,:), &
	1505	surf_usm_v(2)%cssws(ilsp,:), surf_usm_v(3)%cssws(ilsp,:) )
	1506
	1507	!
	1508	!-- Prognostic equation for chem spcs
	1509	DO k = nzb+1, nzt
	1510	cs_scalar_p(k,j,i) = cs_scalar(k,j,i) + ( dt_3d * &
	1511	( tsc(2) * tend(k,j,i) + &
	1512	tsc(3) * tcs_scalar_m(k,j,i) ) &
	1513	- tsc(5) * rdf_sc(k) &
	1514	* ( cs_scalar(k,j,i) - pr_init_cs(k) ) &
	1515	) &
	1516	* MERGE( 1.0_wp, 0.0_wp, &
	1517	BTEST( wall_flags_0(k,j,i), 0 ) &
	1518	)
	1519
	1520	IF ( cs_scalar_p(k,j,i) < 0.0_wp ) cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i) !FKS6
	1521	ENDDO
	1522
	1523	!
	1524	!-- Calculate tendencies for the next Runge-Kutta step
	1525	IF ( timestep_scheme(1:5) == 'runge' ) THEN
	1526	IF ( intermediate_timestep_count == 1 ) THEN
	1527	DO k = nzb+1, nzt
	1528	tcs_scalar_m(k,j,i) = tend(k,j,i)
	1529	ENDDO
	1530	ELSEIF ( intermediate_timestep_count < &
	1531	intermediate_timestep_count_max ) THEN
	1532	DO k = nzb+1, nzt
	1533	tcs_scalar_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
	1534	5.3125_wp * tcs_scalar_m(k,j,i)
	1535	ENDDO
	1536	ENDIF
	1537	ENDIF
[2815]	1538
	1539	END SUBROUTINE chem_prognostic_equations_ij
	1540
	1541
	1542	!------------------------------------------------------------------------------!
[2657]	1543	!
[2815]	1544	! Description:
	1545	! ------------
	1546	!> Subroutine calculating prognostic equations for chemical species
	1547	!> (vector-optimized).
	1548	!> Routine is called separately for each chemical species over a loop from
	1549	!> prognostic_equations.
	1550	!------------------------------------------------------------------------------!
	1551	SUBROUTINE chem_prognostic_equations ( cs_scalar_p, cs_scalar, tcs_scalar_m, &
	1552	pr_init_cs, ilsp )
[2657]	1553
[2815]	1554	USE advec_s_pw_mod, &
	1555	ONLY: advec_s_pw
	1556
	1557	USE advec_s_up_mod, &
	1558	ONLY: advec_s_up
	1559
	1560	USE advec_ws, &
	1561	ONLY: advec_s_ws
	1562
	1563	USE diffusion_s_mod, &
	1564	ONLY: diffusion_s
	1565
	1566	USE indices, &
	1567	ONLY: nxl, nxr, nyn, nys, wall_flags_0
	1568
	1569	USE pegrid
	1570
	1571	USE surface_mod, &
	1572	ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
	1573	surf_usm_v
	1574
	1575	IMPLICIT NONE
	1576
	1577	INTEGER :: i !< running index
	1578	INTEGER :: j !< running index
	1579	INTEGER :: k !< running index
	1580
	1581	INTEGER(iwp),INTENT(IN) :: ilsp !<
	1582
	1583	REAL(wp), DIMENSION(0:nz+1) :: pr_init_cs !<
	1584
	1585	REAL(wp), DIMENSION(:,:,:), POINTER :: cs_scalar !<
	1586	REAL(wp), DIMENSION(:,:,:), POINTER :: cs_scalar_p !<
	1587	REAL(wp), DIMENSION(:,:,:), POINTER :: tcs_scalar_m !<
	1588
	1589
	1590	!
	1591	!-- Tendency terms for chemical species
	1592	tend = 0.0_wp
	1593	!
	1594	!-- Advection terms
	1595	IF ( timestep_scheme(1:5) == 'runge' ) THEN
	1596	IF ( ws_scheme_sca ) THEN
	1597	CALL advec_s_ws( cs_scalar, 'kc' )
	1598	ELSE
	1599	CALL advec_s_pw( cs_scalar )
	1600	ENDIF
	1601	ELSE
	1602	CALL advec_s_up( cs_scalar )
	1603	ENDIF
	1604	!
	1605	!-- Diffusion terms (the last three arguments are zero)
	1606	CALL diffusion_s( cs_scalar, &
	1607	surf_def_h(0)%cssws(ilsp,:), &
	1608	surf_def_h(1)%cssws(ilsp,:), &
	1609	surf_def_h(2)%cssws(ilsp,:), &
	1610	surf_lsm_h%cssws(ilsp,:), &
	1611	surf_usm_h%cssws(ilsp,:), &
	1612	surf_def_v(0)%cssws(ilsp,:), &
	1613	surf_def_v(1)%cssws(ilsp,:), &
	1614	surf_def_v(2)%cssws(ilsp,:), &
	1615	surf_def_v(3)%cssws(ilsp,:), &
	1616	surf_lsm_v(0)%cssws(ilsp,:), &
	1617	surf_lsm_v(1)%cssws(ilsp,:), &
	1618	surf_lsm_v(2)%cssws(ilsp,:), &
	1619	surf_lsm_v(3)%cssws(ilsp,:), &
	1620	surf_usm_v(0)%cssws(ilsp,:), &
	1621	surf_usm_v(1)%cssws(ilsp,:), &
	1622	surf_usm_v(2)%cssws(ilsp,:), &
	1623	surf_usm_v(3)%cssws(ilsp,:) )
	1624	!
	1625	!-- Prognostic equation for chemical species
	1626	DO i = nxl, nxr
	1627	DO j = nys, nyn
	1628	DO k = nzb+1, nzt
	1629	cs_scalar_p(k,j,i) = cs_scalar(k,j,i) &
	1630	+ ( dt_3d * &
	1631	( tsc(2) * tend(k,j,i) &
	1632	+ tsc(3) * tcs_scalar_m(k,j,i) &
	1633	) &
	1634	- tsc(5) * rdf_sc(k) &
	1635	* ( cs_scalar(k,j,i) - pr_init_cs(k) ) &
	1636	) &
	1637	* MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
	1638
	1639	IF ( cs_scalar_p(k,j,i) < 0.0_wp ) cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)
	1640	ENDDO
	1641	ENDDO
	1642	ENDDO
	1643	!
	1644	!-- Calculate tendencies for the next Runge-Kutta step
	1645	IF ( timestep_scheme(1:5) == 'runge' ) THEN
	1646	IF ( intermediate_timestep_count == 1 ) THEN
	1647	DO i = nxl, nxr
	1648	DO j = nys, nyn
	1649	DO k = nzb+1, nzt
	1650	tcs_scalar_m(k,j,i) = tend(k,j,i)
	1651	ENDDO
	1652	ENDDO
	1653	ENDDO
	1654	ELSEIF ( intermediate_timestep_count < &
	1655	intermediate_timestep_count_max ) THEN
	1656	DO i = nxl, nxr
	1657	DO j = nys, nyn
	1658	DO k = nzb+1, nzt
	1659	tcs_scalar_m(k,j,i) = - 9.5625_wp * tend(k,j,i) &
	1660	+ 5.3125_wp * tcs_scalar_m(k,j,i)
	1661	ENDDO
	1662	ENDDO
	1663	ENDDO
	1664	ENDIF
	1665	ENDIF
	1666
	1667	END SUBROUTINE chem_prognostic_equations
	1668
	1669
[2657]	1670	!------------------------------------------------------------------------------!
	1671	!
	1672	! Description:
	1673	! ------------
	1674	!> Subroutine defining header output for chemistry model
	1675	!------------------------------------------------------------------------------!
	1676	SUBROUTINE chem_header ( io )
	1677
	1678	IMPLICIT NONE
	1679
	1680	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
	1681
	1682	! print*,'the header subroutine is still not operational'
	1683	!!
	1684	!!-- Write chemistry model header
	1685	! WRITE( io, 3 )
	1686	!
	1687	! IF ( radiation_scheme == "constant" ) THEN
	1688	! WRITE( io, 4 ) net_radiation
	1689	! ELSEIF ( radiation_scheme == "clear-sky" ) THEN
	1690	! WRITE( io, 5 )
	1691	! ELSEIF ( radiation_scheme == "rrtmg" ) THEN
	1692	! WRITE( io, 6 )
	1693	! IF ( .NOT. lw_radiation ) WRITE( io, 10 )
	1694	! IF ( .NOT. sw_radiation ) WRITE( io, 11 )
	1695	! ENDIF
	1696	!
	1697	! IF ( albedo_type == 0 ) THEN
	1698	! WRITE( io, 7 ) albedo
	1699	! ELSE
	1700	! WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
	1701	! ENDIF
	1702	! IF ( constant_albedo ) THEN
	1703	! WRITE( io, 9 )
	1704	! ENDIF
	1705	!
	1706	! IF ( radiation .AND. radiation_scheme /= 'constant' ) THEN
	1707	! WRITE ( io, 1 ) lambda
	1708	! WRITE ( io, 2 ) day_init, time_utc_init
	1709	! ENDIF
	1710	!
	1711	! WRITE( io, 12 ) dt_radiation
	1712	!
	1713	! 1 FORMAT (' Geograph. longitude : lambda = ',F4.1,' degr')
	1714	! 2 FORMAT (' Day of the year at model start : day_init = ',I3 &
	1715	! /' UTC time at model start : time_utc_init = ',F7.1' s')
	1716	! 3 FORMAT (//' Radiation model information:'/ &
	1717	! ' ----------------------------'/)
	1718	! 4 FORMAT (' --> Using constant net radiation: net_radiation = ', F6.2, &
	1719	! // 'W/m**2')
	1720	! 5 FORMAT (' --> Simple radiation scheme for clear sky is used (no clouds,', &
	1721	! ' default)')
	1722	! 6 FORMAT (' --> RRTMG scheme is used')
	1723	! 7 FORMAT (/' User-specific surface albedo: albedo =', F6.3)
	1724	! 8 FORMAT (/' Albedo is set for land surface type: ', A)
	1725	! 9 FORMAT (/' --> Albedo is fixed during the run')
	1726	!10 FORMAT (/' --> Longwave radiation is disabled')
	1727	!11 FORMAT (/' --> Shortwave radiation is disabled.')
	1728	!12 FORMAT (' Timestep: dt_radiation = ', F6.2, ' s')
	1729	!
	1730	!
	1731	END SUBROUTINE chem_header
[2668]	1732
	1733	!------------------------------------------------------------------------------
	1734	! Description:
	1735	! ------------
	1736	!> Subroutine reading restart data for chemistry model input parameters
	1737	! (FK: To make restarts work, I had to comment this routine. We actually
	1738	! don't need it, since the namelist parameters are always read in,
	1739	! also in case of a restart run)
	1740	!------------------------------------------------------------------------------
[2894]	1741	! SUBROUTINE chem_rrd_global
	1742	!
	1743	! USE chem_modules
	1744	!
	1745	! USE control_parameters, &
	1746	! ONLY: length, message_string, restart_string
[2668]	1747	!
	1748	!
	1749	! IMPLICIT NONE
	1750	!
	1751	!
	1752	!
[2894]	1753	! DO
[2668]	1754	!
[2894]	1755	! SELECT CASE ( restart_string(1:length) )
[2668]	1756	!
	1757	! CASE ( 'bc_cs_b' )
	1758	! READ ( 13 ) bc_cs_b
[2894]	1759	!
	1760	! CASE DEFAULT
	1761	!
	1762	! EXIT
	1763	!
[2668]	1764	! END SELECT
	1765	!
[2894]	1766	!!
	1767	!!-- Read next string and its length
	1768	! READ ( 13 ) length
	1769	! READ ( 13 ) restart_string(1:length)
[2668]	1770	!
	1771	! ENDDO
	1772	!
[2894]	1773	! END SUBROUTINE chem_rrd_global
[2668]	1774
	1775
	1776	!------------------------------------------------------------------------------!
[2657]	1777	!
[2668]	1778	! Description:
	1779	! ------------
	1780	!> Subroutine writing restart data for chemistry model input parameters
	1781	! (FK: To make restarts work, I had to comment this routine. We actually
	1782	! don't need it, since the namelist parameters are always read in,
	1783	! also in case of a restart run)
[2657]	1784	!------------------------------------------------------------------------------!
[2894]	1785	! SUBROUTINE chem_wrd_global
[2668]	1786	!
	1787	! USE chem_modules
	1788	!
	1789	! USE kinds
	1790	!
	1791	!
	1792	! IMPLICIT NONE
	1793	!
	1794	! INTEGER(iwp) :: lsp !< running index for chem spcs
	1795	!
	1796	! !
[2932]	1797	! !-- Writing out input parameters that are not part of chemistry_parameters
	1798	! !-- namelist (namelist parameters are anyway read in again in case of restart)
[2668]	1799	! DO lsp = 1, nvar
[2894]	1800	! CALL wrd_write_string( 'conc_pr_init_'//chem_species(lsp)%name )
[2668]	1801	! WRITE ( 14 ) chem_species(lsp)%conc_pr_init
	1802	! ENDDO
	1803	!
	1804	!
[2894]	1805	! END SUBROUTINE chem_wrd_global
[2668]	1806
	1807
	1808	!------------------------------------------------------------------------------!
[2657]	1809	!
	1810	! Description:
	1811	! ------------
[2668]	1812	!> Subroutine for emission
[2657]	1813	!------------------------------------------------------------------------------!
[2668]	1814	SUBROUTINE chem_emissions
[2657]	1815
[2668]	1816	USE chem_modules
	1817
	1818	USE netcdf_data_input_mod, &
	1819	ONLY: street_type_f
	1820
	1821	USE surface_mod, &
	1822	ONLY: surf_lsm_h
[2657]	1823
	1824
[2668]	1825	IMPLICIT NONE
[2657]	1826
[2678]	1827	INTEGER(iwp) :: i !< running index for grid in x-direction
	1828	INTEGER(iwp) :: j !< running index for grid in y-direction
	1829	INTEGER(iwp) :: m !< running index for horizontal surfaces
[2668]	1830	INTEGER(iwp) :: lsp !< running index for chem spcs
[2657]	1831
[2668]	1832	!
	1833	!-- Comment??? (todo)
[2678]	1834	IF ( street_type_f%from_file ) THEN
	1835	!
	1836	!-- Streets are lsm surfaces, hence, no usm surface treatment required
	1837	DO m = 1, surf_lsm_h%ns
	1838	i = surf_lsm_h%i(m)
	1839	j = surf_lsm_h%j(m)
	1840
	1841	IF ( street_type_f%var(j,i) >= main_street_id .AND. &
	1842	street_type_f%var(j,i) < max_street_id ) THEN
	1843	DO lsp = 1, nvar
	1844	surf_lsm_h%cssws(lsp,m) = emiss_factor_main * surface_csflux(lsp)
	1845	ENDDO
	1846	ELSEIF ( street_type_f%var(j,i) >= side_street_id .AND. &
	1847	street_type_f%var(j,i) < main_street_id ) THEN
	1848	DO lsp = 1, nvar
	1849	surf_lsm_h%cssws(lsp,m) = emiss_factor_side * surface_csflux(lsp)
	1850	ENDDO
[2682]	1851	ELSE
	1852	surf_lsm_h%cssws(:,m) = 0.0_wp
[2678]	1853	ENDIF
	1854	ENDDO
	1855
	1856	ENDIF
[2657]	1857
[2668]	1858	END SUBROUTINE chem_emissions
[2657]	1859
	1860
	1861	END MODULE chemistry_model_mod
	1862

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |