Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_fluxarr_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_FluxArr\_Mod contains routines to handle
9 : ! the HEMCO flux arrays. These are the emissions and deposition arrays
10 : ! listed in the HEMCO state object.
11 : !\\
12 : !\\
13 : ! !INTERFACE:
14 : !
15 : MODULE HCO_FluxArr_Mod
16 : !
17 : ! USES:
18 : !
19 : USE HCO_Error_Mod
20 : USE HCO_Arr_Mod
21 : USE HCO_Scale_Mod
22 : USE HCO_State_Mod, ONLY : HCO_State
23 :
24 : IMPLICIT NONE
25 : PRIVATE
26 : !
27 : ! !PUBLIC MEMBER FUNCTIONS:
28 : !
29 : PUBLIC :: HCO_EmisAdd
30 : PUBLIC :: HCO_DepvAdd
31 : PUBLIC :: HCO_FluxarrReset
32 : !
33 : ! !PRIVATE MEMBER FUNCTIONS:
34 : !
35 : PRIVATE :: DiagnCheck
36 : !
37 : ! !REMARKS:
38 : !
39 : ! !REVISION HISTORY:
40 : ! 05 Jan 2014 - C. Keller - Initial version, adapted from hco_state_mod.F90
41 : ! See https://github.com/geoschem/hemco for complete history
42 : !EOP
43 : !------------------------------------------------------------------------------
44 : !BOC
45 : !
46 : ! !PRIVATE TYPES:
47 : !
48 : INTERFACE HCO_EmisAdd
49 : MODULE PROCEDURE HCO_EmisAdd_3D_Dp
50 : MODULE PROCEDURE HCO_EmisAdd_3D_Sp
51 : MODULE PROCEDURE HCO_EmisAdd_2D_Sp
52 : MODULE PROCEDURE HCO_EmisAdd_2D_Dp
53 : MODULE PROCEDURE HCO_EmisAdd_Dp
54 : MODULE PROCEDURE HCO_EmisAdd_Sp
55 : END INTERFACE
56 :
57 : INTERFACE HCO_DepvAdd
58 : MODULE PROCEDURE HCO_DepvAdd_2D_Sp
59 : MODULE PROCEDURE HCO_DepvAdd_2D_Dp
60 : MODULE PROCEDURE HCO_DepvAdd_Dp
61 : MODULE PROCEDURE HCO_DepvAdd_Sp
62 : END INTERFACE
63 :
64 : CONTAINS
65 : !EOC
66 : !------------------------------------------------------------------------------
67 : ! Harmonized Emissions Component (HEMCO) !
68 : !------------------------------------------------------------------------------
69 : !BOP
70 : !
71 : ! !IROUTINE: HCO_FluxarrReset
72 : !
73 : ! !DESCRIPTION: Routine HCO\_FluxarrReset (re)sets all data arrays
74 : ! of the passed HEMCO state object. The (optional) argument Typ
75 : ! indicates whether only emissions (1), deposition (2), or concentration
76 : ! (3) arrays shall be reset. To reset all, set Typ to 0 (default).
77 : !\\
78 : !\\
79 : ! !INTERFACE:
80 : !
81 0 : SUBROUTINE HCO_FluxarrReset( HcoState, RC, Typ )
82 : !
83 : ! !INPUT/OUTPUT PARAMETERS:
84 : !
85 : TYPE(HCO_State), POINTER :: HcoState
86 : INTEGER, INTENT(INOUT) :: RC
87 : !
88 : ! !INPUT PARAMETERS:
89 : !
90 : INTEGER, INTENT(IN ), OPTIONAL :: Typ
91 : !
92 : ! !REMARKS:
93 : !
94 : ! !REVISION HISTORY:
95 : ! 01 May 2013 - C. Keller - Initial version
96 : ! See https://github.com/geoschem/hemco for complete history
97 : !EOP
98 : !------------------------------------------------------------------------------
99 : !BOC
100 : INTEGER :: N, thisTyp
101 :
102 : !=====================================================================
103 : ! HCO_FluxarrReset begins here!
104 : !=====================================================================
105 :
106 : ! Set local flux direction flag
107 0 : IF ( PRESENT(Typ) ) THEN
108 0 : thisTyp = Typ
109 : ELSE
110 : thisTyp = 0
111 : ENDIF
112 :
113 : ! Loop over all arrays.
114 0 : DO N = 1, HcoState%nSpc
115 :
116 : ! 3D flux rates array
117 0 : IF ( thisTyp == 0 .OR. thisTyp == 1 ) THEN
118 0 : IF ( ASSOCIATED(HcoState%Spc(N)%Emis) ) THEN
119 0 : IF ( ASSOCIATED(HcoState%Spc(N)%Emis%Val) ) THEN
120 0 : HcoState%Spc(N)%Emis%Val = 0.0_hp
121 : ENDIF
122 : ENDIF
123 : ENDIF
124 :
125 : ! 2D deposition velocity array
126 0 : IF ( thisTyp == 0 .OR. thisTyp == 2 ) THEN
127 0 : IF ( ASSOCIATED(HcoState%Spc(N)%Depv) ) THEN
128 0 : IF ( ASSOCIATED(HcoState%Spc(N)%Depv%Val) ) THEN
129 0 : HcoState%Spc(N)%Depv%Val = 0.0_hp
130 : ENDIF
131 : ENDIF
132 : ENDIF
133 :
134 : ! 3D concentrations
135 0 : IF ( thisTyp == 0 .OR. thisTyp == 3 ) THEN
136 0 : IF ( ASSOCIATED(HcoState%Spc(N)%Conc) ) THEN
137 0 : IF ( ASSOCIATED(HcoState%Spc(N)%Conc%Val) ) THEN
138 0 : HcoState%Spc(N)%Conc%Val = 0.0_hp
139 : ENDIF
140 : ENDIF
141 : ENDIF
142 :
143 : ENDDO
144 :
145 : ! Return w/ success
146 0 : RC = HCO_SUCCESS
147 :
148 0 : END SUBROUTINE HCO_FluxarrReset
149 : !EOC
150 : !------------------------------------------------------------------------------
151 : ! Harmonized Emissions Component (HEMCO) !
152 : !------------------------------------------------------------------------------
153 : !BOP
154 : !
155 : ! !IROUTINE: HCO_EmisAdd_3D_Dp
156 : !
157 : ! !DESCRIPTION: Routine HCO\_EmisAdd\_3D adds the 3D-array Arr3D
158 : ! to the emissions array of species HcoID in HEMCO object HcoState.
159 : ! This routine also updates all autofill diagnostics that are defined
160 : ! for the givne species, extension number, emission category and
161 : ! hierarchy.
162 : !\\
163 : !\\
164 : ! !INTERFACE:
165 : !
166 0 : SUBROUTINE HCO_EmisAdd_3D_Dp( HcoState, Arr3D, HcoID, &
167 : RC, ExtNr, Cat, Hier, &
168 : MinDiagnLev )
169 : !
170 : ! !INPUT/OUTPUT PARAMETERS:
171 : !
172 : TYPE(HCO_State), POINTER :: HcoState
173 : REAL(dp), INTENT(INOUT) :: Arr3D( HcoState%NX, &
174 : HcoState%NY, &
175 : HcoState%NZ )
176 : INTEGER, INTENT(INOUT) :: RC
177 : !
178 : ! !INPUT PARAMETERS:
179 : !
180 : INTEGER, INTENT(IN ) :: HcoID
181 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr
182 : INTEGER, INTENT(IN ), OPTIONAL :: Cat
183 : INTEGER, INTENT(IN ), OPTIONAL :: Hier
184 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev
185 : !
186 : ! !REVISION HISTORY:
187 : ! 01 May 2013 - C. Keller - Initial version
188 : ! See https://github.com/geoschem/hemco for complete history
189 : !EOP
190 : !------------------------------------------------------------------------------
191 : !BOC
192 : !
193 : ! !LOCAL VARIABLES:
194 : !
195 : CHARACTER(LEN=255) :: LOC
196 :
197 : !=====================================================================
198 : ! HCO_EmisAdd_3D_Dp begins here!
199 : !=====================================================================
200 0 : LOC = 'HCO_EmisAdd_3D_Dp (HCO_FLUXARR_MOD.F90)'
201 :
202 : ! Make sure target flux array in HcoState is allocated
203 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Emis, &
204 0 : HcoState%NX, HcoState%NY, HcoState%NZ, RC )
205 0 : IF ( RC /=HCO_SUCCESS ) RETURN
206 :
207 : ! Check for negative values. NegFlag determines the behavior for
208 : ! negative values: 2 = allow; 1 = set to zero + warning; 0 = error.
209 0 : IF ( HcoState%Options%NegFlag /= 2 ) THEN
210 0 : IF ( ANY( Arr3D < 0.0_hp ) ) THEN
211 :
212 : ! Negative flag is 1: set to zero and prompt warning
213 0 : IF ( HcoState%Options%NegFlag == 1 ) THEN
214 0 : WHERE ( Arr3D < 0.0_hp ) Arr3D = 0.0_hp
215 : CALL HCO_WARNING ( HcoState%Config%Err, &
216 : 'Negative values found - set to zero!', &
217 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
218 :
219 : ! Negative flag is 0: return w/ error
220 : ELSE
221 : CALL HCO_ERROR ( &
222 : 'Negative values found!', &
223 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
224 0 : RETURN
225 : ENDIF
226 : ENDIF
227 : ENDIF
228 :
229 : ! Eventually add universal scale factor
230 0 : CALL HCO_ScaleArr( HcoState, HcoID, Arr3D, RC )
231 0 : IF ( RC /= HCO_SUCCESS ) THEN
232 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
233 0 : RETURN
234 : ENDIF
235 :
236 : ! Add array
237 : HcoState%Spc(HcoID)%Emis%Val(:,:,:) = &
238 0 : HcoState%Spc(HcoID)%Emis%Val(:,:,:) + Arr3D(:,:,:)
239 :
240 : ! Check for diagnostics
241 : CALL DiagnCheck( HcoState, ExtNr=ExtNr, Cat=Cat, &
242 : Hier=Hier, HcoID=HcoID, Arr3D=Arr3D, &
243 0 : MinDiagnLev=MinDiagnLev, RC=RC )
244 0 : IF ( RC /= HCO_SUCCESS ) THEN
245 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
246 0 : RETURN
247 : ENDIF
248 :
249 : ! Return w/ success
250 0 : RC = HCO_SUCCESS
251 :
252 : END SUBROUTINE HCO_EmisAdd_3D_Dp
253 : !EOC
254 : !------------------------------------------------------------------------------
255 : ! Harmonized Emissions Component (HEMCO) !
256 : !------------------------------------------------------------------------------
257 : !BOP
258 : !
259 : ! !IROUTINE: HCO_EmisAdd_3D_Sp
260 : !
261 : ! !DESCRIPTION: Routine HCO\_EmisAdd\_3D adds the 3D-array Arr3D to the
262 : ! emissions array of species HcoID in HEMCO object HcoState.
263 : ! This routine also updates all autofill diagnostics that are defined
264 : ! for the givne species, extension number, emission category and
265 : ! hierarchy.
266 : !\\
267 : !\\
268 : ! !INTERFACE:
269 : !
270 0 : SUBROUTINE HCO_EmisAdd_3D_Sp ( HcoState, Arr3D, HcoID, &
271 : RC, ExtNr, Cat, Hier, &
272 : MinDiagnLev )
273 : !
274 : ! !INPUT/OUTPUT PARAMETERS:
275 : !
276 : TYPE(HCO_State), POINTER :: HcoState
277 : REAL(sp), INTENT(INOUT) :: Arr3D( HcoState%NX, &
278 : HcoState%NY, &
279 : HcoState%NZ )
280 : INTEGER, INTENT(INOUT) :: RC
281 : !
282 : ! !INPUT PARAMETERS:
283 : !
284 : INTEGER, INTENT(IN ) :: HcoID
285 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr
286 : INTEGER, INTENT(IN ), OPTIONAL :: Cat
287 : INTEGER, INTENT(IN ), OPTIONAL :: Hier
288 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev
289 : !
290 : ! !REVISION HISTORY:
291 : ! 01 May 2013 - C. Keller - Initial version
292 : ! See https://github.com/geoschem/hemco for complete history
293 : !EOP
294 : !------------------------------------------------------------------------------
295 : !BOC
296 : !
297 : ! !LOCAL VARIABLES:
298 : !
299 : CHARACTER(LEN=255) :: LOC
300 :
301 : !=====================================================================
302 : ! HCO_EmisAdd_3D_Sp begins here!
303 : !=====================================================================
304 0 : LOC = 'HCO_EmisAdd_3D_Sp (HCO_FLUXARR_MOD.F90)'
305 :
306 : ! Make sure target flux array in HcoState is allocated
307 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Emis, &
308 0 : HcoState%NX, HcoState%NY, HcoState%NZ, RC )
309 0 : IF ( RC /=HCO_SUCCESS ) RETURN
310 :
311 : ! Check for negative values. NegFlag determines the behavior for
312 : ! negative values: 2 = allow; 1 = set to zero + warning; 0 = error.
313 0 : IF ( HcoState%Options%NegFlag /= 2 ) THEN
314 0 : IF ( ANY( Arr3D < 0.0_sp ) ) THEN
315 :
316 : ! Negative flag is 1: set to zero and prompt warning
317 0 : IF ( HcoState%Options%NegFlag == 1 ) THEN
318 0 : WHERE ( Arr3D < 0.0_sp ) Arr3D = 0.0_sp
319 : CALL HCO_WARNING ( HcoState%Config%Err, &
320 : 'Negative values found - set to zero!', &
321 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
322 :
323 : ! Negative flag is 0: return w/ error
324 : ELSE
325 : CALL HCO_ERROR ( &
326 : 'Negative values found!', &
327 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
328 0 : RETURN
329 : ENDIF
330 : ENDIF
331 : ENDIF
332 :
333 : ! Eventually add universal scale factor
334 0 : CALL HCO_ScaleArr( HcoState, HcoID, Arr3D, RC )
335 0 : IF ( RC /= HCO_SUCCESS ) THEN
336 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
337 0 : RETURN
338 : ENDIF
339 :
340 : ! Add array
341 : HcoState%Spc(HcoID)%Emis%Val(:,:,:) = &
342 0 : HcoState%Spc(HcoID)%Emis%Val(:,:,:) + Arr3D(:,:,:)
343 :
344 : ! Check for diagnostics
345 : CALL DiagnCheck( HcoState, ExtNr=ExtNr, Cat=Cat, &
346 : Hier=Hier, HcoID=HcoID, Arr3Dsp=Arr3D, &
347 0 : MinDiagnLev=MinDiagnLev, RC=RC )
348 0 : IF ( RC /= HCO_SUCCESS ) THEN
349 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
350 0 : RETURN
351 : ENDIF
352 :
353 : ! Return w/ success
354 0 : RC = HCO_SUCCESS
355 :
356 : END SUBROUTINE HCO_EmisAdd_3D_Sp
357 : !EOC
358 : !------------------------------------------------------------------------------
359 : ! Harmonized Emissions Component (HEMCO) !
360 : !------------------------------------------------------------------------------
361 : !BOP
362 : !
363 : ! !IROUTINE: HCO_EmisAdd_2D_Dp
364 : !
365 : ! !DESCRIPTION: Routine HCO\_EmisAdd\_2D\_Dp adds the real*8 2D-array Arr2D
366 : ! to the emission array of species HcoID in HEMCO object HcoState.
367 : ! This routine also updates all autofill diagnostics that are defined
368 : ! for the givne species, extension number, emission category and
369 : ! hierarchy.
370 : !\\
371 : !\\
372 : ! !INTERFACE:
373 : !
374 0 : SUBROUTINE HCO_EmisAdd_2D_Dp( HcoState, Arr2D, HcoID, &
375 : RC, ExtNr, Cat, Hier, &
376 : MinDiagnLev )
377 : !
378 : ! !INPUT/OUTPUT PARAMETERS:
379 : !
380 : TYPE(HCO_State), POINTER :: HcoState
381 : REAL(dp), INTENT(INOUT) :: Arr2D(HcoState%NX,HcoState%NY)
382 : INTEGER, INTENT(INOUT) :: RC
383 : !
384 : ! !INPUT PARAMETERS:
385 : !
386 : INTEGER, INTENT(IN ) :: HcoID
387 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr
388 : INTEGER, INTENT(IN ), OPTIONAL :: Cat
389 : INTEGER, INTENT(IN ), OPTIONAL :: Hier
390 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev
391 : !
392 : ! !REVISION HISTORY:
393 : ! 01 May 2013 - C. Keller - Initial version
394 : ! See https://github.com/geoschem/hemco for complete history
395 : !EOP
396 : !------------------------------------------------------------------------------
397 : !BOC
398 : !
399 : ! !LOCAL VARIABLES:
400 : !
401 : CHARACTER(LEN=255) :: LOC
402 :
403 : !=====================================================================
404 : ! HCO_EmisAdd_2D_Dp begins here!
405 : !=====================================================================
406 0 : LOC = 'HCO_EmisAdd_2D_Dp (HCO_FLUXARR_MOD)'
407 :
408 : ! Make sure target flux array in HcoState is allocated
409 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Emis, &
410 0 : HcoState%NX, HcoState%NY, HcoState%NZ, RC )
411 0 : IF ( RC /=HCO_SUCCESS ) RETURN
412 :
413 : ! Check for negative values. NegFlag determines the behavior for
414 : ! negative values: 2 = allow; 1 = set to zero + warning; 0 = error.
415 0 : IF ( HcoState%Options%NegFlag /= 2 ) THEN
416 0 : IF ( ANY( Arr2D < 0.0_hp ) ) THEN
417 :
418 : ! Negative flag is 1: set to zero and prompt warning
419 0 : IF ( HcoState%Options%NegFlag == 1 ) THEN
420 0 : WHERE ( Arr2D < 0.0_hp ) Arr2D = 0.0_hp
421 : CALL HCO_WARNING ( HcoState%Config%Err, &
422 : 'Negative values found - set to zero!', &
423 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
424 :
425 : ! Negative flag is 0: return w/ error
426 : ELSE
427 : CALL HCO_ERROR ( &
428 : 'Negative values found!', &
429 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
430 0 : RETURN
431 : ENDIF
432 : ENDIF
433 : ENDIF
434 :
435 : ! Eventually add universal scale factor
436 0 : CALL HCO_ScaleArr( HcoState, HcoID, Arr2D, RC )
437 0 : IF ( RC /= HCO_SUCCESS ) THEN
438 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
439 0 : RETURN
440 : ENDIF
441 :
442 : ! Add array
443 : HcoState%Spc(HcoID)%Emis%Val(:,:,1) = &
444 0 : HcoState%Spc(HcoID)%Emis%Val(:,:,1) + Arr2D(:,:)
445 :
446 : ! Check for diagnostics
447 : CALL DiagnCheck( HcoState, ExtNr=ExtNr, Cat=Cat, &
448 : Hier=Hier, HcoID=HcoID, Arr2D=Arr2D, &
449 0 : MinDiagnLev=MinDiagnLev, RC=RC )
450 0 : IF ( RC /= HCO_SUCCESS ) THEN
451 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
452 0 : RETURN
453 : ENDIF
454 :
455 : ! Return w/ success
456 0 : RC = HCO_SUCCESS
457 :
458 : END SUBROUTINE HCO_EmisAdd_2D_Dp
459 : !EOC
460 : !------------------------------------------------------------------------------
461 : ! Harmonized Emissions Component (HEMCO) !
462 : !------------------------------------------------------------------------------
463 : !BOP
464 : !
465 : ! !IROUTINE: HCO_EmisAdd_2D_Sp
466 : !
467 : ! !DESCRIPTION: Routine HCO\_EmisAdd\_2D\_Sp adds the real*4 2D-array Arr2D
468 : ! to the emission array of species HcoID in HEMCO object HcoState.
469 : ! This routine also updates all autofill diagnostics that are defined
470 : ! for the givne species, extension number, emission category and
471 : ! hierarchy.
472 : !\\
473 : !\\
474 : ! !INTERFACE:
475 : !
476 0 : SUBROUTINE HCO_EmisAdd_2D_Sp( HcoState, Arr2D, HcoID, &
477 : RC, ExtNr, Cat, Hier, &
478 : MinDiagnLev )
479 : !
480 : ! !INPUT/OUTPUT PARAMETERS:
481 : !
482 : !
483 : TYPE(HCO_State), POINTER :: HcoState
484 : REAL(sp), INTENT(INOUT) :: Arr2D(HcoState%NX,HcoState%NY)
485 : INTEGER, INTENT(INOUT) :: RC
486 : !
487 : ! !INPUT PARAMETERS:
488 : !
489 : INTEGER, INTENT(IN ) :: HcoID
490 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr
491 : INTEGER, INTENT(IN ), OPTIONAL :: Cat
492 : INTEGER, INTENT(IN ), OPTIONAL :: Hier
493 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev
494 : !
495 : ! !REVISION HISTORY:
496 : ! 01 May 2013 - C. Keller - Initial version
497 : ! See https://github.com/geoschem/hemco for complete history
498 : !EOP
499 : !------------------------------------------------------------------------------
500 : !BOC
501 : !
502 : ! !LOCAL VARIABLES:
503 : !
504 : CHARACTER(LEN=255) :: LOC
505 :
506 : !=====================================================================
507 : ! HCO_EmisAdd_2D_Sp begins here!
508 : !=====================================================================
509 0 : LOC = 'HCO_EmisAdd_2D_Sp (HCO_FLUXARR_MOD.F90)'
510 :
511 : ! Make sure target flux array in HcoState is allocated
512 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Emis, &
513 0 : HcoState%NX, HcoState%NY, HcoState%NZ, RC )
514 0 : IF ( RC /=HCO_SUCCESS ) RETURN
515 :
516 : ! Check for negative values. NegFlag determines the behavior for
517 : ! negative values: 2 = allow; 1 = set to zero + warning; 0 = error.
518 0 : IF ( HcoState%Options%NegFlag /= 2 ) THEN
519 0 : IF ( ANY( Arr2D < 0.0_sp ) ) THEN
520 :
521 : ! Negative flag is 1: set to zero and prompt warning
522 0 : IF ( HcoState%Options%NegFlag == 1 ) THEN
523 0 : WHERE ( Arr2D < 0.0_sp ) Arr2D = 0.0_sp
524 : CALL HCO_WARNING ( HcoState%Config%Err, &
525 : 'Negative values found - set to zero!', &
526 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
527 :
528 : ! Negative flag is 0: return w/ error
529 : ELSE
530 : CALL HCO_ERROR ( &
531 : 'Negative values found!', &
532 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
533 0 : RETURN
534 : ENDIF
535 : ENDIF
536 : ENDIF
537 :
538 : ! Eventually add universal scale factor
539 0 : CALL HCO_ScaleArr( HcoState, HcoID, Arr2D, RC )
540 0 : IF ( RC /= HCO_SUCCESS ) THEN
541 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
542 0 : RETURN
543 : ENDIF
544 :
545 : ! Add array
546 : HcoState%Spc(HcoID)%Emis%Val(:,:,1) = &
547 0 : HcoState%Spc(HcoID)%Emis%Val(:,:,1) + Arr2D(:,:)
548 :
549 : ! Check for diagnostics
550 : CALL DiagnCheck( HcoState, ExtNr=ExtNr, Cat=Cat, &
551 : Hier=Hier, HcoID=HcoID, Arr2Dsp=Arr2D, &
552 0 : MinDiagnLev=MinDiagnLev, RC=RC )
553 0 : IF ( RC /= HCO_SUCCESS ) THEN
554 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
555 0 : RETURN
556 : ENDIF
557 :
558 : ! Return w/ success
559 0 : RC = HCO_SUCCESS
560 :
561 : END SUBROUTINE HCO_EmisAdd_2D_Sp
562 : !EOC
563 : !------------------------------------------------------------------------------
564 : ! Harmonized Emissions Component (HEMCO) !
565 : !------------------------------------------------------------------------------
566 : !BOP
567 : !
568 : ! !IROUTINE: HCO_EmisAdd_Dp
569 : !
570 : ! !DESCRIPTION: Routine HCO\_EmisAdd\_Dp adds value iVal to the emission
571 : ! array of species HcoID in HEMCO object HcoState. The value is placed at
572 : ! location I, J, L of the array.
573 : !\\
574 : !\\
575 : ! !INTERFACE:
576 : !
577 0 : SUBROUTINE HCO_EmisAdd_Dp( HcoState, iVal, HcoID, I, J, L, RC )
578 : !
579 : ! !INPUT/OUTPUT PARAMETERS:
580 : !
581 : TYPE(HCO_State), POINTER :: HcoState
582 : REAL(dp), INTENT(INOUT) :: iVal
583 : INTEGER, INTENT(INOUT) :: RC
584 : !
585 : ! !INPUT PARAMETERS:
586 : !
587 : INTEGER, INTENT(IN ) :: HcoID
588 : INTEGER, INTENT(IN ) :: I
589 : INTEGER, INTENT(IN ) :: J
590 : INTEGER, INTENT(IN ) :: L
591 : !
592 : ! !REVISION HISTORY:
593 : ! 01 May 2013 - C. Keller - Initial version
594 : ! See https://github.com/geoschem/hemco for complete history
595 : !EOP
596 : !------------------------------------------------------------------------------
597 : !BOC
598 : CHARACTER(LEN=255) :: MSG, LOC
599 :
600 : !=====================================================================
601 : ! HCO_EmisAdd_Dp begins here!
602 : !=====================================================================
603 0 : LOC = 'HCO_EmisAdd_Dp (HCO_FLUXARR_MOD.F90)'
604 :
605 : ! Check size dimensions
606 0 : IF ( I > HcoState%NX ) THEN
607 0 : MSG = 'Cannot add DP - i too high!'
608 0 : CALL HCO_ERROR ( MSG, RC )
609 0 : RETURN
610 : ENDIF
611 0 : IF ( J > HcoState%NY ) THEN
612 0 : MSG = 'Cannot add DP - j too high!'
613 0 : CALL HCO_ERROR ( MSG, RC )
614 0 : RETURN
615 : ENDIF
616 0 : IF ( L > HcoState%NZ ) THEN
617 0 : MSG = 'Cannot add DP - l too high!'
618 0 : CALL HCO_ERROR ( MSG, RC )
619 0 : RETURN
620 : ENDIF
621 :
622 : ! Make sure target flux array in HcoState is allocated
623 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Emis, &
624 0 : HcoState%NX, HcoState%NY, HcoState%NZ, RC )
625 0 : IF ( RC /=HCO_SUCCESS ) RETURN
626 :
627 : ! Check for negative values. NegFlag determines the behavior for
628 : ! negative values: 2 = allow; 1 = set to zero + warning; 0 = error.
629 0 : IF ( HcoState%Options%NegFlag /= 2 ) THEN
630 0 : IF ( iVal < 0.0_hp ) THEN
631 :
632 : ! Negative flag is 1: set to zero and prompt warning
633 0 : IF ( HcoState%Options%NegFlag == 1 ) THEN
634 0 : iVal = 0.0_hp
635 : CALL HCO_WARNING ( HcoState%Config%Err, &
636 : 'Negative values found - set to zero!', &
637 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
638 :
639 : ! Negative flag is 0: return w/ error
640 : ELSE
641 : CALL HCO_ERROR ( &
642 : 'Negative values found!', &
643 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
644 0 : RETURN
645 : ENDIF
646 : ENDIF
647 : ENDIF
648 :
649 : ! Eventually add universal scale factor
650 0 : CALL HCO_ScaleArr( HcoState, HcoID, iVal, RC )
651 0 : IF ( RC /= HCO_SUCCESS ) THEN
652 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
653 0 : RETURN
654 : ENDIF
655 :
656 : ! Add array
657 0 : HcoState%Spc(HcoID)%Emis%Val(I,J,L) = &
658 0 : HcoState%Spc(HcoID)%Emis%Val(I,J,L) + iVal
659 :
660 : ! Return w/ success
661 0 : RC = HCO_SUCCESS
662 :
663 : END SUBROUTINE HCO_EmisAdd_Dp
664 : !EOC
665 : !------------------------------------------------------------------------------
666 : ! Harmonized Emissions Component (HEMCO) !
667 : !------------------------------------------------------------------------------
668 : !BOP
669 : !
670 : ! !IROUTINE: HCO_EmisAdd_Sp
671 : !
672 : ! !DESCRIPTION: Routine HCO\_EmisAdd\_Sp adds value iVal to the emission
673 : ! array of species HcoID in HEMCO object HcoState. The value is placed
674 : ! at location I, J, L of the array.
675 : !\\
676 : !\\
677 : ! !INTERFACE:
678 : !
679 0 : SUBROUTINE HCO_EmisAdd_Sp( HcoState, iVal, HcoID, I, J, L, RC )
680 : !
681 : ! !INPUT/OUTPUT PARAMETERS:
682 : !
683 : TYPE(HCO_State), POINTER :: HcoState
684 : REAL(sp), INTENT(INOUT) :: iVal
685 : INTEGER, INTENT(INOUT) :: RC
686 : !
687 : ! !INPUT PARAMETERS:
688 : !
689 : INTEGER, INTENT(IN ) :: HcoID
690 : INTEGER, INTENT(IN ) :: I
691 : INTEGER, INTENT(IN ) :: J
692 : INTEGER, INTENT(IN ) :: L
693 : !
694 : ! !REVISION HISTORY:
695 : ! 01 May 2013 - C. Keller - Initial version
696 : ! See https://github.com/geoschem/hemco for complete history
697 : !EOP
698 : !------------------------------------------------------------------------------
699 : !BOC
700 : CHARACTER(LEN=255) :: MSG, LOC
701 :
702 : !=====================================================================
703 : ! HCO_EmisAdd_Sp begins here!
704 : !=====================================================================
705 0 : LOC = 'HCO_EmisAdd_Sp (HCO_FLUXARR_MOD.F90)'
706 :
707 : ! Check size dimensions
708 0 : IF ( I > HcoState%NX ) THEN
709 0 : MSG = 'Cannot add SP - i too high!'
710 0 : CALL HCO_ERROR ( MSG, RC )
711 0 : RETURN
712 : ENDIF
713 0 : IF ( J > HcoState%NY ) THEN
714 0 : MSG = 'Cannot add SP - j too high!'
715 0 : CALL HCO_ERROR ( MSG, RC )
716 0 : RETURN
717 : ENDIF
718 0 : IF ( L > HcoState%NZ ) THEN
719 0 : MSG = 'Cannot add SP - l too high!'
720 0 : CALL HCO_ERROR ( MSG, RC )
721 0 : RETURN
722 : ENDIF
723 :
724 : ! Make sure target flux array in HcoState is allocated
725 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Emis, &
726 0 : HcoState%NX, HcoState%NY, HcoState%NZ, RC )
727 0 : IF ( RC /=HCO_SUCCESS ) RETURN
728 :
729 : ! Check for negative values. NegFlag determines the behavior for
730 : ! negative values: 2 = allow; 1 = set to zero + warning; 0 = error.
731 0 : IF ( HcoState%Options%NegFlag /= 2 ) THEN
732 0 : IF ( iVal < 0.0_sp ) THEN
733 :
734 : ! Negative flag is 1: set to zero and prompt warning
735 0 : IF ( HcoState%Options%NegFlag == 1 ) THEN
736 0 : iVal = 0.0_sp
737 : CALL HCO_WARNING ( HcoState%Config%Err, &
738 : 'Negative values found - set to zero!', &
739 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
740 :
741 : ! Negative flag is 0: return w/ error
742 : ELSE
743 : CALL HCO_ERROR ( &
744 : 'Negative values found!', &
745 0 : RC, THISLOC = 'HCO_EmisAdd (HCO_FLUXARR_MOD.F90)' )
746 0 : RETURN
747 : ENDIF
748 : ENDIF
749 : ENDIF
750 :
751 : ! Eventually add universal scale factor
752 0 : CALL HCO_ScaleArr( HcoState, HcoID, iVal, RC )
753 0 : IF ( RC /= HCO_SUCCESS ) THEN
754 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
755 0 : RETURN
756 : ENDIF
757 :
758 : ! Add array
759 0 : HcoState%Spc(HcoID)%Emis%Val(I,J,L) = &
760 0 : HcoState%Spc(HcoID)%Emis%Val(I,J,L) + iVal
761 :
762 : ! Return w/ success
763 0 : RC = HCO_SUCCESS
764 :
765 : END SUBROUTINE HCO_EmisAdd_Sp
766 : !EOC
767 : !------------------------------------------------------------------------------
768 : ! Harmonized Emissions Component (HEMCO) !
769 : !------------------------------------------------------------------------------
770 : !BOP
771 : !
772 : ! !IROUTINE: HCO_DepvAdd_2D_Dp
773 : !
774 : ! !DESCRIPTION: Routine HCO\_DepvAdd\_2D\_Dp adds the real*8 2D-array Arr2D
775 : ! to the depostion array of species HcoID in HEMCO object HcoState.
776 : !\\
777 : !\\
778 : ! !INTERFACE:
779 : !
780 0 : SUBROUTINE HCO_DepvAdd_2D_Dp( HcoState, Arr2D, HcoID, RC )
781 : !
782 : ! !INPUT/OUTPUT PARAMETERS:
783 : !
784 : TYPE(HCO_State), POINTER :: HcoState
785 : INTEGER, INTENT(INOUT) :: RC
786 : !
787 : ! !INPUT PARAMETERS:
788 : !
789 : REAL(dp), INTENT(IN ) :: Arr2D(HcoState%NX,HcoState%NY)
790 : INTEGER, INTENT(IN ) :: HcoID
791 : !
792 : ! !REVISION HISTORY:
793 : ! 01 May 2013 - C. Keller - Initial version
794 : ! See https://github.com/geoschem/hemco for complete history
795 : !EOP
796 : !------------------------------------------------------------------------------
797 : !BOC
798 : CHARACTER(LEN=255) :: MSG
799 :
800 : !=====================================================================
801 : ! HCO_DepvAdd_2D_Dp begins here!
802 : !=====================================================================
803 :
804 : ! Make sure target flux array in HcoState is allocated
805 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Depv, &
806 0 : HcoState%NX, HcoState%NY, RC )
807 0 : IF ( RC /=HCO_SUCCESS ) RETURN
808 :
809 : ! Add array
810 : HcoState%Spc(HcoID)%Depv%Val(:,:) = &
811 0 : HcoState%Spc(HcoID)%Depv%Val(:,:) + Arr2D(:,:)
812 :
813 : ! Return w/ success
814 0 : RC = HCO_SUCCESS
815 :
816 : END SUBROUTINE HCO_DepvAdd_2D_Dp
817 : !EOC
818 : !------------------------------------------------------------------------------
819 : ! Harmonized Emissions Component (HEMCO) !
820 : !------------------------------------------------------------------------------
821 : !BOP
822 : !
823 : ! !IROUTINE: HCO_DepvAdd_2D_Sp
824 : !
825 : ! !DESCRIPTION: Routine HCO\_DepvAdd\_2D\_Sp adds the real*4 2D-array Arr2D
826 : ! to the depostion array of species HcoID in HEMCO object HcoState.
827 : !\\
828 : !\\
829 : ! !INTERFACE:
830 : !
831 0 : SUBROUTINE HCO_DepvAdd_2D_Sp( HcoState, Arr2D, HcoID, RC )
832 : !
833 : ! !INPUT/OUTPUT PARAMETERS:
834 : !
835 : TYPE(HCO_State), POINTER :: HcoState
836 : INTEGER, INTENT(INOUT) :: RC
837 : !
838 : ! !INPUT PARAMETERS:
839 : !
840 : REAL(sp), INTENT(IN ) :: Arr2D(HcoState%NX,HcoState%NY)
841 : INTEGER, INTENT(IN ) :: HcoID
842 : !
843 : ! !REVISION HISTORY:
844 : ! 01 May 2013 - C. Keller - Initial version
845 : ! See https://github.com/geoschem/hemco for complete history
846 : !EOP
847 : !------------------------------------------------------------------------------
848 : !BOC
849 :
850 : !=====================================================================
851 : ! HCO_DepvAdd_2D_Sp begins here!
852 : !=====================================================================
853 :
854 : ! Make sure target flux array in HcoState is allocated
855 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Depv, &
856 0 : HcoState%NX, HcoState%NY, RC )
857 0 : IF ( RC /=HCO_SUCCESS ) RETURN
858 :
859 : ! Add array
860 : HcoState%Spc(HcoID)%Depv%Val(:,:) = &
861 0 : HcoState%Spc(HcoID)%Depv%Val(:,:) + Arr2D(:,:)
862 :
863 : ! Return w/ success
864 0 : RC = HCO_SUCCESS
865 :
866 : END SUBROUTINE HCO_DepvAdd_2D_Sp
867 : !EOC
868 : !------------------------------------------------------------------------------
869 : ! Harmonized Emissions Component (HEMCO) !
870 : !------------------------------------------------------------------------------
871 : !BOP
872 : !
873 : ! !IROUTINE: HCO_DepvAdd_Dp
874 : !
875 : ! !DESCRIPTION: Routine HCO\_DepvAdd\_Dp adds value iVal to the deposition
876 : ! array of species HcoID in HEMCO object HcoState. The value is placed at
877 : ! location I, J of the array.
878 : !\\
879 : !\\
880 : ! !INTERFACE:
881 : !
882 0 : SUBROUTINE HCO_DepvAdd_Dp( HcoState, iVal, HcoID, I, J, RC )
883 : !
884 : ! !INPUT/OUTPUT PARAMETERS:
885 : !
886 : TYPE(HCO_State), POINTER :: HcoState
887 : INTEGER, INTENT(INOUT) :: RC
888 : !
889 : ! !INPUT PARAMETERS:
890 : !
891 : REAL(dp), INTENT(IN ) :: iVal
892 : INTEGER, INTENT(IN ) :: HcoID
893 : INTEGER, INTENT(IN ) :: I
894 : INTEGER, INTENT(IN ) :: J
895 : !
896 : ! !REVISION HISTORY:
897 : ! 01 May 2013 - C. Keller - Initial version
898 : ! See https://github.com/geoschem/hemco for complete history
899 : !EOP
900 : !------------------------------------------------------------------------------
901 : !BOC
902 : CHARACTER(LEN=255) :: MSG
903 :
904 : !=====================================================================
905 : ! HCO_DepvAdd_Dp begins here!
906 : !=====================================================================
907 :
908 : ! Check size dimensions
909 0 : IF ( I > HcoState%NX ) THEN
910 0 : MSG = 'Cannot add DP - i too high!'
911 0 : CALL HCO_ERROR ( MSG, RC )
912 0 : RETURN
913 : ENDIF
914 0 : IF ( J > HcoState%NY ) THEN
915 0 : MSG = 'Cannot add DP - j too high!'
916 0 : CALL HCO_ERROR ( MSG, RC )
917 0 : RETURN
918 : ENDIF
919 :
920 : ! Make sure target flux array in HcoState is allocated
921 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Depv, &
922 0 : HcoState%NX, HcoState%NY, RC )
923 0 : IF ( RC /=HCO_SUCCESS ) RETURN
924 :
925 : ! Add array
926 0 : HcoState%Spc(HcoID)%Depv%Val(I,J) = &
927 0 : HcoState%Spc(HcoID)%Depv%Val(I,J) + iVal
928 :
929 : ! Return w/ success
930 0 : RC = HCO_SUCCESS
931 :
932 : END SUBROUTINE HCO_DepvAdd_Dp
933 : !EOC
934 : !------------------------------------------------------------------------------
935 : ! Harmonized Emissions Component (HEMCO) !
936 : !------------------------------------------------------------------------------
937 : !BOP
938 : !
939 : ! !IROUTINE: HCO_DepvAdd_Sp
940 : !
941 : ! !DESCRIPTION: Routine HCO\_DepvAdd\_Sp adds value iVal to the deposition
942 : ! array of species HcoID in HEMCO object HcoState. The value is placed at
943 : ! location I, J of the array.
944 : !\\
945 : !\\
946 : ! !INTERFACE:
947 : !
948 0 : SUBROUTINE HCO_DepvAdd_Sp( HcoState, iVal, HcoID, I, J, RC )
949 : !
950 : ! !INPUT/OUTPUT PARAMETERS:
951 : !
952 : TYPE(HCO_State), POINTER :: HcoState
953 : INTEGER, INTENT(INOUT) :: RC
954 : !
955 : ! !INPUT PARAMETERS:
956 : !
957 : REAL(sp), INTENT(IN ) :: iVal
958 : INTEGER, INTENT(IN ) :: HcoID
959 : INTEGER, INTENT(IN ) :: I
960 : INTEGER, INTENT(IN ) :: J
961 : !
962 : ! !REVISION HISTORY:
963 : ! 01 May 2013 - C. Keller - Initial version
964 : ! See https://github.com/geoschem/hemco for complete history
965 : !EOP
966 : !------------------------------------------------------------------------------
967 : !BOC
968 : CHARACTER(LEN=255) :: MSG
969 :
970 : !=====================================================================
971 : ! HCO_DepvAdd_Sp begins here!
972 : !=====================================================================
973 :
974 : ! Check size dimensions
975 0 : IF ( I > HcoState%NX ) THEN
976 0 : MSG = 'Cannot add iVal - i too high!'
977 0 : CALL HCO_ERROR ( MSG, RC )
978 0 : RETURN
979 : ENDIF
980 0 : IF ( J > HcoState%NY ) THEN
981 0 : MSG = 'Cannot add iVal - j too high!'
982 0 : CALL HCO_ERROR ( MSG, RC )
983 0 : RETURN
984 : ENDIF
985 :
986 : ! Make sure target flux array in HcoState is allocated
987 0 : CALL HCO_ArrAssert ( HcoState%Spc(HcoID)%Depv, &
988 0 : HcoState%NX, HcoState%NY, RC )
989 0 : IF ( RC /=HCO_SUCCESS ) RETURN
990 :
991 : ! Add array
992 0 : HcoState%Spc(HcoID)%Depv%Val(I,J) = &
993 0 : HcoState%Spc(HcoID)%Depv%Val(I,J) + iVal
994 :
995 : ! Return w/ success
996 0 : RC = HCO_SUCCESS
997 :
998 : END SUBROUTINE HCO_DepvAdd_Sp
999 : !EOC
1000 : !------------------------------------------------------------------------------
1001 : ! Harmonized Emissions Component (HEMCO) !
1002 : !------------------------------------------------------------------------------
1003 : !BOP
1004 : !
1005 : ! !IROUTINE: DiagnCheck
1006 : !
1007 : ! !DESCRIPTION: Subroutine DiagnCheck checks if the given emission array needs
1008 : ! to be added to any auto-fill diagnostics. The diagnostics to be
1009 : ! filled (if any) depend on the passed extension number, emission
1010 : ! category and hierarchy, and the HEMCO species ID.
1011 : !\\
1012 : !\\
1013 : ! !INTERFACE:
1014 : !
1015 0 : SUBROUTINE DiagnCheck( HcoState, ExtNr, Cat, &
1016 0 : Hier, HcoID, Arr3D, Arr3Dsp, &
1017 0 : Arr2D, Arr2Dsp, MinDiagnLev, RC )
1018 : !
1019 : ! !USES:
1020 : !
1021 : USE HCO_DIAGN_MOD
1022 : !
1023 : ! !INPUT PARAMETERS:
1024 : !
1025 : INTEGER, INTENT(IN ) :: HcoID
1026 : INTEGER, INTENT(IN ), OPTIONAL :: ExtNr
1027 : INTEGER, INTENT(IN ), OPTIONAL :: Cat
1028 : INTEGER, INTENT(IN ), OPTIONAL :: Hier
1029 : INTEGER, INTENT(IN ), OPTIONAL :: MinDiagnLev
1030 : !
1031 : ! !INPUT/OUTPUT PARAMETERS:
1032 : !
1033 : TYPE(HCO_State), POINTER :: HcoState
1034 : REAL(dp), INTENT(INOUT), OPTIONAL :: Arr3D( HcoState%NX, &
1035 : HcoState%NY, &
1036 : HcoState%NZ )
1037 : REAL(sp), INTENT(INOUT), OPTIONAL :: Arr3Dsp( HcoState%NX, &
1038 : HcoState%NY, &
1039 : HcoState%NZ )
1040 : REAL(dp), INTENT(INOUT), OPTIONAL :: Arr2D( HcoState%NX, &
1041 : HcoState%NY )
1042 : REAL(sp), INTENT(INOUT), OPTIONAL :: Arr2Dsp( HcoState%NX, &
1043 : HcoState%NY )
1044 : INTEGER, INTENT(INOUT) :: RC
1045 : !
1046 : ! !REVISION HISTORY:
1047 : ! 20 Apr 2015 - C. Keller - Initial version
1048 : ! See https://github.com/geoschem/hemco for complete history
1049 : !EOP
1050 : !------------------------------------------------------------------------------
1051 : !BOC
1052 : !
1053 : ! !LOCAL VARIABLES:
1054 : !
1055 : INTEGER :: AFL, XT, CT, HR
1056 : CHARACTER(LEN=255) :: LOC
1057 :
1058 : !=====================================================================
1059 : ! DiagnCheck begins here!
1060 : !=====================================================================
1061 :
1062 : ! Initialize values
1063 0 : LOC = 'DiagnCheck (HCO_FLUXARR_MOD.F90)'
1064 :
1065 : ! Autofill level:
1066 : ! 1=species level, 2=ExtNr level, 3=Cat level, 4=Hier level
1067 0 : AFL = 1
1068 :
1069 : ! ExtNr, Cat & Hier
1070 0 : XT = -1
1071 0 : CT = -1
1072 0 : HR = -1
1073 :
1074 : ! Set extension number, category, and hierarchy
1075 0 : IF ( PRESENT(ExtNr) ) THEN
1076 0 : XT = ExtNr
1077 0 : AFL = 2
1078 :
1079 : ! Consider category only within extension ...
1080 0 : IF ( PRESENT(Cat) ) THEN
1081 0 : IF ( Cat > 0 ) THEN
1082 0 : CT = Cat
1083 0 : AFL = 3
1084 : ENDIF
1085 :
1086 : ! Consider hierarchy only within category ...
1087 0 : IF ( AFL==3 .AND. PRESENT(Hier) ) THEN
1088 0 : IF ( Hier > 0 ) THEN
1089 0 : HR = Hier
1090 0 : AFL = 4
1091 : ENDIF
1092 : ENDIF
1093 : ENDIF
1094 : ENDIF
1095 :
1096 0 : IF ( PRESENT(MinDiagnLev) ) THEN
1097 0 : AFL = MIN(AFL,MinDiagnLev)
1098 : ENDIF
1099 :
1100 : ! Check if we need to call diagnostics
1101 0 : IF ( Diagn_AutoFillLevelDefined(HcoState%Diagn,AFL) ) THEN
1102 :
1103 : ! 3D HP array
1104 0 : IF ( PRESENT(Arr3D) ) THEN
1105 : CALL Diagn_Update( HcoState, ExtNr=XT, Cat=CT, &
1106 : Hier=HR, HcoID=HcoID, AutoFill=1, &
1107 0 : Array3D=Arr3D, MinDiagnLev=MinDiagnLev, RC=RC )
1108 0 : IF ( RC /= HCO_SUCCESS ) THEN
1109 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
1110 0 : RETURN
1111 : ENDIF
1112 : ENDIF
1113 :
1114 : ! 3D SP array
1115 0 : IF ( PRESENT(Arr3Dsp) ) THEN
1116 : CALL Diagn_Update( HcoState, ExtNr=XT, Cat=CT, &
1117 : Hier=HR, HcoID=HcoID, AutoFill=1, &
1118 0 : Array3D=Arr3Dsp, MinDiagnLev=MinDiagnLev, RC=RC )
1119 0 : IF ( RC /= HCO_SUCCESS ) THEN
1120 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
1121 0 : RETURN
1122 : ENDIF
1123 : ENDIF
1124 :
1125 : ! 2D HP array
1126 0 : IF ( PRESENT(Arr2D) ) THEN
1127 : CALL Diagn_Update( HcoState, ExtNr=XT, Cat=CT, &
1128 : Hier=HR, HcoID=HcoID, AutoFill=1, &
1129 0 : Array2D=Arr2D, MinDiagnLev=MinDiagnLev, RC=RC )
1130 0 : IF ( RC /= HCO_SUCCESS ) THEN
1131 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
1132 0 : RETURN
1133 : ENDIF
1134 : ENDIF
1135 :
1136 : ! 2D SP array
1137 0 : IF ( PRESENT(Arr2Dsp) ) THEN
1138 : CALL Diagn_Update( HcoState, ExtNr=XT, Cat=CT, &
1139 : Hier=HR, HcoID=HcoID, AutoFill=1, &
1140 0 : Array2D=Arr2Dsp, MinDiagnLev=MinDiagnLev, RC=RC )
1141 0 : IF ( RC /= HCO_SUCCESS ) THEN
1142 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
1143 0 : RETURN
1144 : ENDIF
1145 : ENDIF
1146 :
1147 : ENDIF
1148 :
1149 : ! Return w/ success
1150 0 : RC = HCO_SUCCESS
1151 :
1152 0 : END SUBROUTINE DiagnCheck
1153 : !EOC
1154 : END MODULE HCO_FluxArr_Mod
|
