Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_tools_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_Tools\_Mod contains a collection of helper
9 : ! routines for the HEMCO extensions.
10 : !\\
11 : !\\
12 : ! !INTERFACE:
13 : !
14 : MODULE HCOX_TOOLS_MOD
15 : !
16 : ! !USES:
17 : !
18 : USE HCO_ERROR_MOD
19 :
20 : IMPLICIT NONE
21 : PRIVATE
22 : !
23 : ! !PUBLIC MEMBER FUNCTIONS:
24 : !
25 : PUBLIC :: HCOX_SCALE
26 : !
27 : ! !MODULE VARIABLES:
28 : !
29 : CHARACTER(LEN=31), PARAMETER, PUBLIC :: HCOX_NOSCALE = 'none'
30 : !
31 : ! !PRIVATE MEMBER FUNCTIONS:
32 : !
33 : ! !REVISION HISTORY:
34 : ! 11 Jun 2015 - C. Keller - Initial version
35 : ! See https://github.com/geoschem/hemco for complete history
36 : !EOP
37 : !-----------------------------------------------------------------------------
38 : !BOC
39 : !
40 : ! !MODULE INTERFACES:
41 : !
42 : INTERFACE HCOX_SCALE
43 : MODULE PROCEDURE HCOX_SCALE_sp2D
44 : MODULE PROCEDURE HCOX_SCALE_sp3D
45 : MODULE PROCEDURE HCOX_SCALE_dp2D
46 : MODULE PROCEDURE HCOX_SCALE_dp3D
47 : END INTERFACE HCOX_SCALE
48 :
49 : CONTAINS
50 : !EOC
51 : !------------------------------------------------------------------------------
52 : ! Harmonized Emissions Component (HEMCO) !
53 : !------------------------------------------------------------------------------
54 : !BOP
55 : !
56 : ! !ROUTINE: HCOX_SCALE_sp2D
57 : !
58 : ! !DESCRIPTION: Applies mask `SCALENAME` to the passed 2D sp field.
59 : !\\
60 : !\\
61 : ! !INTERFACE:
62 : !
63 0 : SUBROUTINE HCOX_SCALE_sp2D( HcoState, Arr, SCALENAME, RC )
64 : !
65 : ! !USES:
66 : !
67 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
68 : USE HCO_STATE_MOD, ONLY : HCO_State
69 : !
70 : ! !INPUT PARAMETERS:
71 : !
72 : TYPE(HCO_STATE), POINTER :: HcoState ! HcoState obj
73 : CHARACTER(LEN=*), INTENT(IN ) :: SCALENAME ! SCALE to be used
74 : !
75 : ! !INPUT/OUTPUT PARAMETERS:
76 : !
77 : REAL(sp), INTENT(INOUT) :: Arr(:,:) ! Array to be scaled
78 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
79 : !
80 : ! !REVISION HISTORY:
81 : ! 11 Jun 2013 - C. Keller - Initial version
82 : ! See https://github.com/geoschem/hemco for complete history
83 : !EOP
84 : !------------------------------------------------------------------------------
85 : !BOC
86 : !
87 : ! !LOCAL VARIABLES:
88 : !
89 0 : REAL(hp) :: SCAL(HcoState%NX,HcoState%NY)
90 : CHARACTER(LEN=255) :: LOC
91 :
92 : !======================================================================
93 : ! HCOX_SCALE_sp2D begins here
94 : !======================================================================
95 0 : LOC = 'HCOX_SCALE_sp2D (HCOX_TOOLS_MOD.F90)'
96 :
97 0 : IF ( TRIM(SCALENAME) /= TRIM(HCOX_NOSCALE) ) THEN
98 :
99 : ! Get mask field
100 0 : CALL HCO_EvalFld ( HcoState, TRIM(SCALENAME), SCAL, RC )
101 0 : IF ( RC /= HCO_SUCCESS ) THEN
102 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
103 0 : RETURN
104 : ENDIF
105 :
106 : ! Set array to zero outside of mask region
107 0 : Arr = Arr * SCAL
108 : ENDIF
109 :
110 : ! Return w/ success
111 0 : RC = HCO_SUCCESS
112 :
113 : END SUBROUTINE HCOX_SCALE_sp2D
114 : !EOC
115 : !------------------------------------------------------------------------------
116 : ! Harmonized Emissions Component (HEMCO) !
117 : !------------------------------------------------------------------------------
118 : !BOP
119 : !
120 : ! !ROUTINE: HCOX_SCALE_sp3D
121 : !
122 : ! !DESCRIPTION: Applies mask `SCALENAME` to the passed 3D sp field.
123 : !\\
124 : !\\
125 : ! !INTERFACE:
126 : !
127 0 : SUBROUTINE HCOX_SCALE_sp3D( HcoState, Arr, SCALENAME, RC )
128 : !
129 : ! !USES:
130 : !
131 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
132 : USE HCO_STATE_MOD, ONLY : HCO_State
133 : !
134 : ! !INPUT PARAMETERS:
135 : !
136 : TYPE(HCO_STATE), POINTER :: HcoState ! HcoState obj
137 : CHARACTER(LEN=*), INTENT(IN ) :: SCALENAME ! SCALE to be used
138 : !
139 : ! !INPUT/OUTPUT PARAMETERS:
140 : !
141 : REAL(sp), INTENT(INOUT) :: Arr(:,:,:) ! Array to be scaled
142 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
143 : !
144 : ! !REVISION HISTORY:
145 : ! 11 Jun 2013 - C. Keller - Initial version
146 : ! See https://github.com/geoschem/hemco for complete history
147 : !EOP
148 : !------------------------------------------------------------------------------
149 : !BOC
150 : !
151 : ! !LOCAL VARIABLES:
152 : !
153 0 : REAL(hp) :: SCAL(HcoState%NX,HcoState%NY)
154 : INTEGER :: I, NZ
155 : CHARACTER(LEN=255) :: LOC
156 :
157 : !======================================================================
158 : ! HCOX_SCALE_sp3D begins here
159 : !======================================================================
160 0 : LOC = 'HCOX_SCALE_sp3D (HCOX_TOOLS_MOD.F90)'
161 :
162 0 : IF ( TRIM(SCALENAME) /= TRIM(HCOX_NOSCALE) ) THEN
163 :
164 : ! Get mask field
165 0 : CALL HCO_EvalFld ( HcoState, TRIM(SCALENAME), SCAL, RC )
166 0 : IF ( RC /= HCO_SUCCESS ) THEN
167 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
168 0 : RETURN
169 : ENDIF
170 :
171 : ! Number of levels
172 0 : NZ = SIZE(Arr,3)
173 :
174 0 : DO I = 1, NZ
175 0 : Arr(:,:,I) = Arr(:,:,1) * SCAL
176 : ENDDO
177 :
178 : ENDIF
179 :
180 : ! Return w/ success
181 0 : RC = HCO_SUCCESS
182 :
183 : END SUBROUTINE HCOX_SCALE_sp3D
184 : !EOC
185 : !------------------------------------------------------------------------------
186 : ! Harmonized Emissions Component (HEMCO) !
187 : !------------------------------------------------------------------------------
188 : !BOP
189 : !
190 : ! !ROUTINE: HCOX_SCALE_dp2D
191 : !
192 : ! !DESCRIPTION: Applies mask `SCALENAME` to the passed 2D dp field.
193 : !\\
194 : !\\
195 : ! !INTERFACE:
196 : !
197 0 : SUBROUTINE HCOX_SCALE_dp2D( HcoState, Arr, SCALENAME, RC )
198 : !
199 : ! !USES:
200 : !
201 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
202 : USE HCO_STATE_MOD, ONLY : HCO_State
203 : !
204 : ! !INPUT PARAMETERS:
205 : !
206 : TYPE(HCO_STATE), POINTER :: HcoState ! HcoState obj
207 : CHARACTER(LEN=*), INTENT(IN ) :: SCALENAME ! SCALE to be used
208 : !
209 : ! !INPUT/OUTPUT PARAMETERS:
210 : !
211 : REAL(dp), INTENT(INOUT) :: Arr(:,:) ! Array to be scaled
212 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
213 : !
214 : ! !REVISION HISTORY:
215 : ! 11 Jun 2013 - C. Keller - Initial version
216 : ! See https://github.com/geoschem/hemco for complete history
217 : !EOP
218 : !------------------------------------------------------------------------------
219 : !BOC
220 : !
221 : ! !LOCAL VARIABLES:
222 : !
223 0 : REAL(hp) :: SCAL(HcoState%NX,HcoState%NY)
224 : CHARACTER(LEN=255) :: LOC
225 :
226 : !======================================================================
227 : ! HCOX_SCALE_dp2D begins here
228 : !======================================================================
229 0 : LOC = 'HCOX_SCALE_dp2D (HCOX_TOOLS_MOD.F90)'
230 :
231 0 : IF ( TRIM(SCALENAME) /= TRIM(HCOX_NOSCALE) ) THEN
232 :
233 : ! Get mask field
234 0 : CALL HCO_EvalFld ( HcoState, TRIM(SCALENAME), SCAL, RC )
235 0 : IF ( RC /= HCO_SUCCESS ) THEN
236 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
237 0 : RETURN
238 : ENDIF
239 :
240 : ! Set array to zero outside of mask region
241 0 : Arr = Arr * SCAL
242 :
243 : ENDIF
244 :
245 : ! Return w/ success
246 0 : RC = HCO_SUCCESS
247 :
248 : END SUBROUTINE HCOX_SCALE_dp2D
249 : !EOC
250 : !------------------------------------------------------------------------------
251 : ! Harmonized Emissions Component (HEMCO) !
252 : !------------------------------------------------------------------------------
253 : !BOP
254 : !
255 : ! !ROUTINE: HCOX_SCALE_dp3D
256 : !
257 : ! !DESCRIPTION: Applies mask `SCALENAME` to the passed 3D dp field.
258 : !\\
259 : !\\
260 : ! !INTERFACE:
261 : !
262 0 : SUBROUTINE HCOX_SCALE_dp3D( HcoState, Arr, SCALENAME, RC )
263 : !
264 : ! !USES:
265 : !
266 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
267 : USE HCO_STATE_MOD, ONLY : HCO_State
268 : !
269 : ! !INPUT PARAMETERS:
270 : !
271 : TYPE(HCO_STATE), POINTER :: HcoState ! HcoState obj
272 : CHARACTER(LEN=*), INTENT(IN ) :: SCALENAME ! SCALE to be used
273 : !
274 : ! !INPUT/OUTPUT PARAMETERS:
275 : !
276 : REAL(dp), INTENT(INOUT) :: Arr(:,:,:) ! Array to be scaled
277 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
278 : !
279 : ! !REVISION HISTORY:
280 : ! 11 Jun 2013 - C. Keller - Initial version
281 : ! See https://github.com/geoschem/hemco for complete history
282 : !EOP
283 : !------------------------------------------------------------------------------
284 : !BOC
285 : !
286 : ! !LOCAL VARIABLES:
287 : !
288 0 : REAL(hp) :: SCAL(HcoState%NX,HcoState%NY)
289 : INTEGER :: I, NZ
290 : CHARACTER(LEN=255) :: LOC
291 :
292 : !======================================================================
293 : ! HCOX_SCALE_dp3D begins here
294 : !======================================================================
295 0 : LOC = 'HCOX_SCALE_dp3D (HCOX_TOOLS_MOD.F90)'
296 :
297 0 : IF ( TRIM(SCALENAME) /= TRIM(HCOX_NOSCALE) ) THEN
298 :
299 : ! Get mask field
300 0 : CALL HCO_EvalFld ( HcoState, TRIM(SCALENAME), SCAL, RC )
301 0 : IF ( RC /= HCO_SUCCESS ) THEN
302 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
303 0 : RETURN
304 : ENDIF
305 :
306 : ! Number of levels
307 0 : NZ = SIZE(Arr,3)
308 0 : DO I = 1, NZ
309 0 : Arr(:,:,I) = Arr(:,:,1) * SCAL
310 : ENDDO
311 : ENDIF
312 :
313 : ! Return w/ success
314 0 : RC = HCO_SUCCESS
315 :
316 : END SUBROUTINE HCOX_SCALE_dp3D
317 : !EOC
318 : END MODULE HCOX_TOOLS_MOD
|