source: palm/trunk/SOURCE/salsa_util_mod.f90 @ 3870

Last change on this file since 3870 was 3864, checked in by monakurppa, 5 years ago

major changes in salsa: data input, format and performance

  • Time-dependent emissions enabled: lod=1 for yearly PM emissions that are normalised depending on the time, and lod=2 for preprocessed emissions (similar to the chemistry module).
  • Additionally, 'uniform' emissions allowed. This emission is set constant on all horisontal upward facing surfaces and it is created based on parameters surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
  • All emissions are now implemented as surface fluxes! No 3D sources anymore.
  • Update the emission information by calling salsa_emission_update if skip_time_do_salsa >= time_since_reference_point and next_aero_emission_update <= time_since_reference_point
  • Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid must match the one applied in the model.
  • Gas emissions and background concentrations can be also read in in salsa_mod if the chemistry module is not applied.
  • In deposition, information on the land use type can be now imported from the land use model
  • Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
  • Apply 100 character line limit
  • Change all variable names from capital to lowercase letter
  • Change real exponents to integer if possible. If not, precalculate the value of exponent
  • Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
  • Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast --> ngases_salsa
  • Rename ibc to index_bc, idu to index_du etc.
  • Renamed loop indices b, c and sg to ib, ic and ig
  • run_salsa subroutine removed
  • Corrected a bud in salsa_driver: falsely applied ino instead of inh
  • Call salsa_tendency within salsa_prognostic_equations which is called in module_interface_mod instead of prognostic_equations_mod
  • Removed tailing white spaces and unused variables
  • Change error message to start by PA instead of SA
  • Property svn:keywords set to Id
File size: 5.4 KB
Line 
1!> @file salsa_util_mod.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM-4U.
4!
5! PALM-4U 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-4U 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!
17! Copyright 1997-2019 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: salsa_util_mod.f90 3864 2019-04-05 09:01:56Z knoop $
27! Formatting changes
28!
29! 3845 2019-04-01 13:41:55Z monakurppa
30! Initial revision
31!
32!
33!
34! Authors:
35! --------
36! @author monakurppa
37!
38!
39! Description:
40! ------------
41!> Utility functions used in salsa_mod.
42!------------------------------------------------------------------------------!
43 MODULE salsa_util_mod
44
45    USE control_parameters,                                                                        &
46        ONLY:  message_string
47
48    USE kinds
49
50    USE pegrid
51
52    IMPLICIT NONE
53
54    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  sums_salsa_ws_l !< subdomain sum of vertical salsa
55                                                              !< flux w's' (5th-order advection
56                                                              !< scheme only)
57!
58!-- Component index
59    TYPE component_index
60       INTEGER(iwp) ::  ncomp  !< Number of components
61       INTEGER(iwp), ALLOCATABLE ::  ind(:)  !< Component index
62       CHARACTER(len=3), ALLOCATABLE ::  comp(:)  !< Component name
63    END TYPE component_index
64
65    SAVE
66
67    INTERFACE component_index_constructor
68       MODULE PROCEDURE component_index_constructor
69    END INTERFACE component_index_constructor
70
71    INTERFACE get_index
72       MODULE PROCEDURE get_index
73    END INTERFACE get_index
74
75    INTERFACE is_used
76       MODULE PROCEDURE is_used
77    END INTERFACE is_used
78
79    PRIVATE
80    PUBLIC component_index, component_index_constructor, get_index, is_used, sums_salsa_ws_l
81
82 CONTAINS
83
84!------------------------------------------------------------------------------!
85! Description:
86! ------------
87!> Creates index tables for different (aerosol) components
88!------------------------------------------------------------------------------!
89    SUBROUTINE component_index_constructor( self, ncomp, nlist, listcomp )
90
91       IMPLICIT NONE
92
93       INTEGER(iwp) ::  i   !<
94       INTEGER(iwp) ::  jj  !<
95
96       INTEGER(iwp), INTENT(in) ::  nlist ! < Maximum number of components
97
98       INTEGER(iwp), INTENT(inout) ::  ncomp  !< Number of components
99
100       TYPE(component_index), INTENT(inout) ::  self  !< Object containing the indices of different
101                                                      !< aerosol components
102       CHARACTER(len=3), INTENT(in) ::  listcomp(nlist)  !< List cof component names
103
104       ncomp = 0
105
106       DO WHILE ( listcomp(ncomp+1) /= '  ' .AND. ncomp < nlist )
107          ncomp = ncomp + 1
108       ENDDO
109
110       self%ncomp = ncomp
111       ALLOCATE( self%ind(ncomp), self%comp(ncomp) )
112
113       DO  i = 1, ncomp
114          self%ind(i) = i
115       ENDDO
116
117       jj = 1
118       DO  i = 1, nlist
119          IF ( listcomp(i) == '') CYCLE
120          self%comp(jj) = listcomp(i)
121          jj = jj + 1
122       ENDDO
123
124    END SUBROUTINE component_index_constructor
125
126!------------------------------------------------------------------------------!
127! Description:
128! ------------
129!> Gives the index of a component in the component list
130!------------------------------------------------------------------------------!
131    INTEGER FUNCTION get_index( self, incomp )
132
133       IMPLICIT NONE
134
135       CHARACTER(len=*), INTENT(in) ::  incomp !< Component name
136       INTEGER(iwp) ::  i
137
138       TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
139                                                   !< aerosol components
140       IF ( ANY( self%comp == incomp ) ) THEN
141          i = 1
142          DO WHILE ( (self%comp(i) /= incomp) )
143             i = i + 1
144          ENDDO
145          get_index = i
146       ELSEIF ( incomp == 'H2O' ) THEN
147          get_index = self%ncomp + 1
148       ELSE
149          WRITE( message_string, * ) 'Incorrect component name given!'
150          CALL message( 'get_index', 'PA0591', 1, 2, 0, 6, 0 )
151       ENDIF
152
153       RETURN
154
155    END FUNCTION get_index
156
157!------------------------------------------------------------------------------!
158! Description:
159! ------------
160!> Tells if the (aerosol) component is being used in the simulation
161!------------------------------------------------------------------------------!
162    LOGICAL FUNCTION is_used( self, icomp )
163
164       IMPLICIT NONE
165
166       CHARACTER(len=*), INTENT(in) ::  icomp !< Component name
167
168       TYPE(component_index), INTENT(in) ::  self  !< Object containing the indices of different
169                                                   !< aerosol components
170
171       IF ( ANY(self%comp == icomp) ) THEN
172          is_used = .TRUE.
173       ELSE
174          is_used = .FALSE.
175       ENDIF
176
177    END FUNCTION
178
179 END MODULE salsa_util_mod
Note: See TracBrowser for help on using the repository browser.