Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_state_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOX\_State\_Mod contains routines and variables
9 : ! to organize the extensions state type ExtState. ExtState contains the
10 : ! logical switches for each extension (denoting whether or not it is
11 : ! enabled) as well as pointers to all met fields used by the extensions.
12 : ! ExtState is passed to all extension modules, and the met fields
13 : ! defined in here are thus available to all extensions. Additional met
14 : ! fields (and extension switches) can be added as required.
15 : !\\
16 : ! This module contains the routines to initialize and finalize the
17 : ! ExtState object, but doesn't link the met field pointers to the
18 : ! corresponding fields. This is done in the HEMCO-model interface
19 : ! routines (e.g. hcoi\_standalone\_mod.F90, hcoi\_gc\_main\_mod.F90).
20 : ! Newly added met fields will only work if the corresponding pointer
21 : ! assignments are added to these interface routines!
22 : !\\
23 : !\\
24 : ! !INTERFACE:
25 : !
26 : MODULE HCOX_STATE_MOD
27 : !
28 : ! !USES:
29 : !
30 : USE HCO_ERROR_MOD
31 : USE HCO_ARR_MOD
32 :
33 : IMPLICIT NONE
34 : PRIVATE
35 : !
36 : ! !PUBLIC MEMBER FUNCTIONS:
37 : !
38 : PUBLIC :: ExtStateInit
39 : PUBLIC :: ExtStateFinal
40 : PUBLIC :: ExtDat_Set
41 : !
42 : ! !DERIVED TYPES:
43 : !
44 : !=========================================================================
45 : ! ExtDat_*: Derived types containing pointers to the met field arrays
46 : ! (Arr) and a logical flag whether or not the field is used by any of
47 : ! the extensions (DoUse). Arrays can be 3D reals or 2D reals or integer
48 : ! All real values are of default precision! (df), as specified in
49 : ! HCO\_ERROR\_MOD. You can add more types if necessary.
50 : !=========================================================================
51 :
52 : ! 2D real, default precision
53 : TYPE, PUBLIC :: ExtDat_2R
54 : TYPE(Arr2D_HP), POINTER :: Arr
55 : LOGICAL :: DoUse
56 : LOGICAL :: FromList
57 : END TYPE ExtDat_2R
58 :
59 : ! 2D real, single precision
60 : TYPE, PUBLIC :: ExtDat_2S
61 : TYPE(Arr2D_SP), POINTER :: Arr
62 : LOGICAL :: DoUse
63 : LOGICAL :: FromList
64 : END TYPE ExtDat_2S
65 :
66 : ! 2D integer
67 : TYPE, PUBLIC :: ExtDat_2I
68 : TYPE(Arr2D_I), POINTER :: Arr
69 : LOGICAL :: DoUse
70 : LOGICAL :: FromList
71 : END TYPE ExtDat_2I
72 :
73 : ! 3D real, default precision
74 : TYPE, PUBLIC :: ExtDat_3R
75 : TYPE(Arr3D_HP), POINTER :: Arr
76 : LOGICAL :: DoUse
77 : LOGICAL :: FromList
78 : END TYPE ExtDat_3R
79 :
80 : ! 3D real, single precision
81 : TYPE, PUBLIC :: ExtDat_3S
82 : TYPE(Arr3D_SP), POINTER :: Arr
83 : LOGICAL :: DoUse
84 : LOGICAL :: FromList
85 : END TYPE ExtDat_3S
86 :
87 : !=========================================================================
88 : ! Ext_State: Derived type declaration for the State object containing
89 : ! pointers to all met fields and related quantities used by the HEMCO
90 : ! extensions. An 'Ext_State' type called ExtState is defined at the
91 : ! beginning of a HEMCO run and populated according to the specifications
92 : ! set in the configuration file. You can add more fields if necessary.
93 : !=========================================================================
94 : TYPE, PUBLIC :: Ext_State
95 :
96 : !----------------------------------------------------------------------
97 : ! Extension switches (enabled?)
98 : ! NOTE: When adding a new extension, don't forget to initialize this
99 : ! switch in subroutine ExtStateInit below!
100 : !----------------------------------------------------------------------
101 : INTEGER :: Custom ! Customizable ext.
102 : INTEGER :: DustDead ! DEAD dust model
103 : INTEGER :: DustGinoux ! Ginoux dust emissions
104 : INTEGER :: DustAlk ! Dust alkalinity
105 : INTEGER :: LightNOx ! Lightning NOx
106 : INTEGER :: ParaNOx ! PARANOX ship emissions
107 : INTEGER :: SoilNOx ! Soil NOx emissions
108 : INTEGER :: Megan ! MEGAN biogenic emissions
109 : INTEGER :: SeaFlux ! air-sea exchange
110 : INTEGER :: SeaSalt ! Seasalt emissions
111 : INTEGER :: GFED ! GFED biomass burning
112 : INTEGER :: FINN ! FINN biomass burning
113 : INTEGER :: GC_RnPbBe ! GEOS-Chem Rn-Pb-Be simulation
114 : INTEGER :: GC_POPs ! GEOS-Chem POPs simulation
115 : INTEGER :: Wetland_CH4 ! Methane emiss from wetlands
116 : INTEGER :: TOMAS_Jeagle ! TOMAS Jeagle sea salt
117 : INTEGER :: TOMAS_DustDead ! TOMAS sectional Dead Dust
118 : INTEGER :: Volcano ! Volcano emissions
119 : INTEGER :: Inorg_Iodine ! Oceanic inorganic iodine emissions
120 :
121 : !----------------------------------------------------------------------
122 : ! Data directory
123 : !----------------------------------------------------------------------
124 : CHARACTER(LEN=255) :: DATA_DIR ! Directory for data
125 :
126 : !----------------------------------------------------------------------
127 : ! Met fields
128 : !----------------------------------------------------------------------
129 : TYPE(ExtDat_2R), POINTER :: U10M ! E/W 10m wind speed [m/s]
130 : TYPE(ExtDat_2R), POINTER :: V10M ! N/S 10m wind speed [m/s]
131 : TYPE(ExtDat_2R), POINTER :: ALBD ! Surface albedo [-]
132 : TYPE(ExtDat_2R), POINTER :: T2M ! 2m Sfce temperature [K]
133 : TYPE(ExtDat_2R), POINTER :: TSKIN ! Surface skin temperature [K]
134 : TYPE(ExtDat_2R), POINTER :: GWETROOT ! Root soil wetness [1]
135 : TYPE(ExtDat_2R), POINTER :: GWETTOP ! Top soil moisture [-]
136 : TYPE(ExtDat_2R), POINTER :: SNOWHGT ! Snow height [mm H2O = kg H2O/m2]
137 : TYPE(ExtDat_2R), POINTER :: SNODP ! Snow depth [m ]
138 : TYPE(ExtDat_2R), POINTER :: SNICE ! Fraction of snow/ice [1]
139 : TYPE(ExtDat_2R), POINTER :: USTAR ! Friction velocity [m/s]
140 : TYPE(ExtDat_2R), POINTER :: Z0 ! Sfc roughness height [m]
141 : TYPE(ExtDat_2R), POINTER :: TROPP ! Tropopause pressure [Pa]
142 : TYPE(ExtDat_2R), POINTER :: SUNCOS ! COS (SZA)
143 : TYPE(ExtDat_2R), POINTER :: SZAFACT ! current SZA/total daily SZA
144 : TYPE(ExtDat_2R), POINTER :: PARDR ! direct photsyn radiation [W/m2]
145 : TYPE(ExtDat_2R), POINTER :: PARDF ! diffuse photsyn radiation [W/m2]
146 : TYPE(ExtDat_2R), POINTER :: PSC2_WET ! Interpolated sfc pressure [hPa]
147 : TYPE(ExtDat_2R), POINTER :: RADSWG ! surface radiation [W/m2]
148 : TYPE(ExtDat_2R), POINTER :: FRCLND ! Olson land fraction [-]
149 : TYPE(ExtDat_2R), POINTER :: FRLAND ! land fraction [-]
150 : TYPE(ExtDat_2R), POINTER :: FROCEAN ! ocean fraction [-]
151 : TYPE(ExtDat_2R), POINTER :: FRSEAICE ! sea ice fraction [-]
152 : TYPE(ExtDat_2R), POINTER :: QV2M ! 2m specific humidity [-]
153 : TYPE(ExtDat_2R), POINTER :: FRLAKE ! lake fraction [-]
154 : TYPE(ExtDat_2R), POINTER :: FRLANDIC ! land ice fraction [-]
155 : TYPE(ExtDat_2R), POINTER :: CLDFRC ! cloud fraction [-]
156 : TYPE(ExtDat_2R), POINTER :: JNO2 ! J-Value for NO2 [1/s]
157 : TYPE(ExtDat_2R), POINTER :: JOH ! J-Value for O3->OH [1/s]
158 : TYPE(ExtDat_2R), POINTER :: LAI ! daily leaf area index [cm2/cm2]
159 : TYPE(ExtDat_2R), POINTER :: CHLR ! daily chlorophyll-a [mg/m3]
160 : TYPE(ExtDat_2I), POINTER :: TropLev ! Tropopause level [1]
161 : TYPE(ExtDat_2R), POINTER :: FLASH_DENS ! Lightning flash density [#/km2/s]
162 : TYPE(ExtDat_2R), POINTER :: CONV_DEPTH ! Convective cloud depth [m]
163 : INTEGER, POINTER :: PBL_MAX ! Max height of PBL [level]
164 : TYPE(ExtDat_3R), POINTER :: CNV_MFC ! Convective cloud mass flux [kg/m2/s]
165 : TYPE(ExtDat_3R), POINTER :: FRAC_OF_PBL ! Fraction of grid box in PBL
166 : TYPE(ExtDat_3R), POINTER :: SPHU ! Spec. humidity [kg H2O/kg total air]
167 : TYPE(ExtDat_3R), POINTER :: TK ! Air temperature [K]
168 : TYPE(ExtDat_3R), POINTER :: AIR ! Dry air mass [kg]
169 : TYPE(ExtDat_3R), POINTER :: AIRVOL ! Air volume [m3]
170 : TYPE(ExtDat_3R), POINTER :: AIRDEN ! Dry air density [kg/m3]
171 : TYPE(ExtDat_3R), POINTER :: O3 ! O3 mass [kg/kg dry air]
172 : TYPE(ExtDat_3R), POINTER :: NO ! NO mass [kg/kg dry air]
173 : TYPE(ExtDat_3R), POINTER :: NO2 ! NO2 mass [kg/kg dry air]
174 : TYPE(ExtDat_3R), POINTER :: HNO3 ! HNO3 mass [kg/kg dry air]
175 : TYPE(ExtDat_3R), POINTER :: POPG ! POPG mass [kg/kg dry air]
176 :
177 : !----------------------------------------------------------------------
178 : ! Deposition parameter
179 : ! DRY_TOTN and WET_TOTN are the total (dry/wet) deposited N since the
180 : ! last emission timestep. Even though these numbers are per second,
181 : ! they may represent accumulated deposition velocities if chemistry
182 : ! and/or dynamic timestep are not equal to the emission timestep.
183 : ! These values are used by the soil NOx module. Note that it is assumed
184 : ! that DRY_TOTN and WET_TOTN are summed over chemistry and transport
185 : ! timesteps, respectively!
186 : !----------------------------------------------------------------------
187 : TYPE(ExtDat_2R), POINTER :: DRY_TOTN ! Dry deposited N [molec/cm2/s]
188 : TYPE(ExtDat_2R), POINTER :: WET_TOTN ! Wet deposited N [kg N/s]
189 : REAL(hp), POINTER :: DRYCOEFF(:) ! Baldocci drydep coeff.
190 :
191 : !----------------------------------------------------------------------
192 : ! Constants for POPs emissions module
193 : !----------------------------------------------------------------------
194 : REAL(dp) :: POP_DEL_H ! Delta H [J/mol]
195 : REAL(dp) :: POP_DEL_Hw ! Delta Hw [J/mol]
196 : REAL(dp) :: POP_HSTAR ! Henry's law constant [atm/M/L]
197 : REAL(dp) :: POP_KOA ! POP octanol-water partition coef
198 : REAL(dp) :: POP_KBC ! POP BC-air partition coeff.
199 : REAL(dp) :: POP_XMW ! POP molecular weight [kg/mol]
200 :
201 : !----------------------------------------------------------------------
202 : ! Fields used in ESMF environment only. These arrays won't be used
203 : ! in a classic environment. They become filled in HCO_SetExtState_ESMF
204 : ! in hcoi_esmf_mod.F90 (called from within hcoi_gc_main_mod.F90).
205 : !----------------------------------------------------------------------
206 : TYPE(ExtDat_3S), POINTER :: BYNCY ! Buoyancy
207 : TYPE(ExtDat_2S), POINTER :: LFR ! Lightning flash rate
208 : TYPE(ExtDat_2R), POINTER :: CNV_FRC ! convective fraction (filled
209 : ! from State_Met)
210 : END TYPE Ext_State
211 : !
212 : ! !PRIVATE MEMBER FUNCTIONS:
213 : !
214 : ! !REVISION HISTORY:
215 : ! 02 Oct 2013 - C. Keller - Initial version
216 : ! See https://github.com/geoschem/hemco for complete history
217 : !EOP
218 : !-----------------------------------------------------------------------------
219 : !BOC
220 : !
221 : ! !MODULE INTERFACES:
222 : !
223 : INTERFACE ExtDat_Init
224 : MODULE PROCEDURE ExtDat_Init_2R
225 : MODULE PROCEDURE ExtDat_Init_2S
226 : MODULE PROCEDURE ExtDat_Init_2I
227 : MODULE PROCEDURE ExtDat_Init_3R
228 : MODULE PROCEDURE ExtDat_Init_3S
229 : END INTERFACE ExtDat_Init
230 :
231 : INTERFACE ExtDat_Set
232 : MODULE PROCEDURE ExtDat_Set_2R
233 : MODULE PROCEDURE ExtDat_Set_2S
234 : MODULE PROCEDURE ExtDat_Set_2I
235 : MODULE PROCEDURE ExtDat_Set_3R
236 : MODULE PROCEDURE ExtDat_Set_3S
237 : END INTERFACE ExtDat_Set
238 :
239 : INTERFACE ExtDat_Cleanup
240 : MODULE PROCEDURE ExtDat_Cleanup_2R
241 : MODULE PROCEDURE ExtDat_Cleanup_2S
242 : MODULE PROCEDURE ExtDat_Cleanup_2I
243 : MODULE PROCEDURE ExtDat_Cleanup_3R
244 : MODULE PROCEDURE ExtDat_Cleanup_3S
245 : END INTERFACE ExtDat_Cleanup
246 :
247 : CONTAINS
248 : !EOC
249 : !------------------------------------------------------------------------------
250 : ! Harmonized Emissions Component (HEMCO) !
251 : !------------------------------------------------------------------------------
252 : !BOP
253 : !
254 : ! !ROUTINE: ExtStateInit
255 : !
256 : ! !DESCRIPTION: Initializes all fields of the ExtState object.
257 : !\\
258 : !\\
259 : ! !INTERFACE:
260 : !
261 0 : SUBROUTINE ExtStateInit( ExtState, RC )
262 : !
263 : ! !INPUT/OUTPUT PARAMETERS:
264 : !
265 : TYPE(Ext_State), POINTER :: ExtState ! ExtState object
266 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
267 : !
268 : ! !REMARKS:
269 : ! You can add more initialization statements as is necessary.
270 : !
271 : ! !REVISION HISTORY:
272 : ! 15 Dec 2013 - C. Keller - Initial version
273 : ! See https://github.com/geoschem/hemco for complete history
274 : !EOP
275 : !------------------------------------------------------------------------------
276 : !BOC
277 : !
278 : ! !LOCAL VARIABLES:
279 : !
280 : CHARACTER(LEN=255) :: LOC
281 : !======================================================================
282 : ! ExtStateInit begins here
283 : !======================================================================
284 0 : LOC = 'ExtStateInit (HCOX_STATE_MOD.F90)'
285 :
286 : ! Allocate object
287 0 : IF ( .NOT. ASSOCIATED ( ExtState ) ) ALLOCATE ( ExtState )
288 :
289 : !-----------------------------------------------------------------------
290 : ! Set all switches to -1
291 : !-----------------------------------------------------------------------
292 0 : ExtState%Custom = -1
293 0 : ExtState%DustDead = -1
294 0 : ExtState%DustGinoux = -1
295 0 : ExtState%DustAlk = -1
296 0 : ExtState%LightNOx = -1
297 0 : ExtState%ParaNOx = -1
298 0 : ExtState%SoilNOx = -1
299 0 : ExtState%Megan = -1
300 0 : ExtState%SeaFlux = -1
301 0 : ExtState%SeaSalt = -1
302 0 : ExtState%GFED = -1
303 0 : ExtState%FINN = -1
304 0 : ExtState%GC_RnPbBe = -1
305 0 : ExtState%GC_POPs = -1
306 0 : ExtState%Wetland_CH4 = -1
307 0 : ExtState%TOMAS_Jeagle = -1
308 0 : ExtState%TOMAS_DustDead = -1
309 0 : ExtState%Volcano = -1
310 0 : ExtState%Inorg_Iodine = -1
311 :
312 : !-----------------------------------------------------------------------
313 : ! Initialize constants for POPs emissions module
314 : !-----------------------------------------------------------------------
315 0 : ExtState%POP_DEL_H = 0d0
316 0 : ExtState%POP_DEL_Hw = 0d0
317 0 : ExtState%POP_HSTAR = 0d0
318 0 : ExtState%POP_KOA = 0d0
319 0 : ExtState%POP_KBC = 0d0
320 0 : ExtState%POP_XMW = 0d0
321 :
322 : !-----------------------------------------------------------------------
323 : ! Initialize all met arrays.
324 : ! This defines a nullified pointer for every met field and sets the
325 : ! corresponding DoUse flag to FALSE. The pointers to the met fields
326 : ! need to be defined in the HEMCO-model interface routine.
327 : !-----------------------------------------------------------------------
328 0 : CALL ExtDat_Init( ExtState%U10M, RC )
329 0 : IF ( RC /= HCO_SUCCESS ) THEN
330 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
331 0 : RETURN
332 : ENDIF
333 :
334 0 : CALL ExtDat_Init ( ExtState%V10M, RC )
335 0 : IF ( RC /= HCO_SUCCESS ) THEN
336 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
337 0 : RETURN
338 : ENDIF
339 :
340 0 : CALL ExtDat_Init ( ExtState%ALBD, RC )
341 0 : IF ( RC /= HCO_SUCCESS ) THEN
342 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
343 0 : RETURN
344 : ENDIF
345 :
346 0 : CALL ExtDat_Init ( ExtState%T2M, RC )
347 0 : IF ( RC /= HCO_SUCCESS ) THEN
348 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
349 0 : RETURN
350 : ENDIF
351 :
352 0 : CALL ExtDat_Init ( ExtState%TSKIN, RC )
353 0 : IF ( RC /= HCO_SUCCESS ) THEN
354 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
355 0 : RETURN
356 : ENDIF
357 :
358 0 : CALL ExtDat_Init ( ExtState%GWETROOT, RC )
359 0 : IF ( RC /= HCO_SUCCESS ) THEN
360 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
361 0 : RETURN
362 : ENDIF
363 :
364 0 : CALL ExtDat_Init ( ExtState%GWETTOP, RC )
365 0 : IF ( RC /= HCO_SUCCESS ) THEN
366 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
367 0 : RETURN
368 : ENDIF
369 :
370 0 : CALL ExtDat_Init ( ExtState%SNOWHGT, RC )
371 0 : IF ( RC /= HCO_SUCCESS ) THEN
372 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
373 0 : RETURN
374 : ENDIF
375 :
376 0 : CALL ExtDat_Init ( ExtState%SNODP, RC )
377 0 : IF ( RC /= HCO_SUCCESS ) THEN
378 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
379 0 : RETURN
380 : ENDIF
381 :
382 0 : CALL ExtDat_Init ( ExtState%SNICE, RC )
383 0 : IF ( RC /= HCO_SUCCESS ) THEN
384 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
385 0 : RETURN
386 : ENDIF
387 :
388 0 : CALL ExtDat_Init ( ExtState%USTAR, RC )
389 0 : IF ( RC /= HCO_SUCCESS ) THEN
390 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
391 0 : RETURN
392 : ENDIF
393 :
394 0 : CALL ExtDat_Init ( ExtState%Z0, RC )
395 0 : IF ( RC /= HCO_SUCCESS ) THEN
396 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
397 0 : RETURN
398 : ENDIF
399 :
400 0 : CALL ExtDat_Init ( ExtState%TROPP, RC )
401 0 : IF ( RC /= HCO_SUCCESS ) THEN
402 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
403 0 : RETURN
404 : ENDIF
405 :
406 0 : CALL ExtDat_Init ( ExtState%SUNCOS, RC )
407 0 : IF ( RC /= HCO_SUCCESS ) THEN
408 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
409 0 : RETURN
410 : ENDIF
411 :
412 0 : CALL ExtDat_Init ( ExtState%SZAFACT, RC )
413 0 : IF ( RC /= HCO_SUCCESS ) THEN
414 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
415 0 : RETURN
416 : ENDIF
417 :
418 0 : CALL ExtDat_Init ( ExtState%PARDR, RC )
419 0 : IF ( RC /= HCO_SUCCESS ) THEN
420 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
421 0 : RETURN
422 : ENDIF
423 :
424 0 : CALL ExtDat_Init ( ExtState%PARDF, RC )
425 0 : IF ( RC /= HCO_SUCCESS ) THEN
426 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
427 0 : RETURN
428 : ENDIF
429 :
430 0 : CALL ExtDat_Init ( ExtState%PSC2_WET, RC )
431 0 : IF ( RC /= HCO_SUCCESS ) THEN
432 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
433 0 : RETURN
434 : ENDIF
435 :
436 0 : CALL ExtDat_Init ( ExtState%RADSWG, RC )
437 0 : IF ( RC /= HCO_SUCCESS ) THEN
438 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
439 0 : RETURN
440 : ENDIF
441 :
442 0 : CALL ExtDat_Init ( ExtState%FRCLND, RC )
443 0 : IF ( RC /= HCO_SUCCESS ) THEN
444 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
445 0 : RETURN
446 : ENDIF
447 :
448 0 : CALL ExtDat_Init ( ExtState%FRLAND, RC )
449 0 : IF ( RC /= HCO_SUCCESS ) THEN
450 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
451 0 : RETURN
452 : ENDIF
453 :
454 0 : CALL ExtDat_Init ( ExtState%FROCEAN, RC )
455 0 : IF ( RC /= HCO_SUCCESS ) THEN
456 0 : CALL HCO_ERROR( 'ERROR 22', RC, THISLOC=LOC )
457 0 : RETURN
458 : ENDIF
459 :
460 0 : CALL ExtDat_Init ( ExtState%FRSEAICE, RC )
461 0 : IF ( RC /= HCO_SUCCESS ) THEN
462 0 : CALL HCO_ERROR( 'ERROR 23', RC, THISLOC=LOC )
463 0 : RETURN
464 : ENDIF
465 :
466 0 : CALL ExtDat_Init ( ExtState%QV2M, RC )
467 0 : IF ( RC /= HCO_SUCCESS ) THEN
468 0 : CALL HCO_ERROR( 'ERROR 24', RC, THISLOC=LOC )
469 0 : RETURN
470 : ENDIF
471 :
472 0 : CALL ExtDat_Init ( ExtState%FRLAKE, RC )
473 0 : IF ( RC /= HCO_SUCCESS ) THEN
474 0 : CALL HCO_ERROR( 'ERROR 25', RC, THISLOC=LOC )
475 0 : RETURN
476 : ENDIF
477 :
478 0 : CALL ExtDat_Init ( ExtState%FRLANDIC, RC )
479 0 : IF ( RC /= HCO_SUCCESS ) THEN
480 0 : CALL HCO_ERROR( 'ERROR 26', RC, THISLOC=LOC )
481 0 : RETURN
482 : ENDIF
483 :
484 0 : CALL ExtDat_Init ( ExtState%CLDFRC, RC )
485 0 : IF ( RC /= HCO_SUCCESS ) THEN
486 0 : CALL HCO_ERROR( 'ERROR 27', RC, THISLOC=LOC )
487 0 : RETURN
488 : ENDIF
489 :
490 0 : CALL ExtDat_Init ( ExtState%LAI, RC )
491 0 : IF ( RC /= HCO_SUCCESS ) THEN
492 0 : CALL HCO_ERROR( 'ERROR 28', RC, THISLOC=LOC )
493 0 : RETURN
494 : ENDIF
495 :
496 0 : CALL ExtDat_Init ( ExtState%CHLR, RC )
497 0 : IF ( RC /= HCO_SUCCESS ) THEN
498 0 : CALL HCO_ERROR( 'ERROR 29', RC, THISLOC=LOC )
499 0 : RETURN
500 : ENDIF
501 :
502 0 : CALL ExtDat_Init ( ExtState%FLASH_DENS, RC )
503 0 : IF ( RC /= HCO_SUCCESS ) THEN
504 0 : CALL HCO_ERROR( 'ERROR 30', RC, THISLOC=LOC )
505 0 : RETURN
506 : ENDIF
507 :
508 0 : CALL ExtDat_Init ( ExtState%CONV_DEPTH, RC )
509 0 : IF ( RC /= HCO_SUCCESS ) THEN
510 0 : CALL HCO_ERROR( 'ERROR 31', RC, THISLOC=LOC )
511 0 : RETURN
512 : ENDIF
513 :
514 0 : CALL ExtDat_Init ( ExtState%JNO2, RC )
515 0 : IF ( RC /= HCO_SUCCESS ) THEN
516 0 : CALL HCO_ERROR( 'ERROR 32', RC, THISLOC=LOC )
517 0 : RETURN
518 : ENDIF
519 :
520 0 : CALL ExtDat_Init ( ExtState%JOH, RC )
521 0 : IF ( RC /= HCO_SUCCESS ) THEN
522 0 : CALL HCO_ERROR( 'ERROR 33', RC, THISLOC=LOC )
523 0 : RETURN
524 : ENDIF
525 :
526 0 : CALL ExtDat_Init ( ExtState%CNV_MFC, RC )
527 0 : IF ( RC /= HCO_SUCCESS ) THEN
528 0 : CALL HCO_ERROR( 'ERROR 34', RC, THISLOC=LOC )
529 0 : RETURN
530 : ENDIF
531 :
532 0 : ExtState%PBL_MAX => NULL()
533 :
534 0 : CALL ExtDat_Init ( ExtState%FRAC_OF_PBL, RC )
535 0 : IF ( RC /= HCO_SUCCESS ) THEN
536 0 : CALL HCO_ERROR( 'ERROR 35', RC, THISLOC=LOC )
537 0 : RETURN
538 : ENDIF
539 :
540 0 : CALL ExtDat_Init ( ExtState%SPHU, RC )
541 0 : IF ( RC /= HCO_SUCCESS ) THEN
542 0 : CALL HCO_ERROR( 'ERROR 36', RC, THISLOC=LOC )
543 0 : RETURN
544 : ENDIF
545 :
546 0 : CALL ExtDat_Init ( ExtState%TK, RC )
547 0 : IF ( RC /= HCO_SUCCESS ) THEN
548 0 : CALL HCO_ERROR( 'ERROR 37', RC, THISLOC=LOC )
549 0 : RETURN
550 : ENDIF
551 :
552 0 : CALL ExtDat_Init ( ExtState%AIR, RC )
553 0 : IF ( RC /= HCO_SUCCESS ) THEN
554 0 : CALL HCO_ERROR( 'ERROR 38', RC, THISLOC=LOC )
555 0 : RETURN
556 : ENDIF
557 :
558 0 : CALL ExtDat_Init ( ExtState%AIRVOL, RC )
559 0 : IF ( RC /= HCO_SUCCESS ) THEN
560 0 : CALL HCO_ERROR( 'ERROR 39', RC, THISLOC=LOC )
561 0 : RETURN
562 : ENDIF
563 :
564 0 : CALL ExtDat_Init ( ExtState%AIRDEN, RC )
565 0 : IF ( RC /= HCO_SUCCESS ) THEN
566 0 : CALL HCO_ERROR( 'ERROR 40', RC, THISLOC=LOC )
567 0 : RETURN
568 : ENDIF
569 :
570 0 : CALL ExtDat_Init ( ExtState%O3, RC )
571 0 : IF ( RC /= HCO_SUCCESS ) THEN
572 0 : CALL HCO_ERROR( 'ERROR 41', RC, THISLOC=LOC )
573 0 : RETURN
574 : ENDIF
575 :
576 0 : CALL ExtDat_Init ( ExtState%NO, RC )
577 0 : IF ( RC /= HCO_SUCCESS ) THEN
578 0 : CALL HCO_ERROR( 'ERROR 42', RC, THISLOC=LOC )
579 0 : RETURN
580 : ENDIF
581 :
582 0 : CALL ExtDat_Init ( ExtState%NO2, RC )
583 0 : IF ( RC /= HCO_SUCCESS ) THEN
584 0 : CALL HCO_ERROR( 'ERROR 43', RC, THISLOC=LOC )
585 0 : RETURN
586 : ENDIF
587 :
588 0 : CALL ExtDat_Init ( ExtState%HNO3, RC )
589 0 : IF ( RC /= HCO_SUCCESS ) THEN
590 0 : CALL HCO_ERROR( 'ERROR 44', RC, THISLOC=LOC )
591 0 : RETURN
592 : ENDIF
593 :
594 0 : CALL ExtDat_Init ( ExtState%POPG, RC )
595 0 : IF ( RC /= HCO_SUCCESS ) THEN
596 0 : CALL HCO_ERROR( 'ERROR 45', RC, THISLOC=LOC )
597 0 : RETURN
598 : ENDIF
599 :
600 0 : CALL ExtDat_Init ( ExtState%DRY_TOTN, RC )
601 0 : IF ( RC /= HCO_SUCCESS ) THEN
602 0 : CALL HCO_ERROR( 'ERROR 46', RC, THISLOC=LOC )
603 0 : RETURN
604 : ENDIF
605 :
606 0 : CALL ExtDat_Init ( ExtState%WET_TOTN, RC )
607 0 : IF ( RC /= HCO_SUCCESS ) THEN
608 0 : CALL HCO_ERROR( 'ERROR 47', RC, THISLOC=LOC )
609 0 : RETURN
610 : ENDIF
611 :
612 0 : CALL ExtDat_Init ( ExtState%BYNCY, RC )
613 0 : IF ( RC /= HCO_SUCCESS ) THEN
614 0 : CALL HCO_ERROR( 'ERROR 48', RC, THISLOC=LOC )
615 0 : RETURN
616 : ENDIF
617 :
618 0 : CALL ExtDat_Init ( ExtState%LFR, RC )
619 0 : IF ( RC /= HCO_SUCCESS ) THEN
620 0 : CALL HCO_ERROR( 'ERROR 49', RC, THISLOC=LOC )
621 0 : RETURN
622 : ENDIF
623 :
624 0 : CALL ExtDat_Init ( ExtState%CNV_FRC, RC )
625 0 : IF ( RC /= HCO_SUCCESS ) THEN
626 0 : CALL HCO_ERROR( 'ERROR 50', RC, THISLOC=LOC )
627 0 : RETURN
628 : ENDIF
629 :
630 0 : CALL ExtDat_Init ( ExtState%TropLev, RC )
631 0 : IF ( RC /= HCO_SUCCESS ) THEN
632 0 : CALL HCO_ERROR( 'ERROR 51', RC, THISLOC=LOC )
633 0 : RETURN
634 : ENDIF
635 :
636 : ! Return w/ success
637 0 : RC = HCO_SUCCESS
638 :
639 : END SUBROUTINE ExtStateInit
640 : !EOC
641 : !------------------------------------------------------------------------------
642 : ! Harmonized Emissions Component (HEMCO) !
643 : !------------------------------------------------------------------------------
644 : !BOP
645 : !
646 : ! !IROUTINE: ExtStateFinal
647 : !
648 : ! !DESCRIPTION: Finalizes the ExtState object. This removes all defined
649 : ! pointer links (i.e. nullifies ExtDat\%Arr), but does not deallocate
650 : ! the target array!
651 : !\\
652 : !\\
653 : ! !INTERFACE:
654 : !
655 0 : SUBROUTINE ExtStateFinal( ExtState )
656 : !
657 : ! !INPUT PARAMETERS:
658 : !
659 : TYPE(Ext_State), POINTER :: ExtState
660 : !
661 : ! !REVISION HISTORY:
662 : ! 03 Oct 2013 - C. Keller - Initial version
663 : ! See https://github.com/geoschem/hemco for complete history
664 : !EOP
665 : !------------------------------------------------------------------------------
666 : !BOC
667 : !======================================================================
668 : ! ExtStateFinal begins here
669 : !======================================================================
670 :
671 0 : IF ( ASSOCIATED(ExtState) ) THEN
672 :
673 : ! Cleanup arrays. Don't do deepclean, i.e. only nullify pointers!
674 0 : CALL ExtDat_Cleanup( ExtState%U10M )
675 0 : CALL ExtDat_Cleanup( ExtState%V10M )
676 0 : CALL ExtDat_Cleanup( ExtState%ALBD )
677 0 : CALL ExtDat_Cleanup( ExtState%T2M )
678 0 : CALL ExtDat_Cleanup( ExtState%TSKIN )
679 0 : CALL ExtDat_Cleanup( ExtState%GWETROOT )
680 0 : CALL ExtDat_Cleanup( ExtState%GWETTOP )
681 0 : CALL ExtDat_Cleanup( ExtState%SNOWHGT )
682 0 : CALL ExtDat_Cleanup( ExtState%SNODP )
683 0 : CALL ExtDat_Cleanup( ExtState%SNICE )
684 0 : CALL ExtDat_Cleanup( ExtState%USTAR )
685 0 : CALL ExtDat_Cleanup( ExtState%Z0 )
686 0 : CALL ExtDat_Cleanup( ExtState%TROPP )
687 0 : CALL ExtDat_Cleanup( ExtState%SUNCOS )
688 0 : CALL ExtDat_Cleanup( ExtState%SZAFACT )
689 0 : CALL ExtDat_Cleanup( ExtState%PARDR )
690 0 : CALL ExtDat_Cleanup( ExtState%PARDF )
691 0 : CALL ExtDat_Cleanup( ExtState%PSC2_WET )
692 0 : CALL ExtDat_Cleanup( ExtState%RADSWG )
693 0 : CALL ExtDat_Cleanup( ExtState%FRCLND )
694 0 : CALL ExtDat_Cleanup( ExtState%FRLAND )
695 0 : CALL ExtDat_Cleanup( ExtState%FROCEAN )
696 0 : CALL ExtDat_Cleanup( ExtState%FRSEAICE )
697 0 : CALL ExtDat_Cleanup( ExtState%QV2M )
698 0 : CALL ExtDat_Cleanup( ExtState%FRLAKE )
699 0 : CALL ExtDat_Cleanup( ExtState%FRLANDIC )
700 0 : CALL ExtDat_Cleanup( ExtState%CLDFRC )
701 0 : CALL ExtDat_Cleanup( ExtState%LAI )
702 0 : CALL ExtDat_Cleanup( ExtState%CHLR )
703 0 : CALL ExtDat_Cleanup( ExtState%FLASH_DENS )
704 0 : CALL ExtDat_Cleanup( ExtState%CONV_DEPTH )
705 0 : CALL ExtDat_Cleanup( ExtState%JNO2 )
706 0 : CALL ExtDat_Cleanup( ExtState%JOH )
707 0 : CALL ExtDat_Cleanup( ExtState%CNV_MFC )
708 0 : CALL ExtDat_Cleanup( ExtState%FRAC_OF_PBL)
709 0 : CALL ExtDat_Cleanup( ExtState%SPHU )
710 0 : CALL ExtDat_Cleanup( ExtState%TK )
711 0 : CALL ExtDat_Cleanup( ExtState%AIR )
712 0 : CALL ExtDat_Cleanup( ExtState%AIRVOL )
713 0 : CALL ExtDat_Cleanup( ExtState%AIRDEN )
714 0 : CALL ExtDat_Cleanup( ExtState%O3 )
715 0 : CALL ExtDat_Cleanup( ExtState%NO )
716 0 : CALL ExtDat_Cleanup( ExtState%NO2 )
717 0 : CALL ExtDat_Cleanup( ExtState%HNO3 )
718 0 : CALL ExtDat_Cleanup( ExtState%POPG )
719 0 : CALL ExtDat_Cleanup( ExtState%DRY_TOTN )
720 0 : CALL ExtDat_Cleanup( ExtState%WET_TOTN )
721 0 : CALL ExtDat_Cleanup( ExtState%CNV_FRC )
722 0 : CALL ExtDat_Cleanup( ExtState%BYNCY )
723 0 : CALL ExtDat_Cleanup( ExtState%LFR )
724 0 : CALL ExtDat_Cleanup( ExtState%TropLev )
725 :
726 0 : ExtState%DRYCOEFF => NULL()
727 0 : ExtState%PBL_MAX => NULL()
728 :
729 : ENDIF
730 :
731 0 : END SUBROUTINE ExtStateFinal
732 : !EOC
733 : !------------------------------------------------------------------------------
734 : ! Harmonized Emissions Component (HEMCO) !
735 : !------------------------------------------------------------------------------
736 : !BOP
737 : !
738 : ! !IROUTINE: ExtDat_Init_2R
739 : !
740 : ! !DESCRIPTION: Subroutine ExtDat\_Init\_2R initializes the given ExtDat type.
741 : !\\
742 : !\\
743 : ! !INTERFACE:
744 : !
745 0 : SUBROUTINE ExtDat_Init_2R ( ExtDat, RC )
746 : !
747 : ! !INPUT PARAMETERS:
748 : !
749 : TYPE(ExtDat_2R), POINTER :: ExtDat
750 : INTEGER, INTENT(INOUT) :: RC ! Return code
751 : !
752 : ! !REVISION HISTORY:
753 : ! 20 Apr 2013 - C. Keller - Initial version
754 : ! See https://github.com/geoschem/hemco for complete history
755 : !EOP
756 : !------------------------------------------------------------------------------
757 : !BOC
758 : !
759 : ! !LOCAL VARIABLES:
760 : !
761 : CHARACTER(LEN=255) :: LOC
762 :
763 : ! ================================================================
764 : ! ExtDat_Init_2R begins here
765 : ! ================================================================
766 0 : LOC = 'ExtDat_Init_2R (HCOX_STATE_MOD.F90)'
767 :
768 0 : ExtDat => NULL()
769 0 : ALLOCATE(ExtDat)
770 0 : ExtDat%Arr => NULL()
771 :
772 : ! Establish pointer to ExtDat%Arr%Val
773 0 : CALL HCO_ArrInit( ExtDat%Arr, 0, 0, RC )
774 0 : IF ( RC /= HCO_SUCCESS ) THEN
775 0 : CALL HCO_ERROR( 'ERROR 52', RC, THISLOC=LOC )
776 0 : RETURN
777 : ENDIF
778 :
779 0 : ExtDat%DoUse = .FALSE.
780 0 : ExtDat%FromList = .FALSE.
781 :
782 : ! Leave
783 0 : RC = HCO_SUCCESS
784 :
785 : END SUBROUTINE ExtDat_Init_2R
786 : !EOC
787 : !------------------------------------------------------------------------------
788 : ! Harmonized Emissions Component (HEMCO) !
789 : !------------------------------------------------------------------------------
790 : !BOP
791 : !
792 : ! !IROUTINE: ExtDat_Init_2S
793 : !
794 : ! !DESCRIPTION: Subroutine ExtDat\_Init\_2S initializes the given ExtDat type.
795 : !\\
796 : !\\
797 : ! !INTERFACE:
798 : !
799 0 : SUBROUTINE ExtDat_Init_2S ( ExtDat, RC )
800 : !
801 : ! !INPUT PARAMETERS:
802 : !
803 : TYPE(ExtDat_2S), POINTER :: ExtDat
804 : INTEGER, INTENT(INOUT) :: RC ! Return code
805 : !
806 : ! !REVISION HISTORY:
807 : ! 20 Apr 2013 - C. Keller - Initial version
808 : ! See https://github.com/geoschem/hemco for complete history
809 : !EOP
810 : !------------------------------------------------------------------------------
811 : !BOC
812 : !
813 : ! !LOCAL VARIABLES:
814 : !
815 : CHARACTER(LEN=255) :: LOC
816 :
817 : ! ================================================================
818 : ! ExtDat_Init_2S begins here
819 : ! ================================================================
820 0 : LOC = 'ExtDat_Init_2S (HCOX_STATE_MOD.F90)'
821 :
822 0 : ExtDat => NULL()
823 0 : ALLOCATE(ExtDat)
824 0 : ExtDat%Arr => NULL()
825 :
826 : ! Establish pointer to ExtDat%Arr%Val
827 0 : CALL HCO_ArrInit( ExtDat%Arr, 0, 0, RC )
828 0 : IF ( RC /= HCO_SUCCESS ) THEN
829 0 : CALL HCO_ERROR( 'ERROR 53', RC, THISLOC=LOC )
830 0 : RETURN
831 : ENDIF
832 :
833 0 : ExtDat%DoUse = .FALSE.
834 0 : ExtDat%FromList = .FALSE.
835 :
836 : ! Leave
837 0 : RC = HCO_SUCCESS
838 :
839 : END SUBROUTINE ExtDat_Init_2S
840 : !EOC
841 : !------------------------------------------------------------------------------
842 : ! Harmonized Emissions Component (HEMCO) !
843 : !------------------------------------------------------------------------------
844 : !BOP
845 : !
846 : ! !IROUTINE: ExtDat_Init_2I
847 : !
848 : ! !DESCRIPTION: Subroutine ExtDat\_Init\_2I initializes the given ExtDat type.
849 : !\\
850 : !\\
851 : ! !INTERFACE:
852 : !
853 0 : SUBROUTINE ExtDat_Init_2I ( ExtDat, RC )
854 : !
855 : ! !INPUT PARAMETERS:
856 : !
857 : TYPE(ExtDat_2I), POINTER :: ExtDat
858 : INTEGER, INTENT(INOUT) :: RC ! Return code
859 : !
860 : ! !REVISION HISTORY:
861 : ! 20 Apr 2013 - C. Keller - Initial version
862 : ! See https://github.com/geoschem/hemco for complete history
863 : !EOP
864 : !------------------------------------------------------------------------------
865 : !BOC
866 : !
867 : ! !LOCAL VARIABLES:
868 : !
869 : CHARACTER(LEN=255) :: LOC
870 :
871 : ! ================================================================
872 : ! ExtDat_Init_2I begins here
873 : ! ================================================================
874 0 : LOC = 'ExtDat_Init_2I (HCOX_STATE_MOD.F90)'
875 :
876 0 : ExtDat => NULL()
877 0 : ALLOCATE(ExtDat)
878 0 : ExtDat%Arr => NULL()
879 :
880 : ! Establish pointer to ExtDat%Arr%Val
881 0 : CALL HCO_ArrInit( ExtDat%Arr, 0, 0, RC )
882 0 : IF ( RC /= HCO_SUCCESS ) THEN
883 0 : CALL HCO_ERROR( 'ERROR 54', RC, THISLOC=LOC )
884 0 : RETURN
885 : ENDIF
886 :
887 0 : ExtDat%DoUse = .FALSE.
888 0 : ExtDat%FromList = .FALSE.
889 :
890 : ! Leave
891 0 : RC = HCO_SUCCESS
892 :
893 : END SUBROUTINE ExtDat_Init_2I
894 : !EOC
895 : !------------------------------------------------------------------------------
896 : ! Harmonized Emissions Component (HEMCO) !
897 : !------------------------------------------------------------------------------
898 : !BOP
899 : !
900 : ! !IROUTINE: ExtDat_Init_3R
901 : !
902 : ! !DESCRIPTION: Subroutine ExtDat\_Init\_3R initializes the given ExtDat type.
903 : !\\
904 : !\\
905 : ! !INTERFACE:
906 : !
907 0 : SUBROUTINE ExtDat_Init_3R ( ExtDat, RC )
908 : !
909 : ! !INPUT PARAMETERS:
910 : !
911 : TYPE(ExtDat_3R), POINTER :: ExtDat
912 : INTEGER, INTENT(INOUT) :: RC ! Return code
913 : !
914 : ! !REVISION HISTORY:
915 : ! 20 Apr 2013 - C. Keller - Initial version
916 : ! See https://github.com/geoschem/hemco for complete history
917 : !EOP
918 : !------------------------------------------------------------------------------
919 : !BOC
920 : !
921 : ! !LOCAL VARIABLES:
922 : !
923 : CHARACTER(LEN=255) :: LOC
924 : ! ================================================================
925 : ! ExtDat_Init_3R begins here
926 : ! ================================================================
927 0 : LOC = 'ExtDat_Init_3R (HCOX_STATE_MOD.F90)'
928 :
929 0 : ExtDat => NULL()
930 0 : ALLOCATE(ExtDat)
931 0 : ExtDat%Arr => NULL()
932 :
933 : ! Establish pointer to ExtDat%Arr%Val
934 0 : CALL HCO_ArrInit( ExtDat%Arr, 0, 0, 0, RC )
935 0 : IF ( RC /= HCO_SUCCESS ) THEN
936 0 : CALL HCO_ERROR( 'ERROR 55', RC, THISLOC=LOC )
937 0 : RETURN
938 : ENDIF
939 :
940 0 : ExtDat%DoUse = .FALSE.
941 0 : ExtDat%FromList = .FALSE.
942 :
943 : ! Leave
944 0 : RC = HCO_SUCCESS
945 :
946 : END SUBROUTINE ExtDat_Init_3R
947 : !EOC
948 : !------------------------------------------------------------------------------
949 : ! Harmonized Emissions Component (HEMCO) !
950 : !------------------------------------------------------------------------------
951 : !BOP
952 : !
953 : ! !IROUTINE: ExtDat_Init_3S
954 : !
955 : ! !DESCRIPTION: Subroutine ExtDat\_Init\_3S initializes the given ExtDat type.
956 : !\\
957 : !\\
958 : ! !INTERFACE:
959 : !
960 0 : SUBROUTINE ExtDat_Init_3S ( ExtDat, RC )
961 : !
962 : ! !INPUT PARAMETERS:
963 : !
964 : TYPE(ExtDat_3S), POINTER :: ExtDat
965 : INTEGER, INTENT(INOUT) :: RC ! Return code
966 : !
967 : ! !REVISION HISTORY:
968 : ! 20 Apr 2013 - C. Keller - Initial version
969 : ! See https://github.com/geoschem/hemco for complete history
970 : !EOP
971 : !------------------------------------------------------------------------------
972 : !BOC
973 : !
974 : ! !LOCAL VARIABLES:
975 : !
976 : CHARACTER(LEN=255) :: LOC
977 : ! ================================================================
978 : ! ExtDat_Init_3S begins here
979 : ! ================================================================
980 0 : LOC = 'ExtDat_Init_3S (HCOX_STATE_MOD.F90)'
981 :
982 0 : ExtDat => NULL()
983 0 : ALLOCATE(ExtDat)
984 0 : ExtDat%Arr => NULL()
985 :
986 : ! Establish pointer to ExtDat%Arr%Val
987 0 : CALL HCO_ArrInit( ExtDat%Arr, 0, 0, 0, RC )
988 0 : IF ( RC /= HCO_SUCCESS ) THEN
989 0 : CALL HCO_ERROR( 'ERROR 56', RC, THISLOC=LOC )
990 0 : RETURN
991 : ENDIF
992 :
993 0 : ExtDat%DoUse = .FALSE.
994 0 : ExtDat%FromList = .FALSE.
995 :
996 : ! Leave
997 0 : RC = HCO_SUCCESS
998 :
999 : END SUBROUTINE ExtDat_Init_3S
1000 : !EOC
1001 : !------------------------------------------------------------------------------
1002 : ! Harmonized Emissions Component (HEMCO) !
1003 : !------------------------------------------------------------------------------
1004 : !BOP
1005 : !
1006 : ! !IROUTINE: ExtDat_Cleanup_2R
1007 : !
1008 : ! !DESCRIPTION: Subroutine ExtDat\_Cleanup\_2R removes the given ExtDat type.
1009 : !\\
1010 : !\\
1011 : ! !INTERFACE:
1012 : !
1013 0 : SUBROUTINE ExtDat_Cleanup_2R ( ExtDat )
1014 : !
1015 : ! !INPUT PARAMETERS:
1016 : !
1017 : TYPE(ExtDat_2R), POINTER :: ExtDat
1018 : !
1019 : ! !REVISION HISTORY:
1020 : ! 20 Apr 2013 - C. Keller - Initial version
1021 : ! See https://github.com/geoschem/hemco for complete history
1022 : !EOP
1023 : !------------------------------------------------------------------------------
1024 : !BOC
1025 : ! ================================================================
1026 : ! ExtDat_Cleanup_2R begins here
1027 : ! ================================================================
1028 :
1029 0 : IF ( ASSOCIATED( ExtDat) ) THEN
1030 0 : CALL HCO_ArrCleanup( ExtDat%Arr, DeepClean=.TRUE. )
1031 0 : DEALLOCATE ( ExtDat )
1032 : ENDIF
1033 :
1034 0 : END SUBROUTINE ExtDat_Cleanup_2R
1035 : !EOC
1036 : !------------------------------------------------------------------------------
1037 : ! Harmonized Emissions Component (HEMCO) !
1038 : !------------------------------------------------------------------------------
1039 : !BOP
1040 : !
1041 : ! !IROUTINE: ExtDat_Cleanup_2S
1042 : !
1043 : ! !DESCRIPTION: Subroutine ExtDat\_Cleanup\_2S removes the given ExtDat type.
1044 : !\\
1045 : !\\
1046 : ! !INTERFACE:
1047 : !
1048 0 : SUBROUTINE ExtDat_Cleanup_2S ( ExtDat )
1049 : !
1050 : ! !INPUT PARAMETERS:
1051 : !
1052 : TYPE(ExtDat_2S), POINTER :: ExtDat
1053 : !
1054 : ! !REVISION HISTORY:
1055 : ! 20 Apr 2013 - C. Keller - Initial version
1056 : ! See https://github.com/geoschem/hemco for complete history
1057 : !EOP
1058 : !------------------------------------------------------------------------------
1059 : !BOC
1060 : ! ================================================================
1061 : ! ExtDat_Cleanup_2S begins here
1062 : ! ================================================================
1063 :
1064 0 : IF ( ASSOCIATED( ExtDat) ) THEN
1065 0 : CALL HCO_ArrCleanup( ExtDat%Arr, DeepClean=.TRUE. )
1066 0 : DEALLOCATE ( ExtDat )
1067 : ENDIF
1068 :
1069 0 : END SUBROUTINE ExtDat_Cleanup_2S
1070 : !EOC
1071 : !------------------------------------------------------------------------------
1072 : ! Harmonized Emissions Component (HEMCO) !
1073 : !------------------------------------------------------------------------------
1074 : !BOP
1075 : !
1076 : ! !IROUTINE: ExtDat_Cleanup_2I
1077 : !
1078 : ! !DESCRIPTION: Subroutine ExtDat\_Cleanup\_2I removes the given ExtDat type.
1079 : !\\
1080 : !\\
1081 : ! !INTERFACE:
1082 : !
1083 0 : SUBROUTINE ExtDat_Cleanup_2I ( ExtDat )
1084 : !
1085 : ! !INPUT PARAMETERS:
1086 : !
1087 : TYPE(ExtDat_2I), POINTER :: ExtDat
1088 : !
1089 : ! !REVISION HISTORY:
1090 : ! 20 Apr 2013 - C. Keller - Initial version
1091 : ! See https://github.com/geoschem/hemco for complete history
1092 : !EOP
1093 : !------------------------------------------------------------------------------
1094 : !BOC
1095 : ! ================================================================
1096 : ! ExtDat_Cleanup_2I begins here
1097 : ! ================================================================
1098 :
1099 0 : IF ( ASSOCIATED( ExtDat) ) THEN
1100 0 : CALL HCO_ArrCleanup( ExtDat%Arr, DeepClean=.TRUE. )
1101 0 : DEALLOCATE ( ExtDat )
1102 : ENDIF
1103 :
1104 0 : END SUBROUTINE ExtDat_Cleanup_2I
1105 : !EOC
1106 : !------------------------------------------------------------------------------
1107 : ! Harmonized Emissions Component (HEMCO) !
1108 : !------------------------------------------------------------------------------
1109 : !BOP
1110 : !
1111 : ! !IROUTINE: ExtDat_Cleanup_3R
1112 : !
1113 : ! !DESCRIPTION: Subroutine ExtDat\_Cleanup\_3R removes the given ExtDat type.
1114 : !\\
1115 : !\\
1116 : ! !INTERFACE:
1117 : !
1118 0 : SUBROUTINE ExtDat_Cleanup_3R( ExtDat )
1119 : !
1120 : ! !INPUT PARAMETERS:
1121 : !
1122 : TYPE(ExtDat_3R), POINTER :: ExtDat
1123 : !
1124 : ! !REVISION HISTORY:
1125 : ! 20 Apr 2013 - C. Keller - Initial version
1126 : ! See https://github.com/geoschem/hemco for complete history
1127 : !EOP
1128 : !------------------------------------------------------------------------------
1129 : !BOC
1130 : ! ================================================================
1131 : ! ExtDat_Cleanup_3R begins here
1132 : ! ================================================================
1133 :
1134 0 : IF ( ASSOCIATED( ExtDat) ) THEN
1135 0 : CALL HCO_ArrCleanup( ExtDat%Arr, DeepClean=.TRUE. )
1136 0 : DEALLOCATE ( ExtDat )
1137 : ENDIF
1138 :
1139 0 : END SUBROUTINE ExtDat_Cleanup_3R
1140 : !EOC
1141 : !------------------------------------------------------------------------------
1142 : ! Harmonized Emissions Component (HEMCO) !
1143 : !------------------------------------------------------------------------------
1144 : !BOP
1145 : !
1146 : ! !IROUTINE: ExtDat_Cleanup_3S
1147 : !
1148 : ! !DESCRIPTION: Subroutine ExtDat\_Cleanup\_3S removes the given ExtDat type.
1149 : !\\
1150 : !\\
1151 : ! !INTERFACE:
1152 : !
1153 0 : SUBROUTINE ExtDat_Cleanup_3S( ExtDat )
1154 : !
1155 : ! !INPUT PARAMETERS:
1156 : !
1157 : TYPE(ExtDat_3S), POINTER :: ExtDat
1158 : !
1159 : ! !REVISION HISTORY:
1160 : ! 20 Apr 2013 - C. Keller - Initial version
1161 : ! See https://github.com/geoschem/hemco for complete history
1162 : !EOP
1163 : !------------------------------------------------------------------------------
1164 : !BOC
1165 : ! ================================================================
1166 : ! ExtDat_Cleanup_3S begins here
1167 : ! ================================================================
1168 :
1169 0 : IF ( ASSOCIATED( ExtDat) ) THEN
1170 0 : CALL HCO_ArrCleanup( ExtDat%Arr, DeepClean=.TRUE. )
1171 0 : DEALLOCATE ( ExtDat )
1172 : ENDIF
1173 :
1174 0 : END SUBROUTINE ExtDat_Cleanup_3S
1175 : !EOC
1176 : !------------------------------------------------------------------------------
1177 : ! Harmonized Emissions Component (HEMCO) !
1178 : !------------------------------------------------------------------------------
1179 : !BOP
1180 : !
1181 : ! !IROUTINE: ExtDat_Set_2R
1182 : !
1183 : ! !DESCRIPTION: Subroutine ExtDat\_Set\_2R sets/updates the data array of an
1184 : ! ExtDat object.
1185 : !\\
1186 : !\\
1187 : ! !INTERFACE:
1188 : !
1189 0 : SUBROUTINE ExtDat_Set_2R ( HcoState, ExtDat, &
1190 : FldName, RC, First, &
1191 : Trgt, Filled, NotFillOk )
1192 : !
1193 : ! !USES:
1194 : !
1195 : USE HCO_ARR_MOD, ONLY : HCO_ArrAssert
1196 : USE HCO_STATE_MOD, ONLY : HCO_State
1197 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
1198 : !
1199 : ! !INPUT PARAMETERS:
1200 : !
1201 : TYPE(HCO_State), POINTER :: HcoState
1202 : TYPE(ExtDat_2R), POINTER :: ExtDat
1203 : CHARACTER(LEN=*), INTENT(IN ) :: FldName
1204 : INTEGER, INTENT(INOUT) :: RC
1205 : LOGICAL, INTENT(IN ), OPTIONAL :: First
1206 : REAL(hp), POINTER , OPTIONAL :: Trgt(:,:)
1207 : LOGICAL, INTENT( OUT), OPTIONAL :: Filled
1208 : LOGICAL, INTENT(IN ), OPTIONAL :: NotFillOk
1209 : !
1210 : ! !REVISION HISTORY:
1211 : ! 03 Apr 2015 - C. Keller - Initial version
1212 : ! See https://github.com/geoschem/hemco for complete history
1213 : !EOP
1214 : !------------------------------------------------------------------------------
1215 : !BOC
1216 : !
1217 : ! !LOCAL VARIABLES:
1218 : !
1219 : INTEGER :: AS, NX, NY
1220 0 : REAL(hp), ALLOCATABLE :: Arr2D(:,:)
1221 : CHARACTER(LEN=255) :: MSG
1222 : CHARACTER(LEN=255) :: LOC = 'ExtDat_Set_2R (hcox_state_mod.F90)'
1223 : LOGICAL :: FRST
1224 : LOGICAL :: FOUND
1225 : LOGICAL :: FailIfNotFilled
1226 :
1227 : ! ================================================================
1228 : ! ExtDat_Set_2R begins here
1229 : ! ================================================================
1230 :
1231 : ! Initialize
1232 0 : RC = HCO_SUCCESS
1233 0 : IF ( PRESENT(Filled) ) Filled = .FALSE.
1234 :
1235 : ! Nothing to do if this ExtDat field is not in use
1236 0 : IF ( .NOT. ExtDat%DoUse ) RETURN
1237 :
1238 : ! Check for fill requirement
1239 0 : IF ( PRESENT(NotFillOk) ) THEN
1240 0 : FailIfNotFilled = .NOT. NotFillOk
1241 : ELSE
1242 : FailIfNotFilled = .TRUE.
1243 : ENDIF
1244 :
1245 : ! First time
1246 0 : IF ( PRESENT(FIRST) ) THEN
1247 0 : FRST = FIRST
1248 : ELSE
1249 : FRST = .FALSE.
1250 : ENDIF
1251 :
1252 : ! On first call or if data is flagged as being read from list, get data
1253 : ! from emissions list
1254 0 : IF ( FRST .OR. ExtDat%FromList ) THEN
1255 :
1256 : ! Allocate temporary array
1257 0 : ALLOCATE(Arr2D(HcoState%NX,HcoState%NY),STAT=AS)
1258 0 : IF ( AS /= 0 ) THEN
1259 0 : CALL HCO_ERROR ( "Arr2D allocation error", RC, THISLOC=LOC )
1260 0 : RETURN
1261 : ENDIF
1262 :
1263 : ! Try to get data from list
1264 0 : CALL HCO_EvalFld( HcoState, TRIM(FldName), Arr2D, RC, FOUND=FOUND )
1265 0 : IF ( RC /= HCO_SUCCESS ) THEN
1266 0 : CALL HCO_ERROR( 'ERROR 57', RC, THISLOC=LOC )
1267 0 : RETURN
1268 : ENDIF
1269 :
1270 : ! On first call, need to make additional checks
1271 0 : IF ( FRST ) THEN
1272 :
1273 : ! If read from list
1274 0 : IF ( FOUND ) THEN
1275 0 : ExtDat%FromList = .TRUE.
1276 :
1277 : ! Make sure array is allocated
1278 0 : CALL HCO_ArrAssert( ExtDat%Arr, HcoState%NX, HcoState%NY, RC )
1279 0 : IF ( RC /= HCO_SUCCESS ) THEN
1280 0 : CALL HCO_ERROR( 'ERROR 58', RC, THISLOC=LOC )
1281 0 : RETURN
1282 : ENDIF
1283 :
1284 : ! Verbose
1285 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1286 0 : MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName)
1287 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1288 : ENDIF
1289 :
1290 : ! Target to data
1291 0 : ELSEIF ( PRESENT(Trgt) ) THEN
1292 :
1293 : ! If target is not associated:
1294 0 : IF ( .NOT. ASSOCIATED(Trgt) ) THEN
1295 0 : IF ( FailIfNotFilled ) THEN
1296 : MSG = 'Cannot fill extension field ' // TRIM(FldName) // &
1297 0 : ' because target field is not associated.'
1298 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1299 0 : RETURN
1300 : ENDIF
1301 :
1302 : ! If target is associated:
1303 : ELSE
1304 :
1305 : ! Make sure dimensions agree
1306 0 : NX = SIZE(Trgt,1)
1307 0 : NY = SIZE(Trgt,2)
1308 :
1309 : ! Must cover the horizontal grid
1310 0 : IF ( (NX/=HcoState%NX) .OR. (NY/=HcoState%NY) ) THEN
1311 0 : WRITE(MSG,*) 'Horizontal dimensions of target data do not ', &
1312 0 : 'correspond to simulation grid: ', &
1313 0 : 'Expected dimensions: ', HcoState%NX, HcoState%NY, &
1314 0 : '; encountered dimensions: ', NX, NY, '. Error occured ', &
1315 0 : 'for field ', TRIM(FldName)
1316 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1317 0 : RETURN
1318 : ENDIF
1319 :
1320 : ! Link data to target
1321 0 : ExtDat%Arr%Val => Trgt
1322 :
1323 : ! Make sure it's not from list
1324 0 : ExtDat%FromList = .FALSE.
1325 :
1326 : ! This array is now filled
1327 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1328 :
1329 : ! Verbose
1330 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1331 0 : MSG = 'Set extension field pointer to external data: ' // TRIM(FldName)
1332 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1333 : ENDIF
1334 : ENDIF
1335 :
1336 : ! Field not found and no target defined
1337 0 : ELSEIF ( FailIfNotFilled ) THEN
1338 0 : MSG = 'Cannot fill extension field ' // TRIM(FldName)
1339 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1340 0 : RETURN
1341 : ENDIF
1342 : ENDIF ! FIRST
1343 :
1344 : ! Eventually copy field from HEMCO list to ExtState. We need to
1345 : ! make a copy and cannot just set a pointer because ExtState fields
1346 : ! are in HEMCO precision but the EmisList fields are in single
1347 : ! precisions.
1348 0 : IF ( ExtDat%FromList ) THEN
1349 0 : IF ( FOUND ) THEN
1350 : ! Copy values and mark array as filled
1351 0 : ExtDat%Arr%Val(:,:) = Arr2D(:,:)
1352 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1353 0 : ELSEIF ( FailIfNotFilled ) Then
1354 0 : MSG = 'Cannot find extension field in HEMCO data list: ' // TRIM(FldName)
1355 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1356 0 : RETURN
1357 : ENDIF
1358 : ENDIF ! FromList
1359 : ENDIF
1360 :
1361 : ! Make sure array exists
1362 0 : IF ( FailIfNotFilled .AND. .NOT. ASSOCIATED(ExtDat%Arr%Val) ) THEN
1363 0 : MSG = 'ExtState array not filled: ' // TRIM(FldName)
1364 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1365 : ENDIF
1366 :
1367 : ! Cleanup
1368 0 : IF ( ALLOCATED(Arr2D) ) DEALLOCATE(Arr2D)
1369 :
1370 : ! Return w/ success
1371 0 : RC = HCO_SUCCESS
1372 :
1373 0 : END SUBROUTINE ExtDat_Set_2R
1374 : !EOC
1375 : !------------------------------------------------------------------------------
1376 : ! Harmonized Emissions Component (HEMCO) !
1377 : !------------------------------------------------------------------------------
1378 : !BOP
1379 : !
1380 : ! !IROUTINE: ExtDat_Set_2S
1381 : !
1382 : ! !DESCRIPTION: Subroutine ExtDat\_Set\_2S sets/updates the data array of an
1383 : ! ExtDat object.
1384 : !\\
1385 : !\\
1386 : ! !INTERFACE:
1387 : !
1388 0 : SUBROUTINE ExtDat_Set_2S ( HcoState, ExtDat, &
1389 : FldName, RC, First, &
1390 : Trgt, Filled, NotFillOk )
1391 : !
1392 : ! !USES:
1393 : !
1394 : USE HCO_ARR_MOD, ONLY : HCO_ArrAssert
1395 : USE HCO_STATE_MOD, ONLY : HCO_State
1396 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
1397 : !
1398 : ! !INPUT PARAMETERS:
1399 : !
1400 : TYPE(HCO_State), POINTER :: HcoState
1401 : TYPE(ExtDat_2S), POINTER :: ExtDat
1402 : CHARACTER(LEN=*), INTENT(IN ) :: FldName
1403 : INTEGER, INTENT(INOUT) :: RC
1404 : LOGICAL, INTENT(IN ), OPTIONAL :: First
1405 : REAL(sp), POINTER , OPTIONAL :: Trgt(:,:)
1406 : LOGICAL, INTENT( OUT), OPTIONAL :: Filled
1407 : LOGICAL, INTENT(IN ), OPTIONAL :: NotFillOk
1408 : !
1409 : ! !REVISION HISTORY:
1410 : ! 03 Apr 2015 - C. Keller - Initial version
1411 : ! See https://github.com/geoschem/hemco for complete history
1412 : !EOP
1413 : !------------------------------------------------------------------------------
1414 : !BOC
1415 : !
1416 : ! !LOCAL VARIABLES:
1417 : !
1418 : INTEGER :: AS, NX, NY
1419 0 : REAL(hp), ALLOCATABLE :: Arr2D(:,:)
1420 : CHARACTER(LEN=255) :: MSG
1421 : CHARACTER(LEN=255) :: LOC = 'ExtDat_Set_2S (hcox_state_mod.F90)'
1422 : LOGICAL :: FRST
1423 : LOGICAL :: FOUND
1424 : LOGICAL :: FailIfNotFilled
1425 :
1426 : ! ================================================================
1427 : ! ExtDat_Set_2S begins here
1428 : ! ================================================================
1429 :
1430 : ! Init
1431 0 : RC = HCO_SUCCESS
1432 0 : IF ( PRESENT(Filled) ) Filled = .FALSE.
1433 :
1434 : ! Nothing to do if this ExtDat field is not in use
1435 0 : IF ( .NOT. ExtDat%DoUse ) RETURN
1436 :
1437 : ! Check for fill requirement
1438 0 : IF ( PRESENT(NotFillOk) ) THEN
1439 0 : FailIfNotFilled = .NOT. NotFillOk
1440 : ELSE
1441 : FailIfNotFilled = .TRUE.
1442 : ENDIF
1443 :
1444 : ! First time
1445 0 : IF ( PRESENT(FIRST) ) THEN
1446 0 : FRST = FIRST
1447 : ELSE
1448 : FRST = .FALSE.
1449 : ENDIF
1450 :
1451 : ! On first call or if data is flagged as being read from list, get data
1452 : ! from emissions list
1453 0 : IF ( FRST .OR. ExtDat%FromList ) THEN
1454 :
1455 : ! Allocate temporary array
1456 0 : ALLOCATE(Arr2D(HcoState%NX,HcoState%NY),STAT=AS)
1457 0 : IF ( AS /= 0 ) THEN
1458 0 : CALL HCO_ERROR ( "Arr2D allocation error", RC, THISLOC=LOC )
1459 0 : RETURN
1460 : ENDIF
1461 :
1462 : ! Try to get data from list
1463 0 : CALL HCO_EvalFld( HcoState, TRIM(FldName), Arr2D, RC, FOUND=FOUND )
1464 0 : IF ( RC /= HCO_SUCCESS ) THEN
1465 0 : CALL HCO_ERROR( 'ERROR 59', RC, THISLOC=LOC )
1466 0 : RETURN
1467 : ENDIF
1468 :
1469 : ! On first call, need to make additional checks
1470 0 : IF ( FRST ) THEN
1471 :
1472 : ! If read from list
1473 0 : IF ( FOUND ) THEN
1474 0 : ExtDat%FromList = .TRUE.
1475 :
1476 : ! Make sure array is allocated
1477 0 : CALL HCO_ArrAssert( ExtDat%Arr, HcoState%NX, HcoState%NY, RC )
1478 0 : IF ( RC /= HCO_SUCCESS ) THEN
1479 0 : CALL HCO_ERROR( 'ERROR 60', RC, THISLOC=LOC )
1480 0 : RETURN
1481 : ENDIF
1482 :
1483 : ! Verbose
1484 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1485 0 : MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName)
1486 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1487 : ENDIF
1488 :
1489 : ! Target to data
1490 0 : ELSEIF ( PRESENT(Trgt) ) THEN
1491 :
1492 : ! If target is not associated:
1493 0 : IF ( .NOT. ASSOCIATED(Trgt) ) THEN
1494 0 : IF ( FailIfNotFilled ) THEN
1495 : MSG = 'Cannot fill extension field ' // TRIM(FldName) // &
1496 0 : ' because target field is not associated.'
1497 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1498 0 : RETURN
1499 : ENDIF
1500 :
1501 : ! If target is associated:
1502 : ELSE
1503 :
1504 : ! Make sure dimensions agree
1505 0 : NX = SIZE(Trgt,1)
1506 0 : NY = SIZE(Trgt,2)
1507 :
1508 : ! Must cover the horizontal grid
1509 0 : IF ( (NX/=HcoState%NX) .OR. (NY/=HcoState%NY) ) THEN
1510 0 : WRITE(MSG,*) 'Horizontal dimensions of target data do not ', &
1511 0 : 'correspond to simulation grid: ', &
1512 0 : 'Expected dimensions: ', HcoState%NX, HcoState%NY, &
1513 0 : '; encountered dimensions: ', NX, NY, '. Error occured ', &
1514 0 : 'for field ', TRIM(FldName)
1515 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1516 0 : RETURN
1517 : ENDIF
1518 :
1519 : ! Link data to target
1520 0 : ExtDat%Arr%Val => Trgt
1521 :
1522 : ! Make sure it's not from list
1523 0 : ExtDat%FromList = .FALSE.
1524 :
1525 : ! Mark as filled
1526 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1527 :
1528 : ! Verbose
1529 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1530 0 : MSG = 'Set extension field pointer to external data: ' // TRIM(FldName)
1531 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1532 : ENDIF
1533 : ENDIF
1534 :
1535 : ! Field not found and no target defined
1536 0 : ELSEIF ( FailIfNotFilled ) THEN
1537 0 : MSG = 'Cannot fill extension field ' // TRIM(FldName)
1538 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1539 0 : RETURN
1540 : ENDIF
1541 : ENDIF ! FIRST
1542 :
1543 : ! Eventually copy field from HEMCO list to ExtState. We need to
1544 : ! make a copy and cannot just set a pointer because ExtState fields
1545 : ! are in HEMCO precision but the EmisList fields are in single
1546 : ! precisions.
1547 0 : IF ( ExtDat%FromList ) THEN
1548 0 : IF ( FOUND ) THEN
1549 : ! Copy values and mark as filled
1550 0 : ExtDat%Arr%Val(:,:) = Arr2D(:,:)
1551 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1552 0 : ELSEIF ( FailIfNotFilled ) THEN
1553 0 : MSG = 'Cannot find extension field in HEMCO data list: ' // TRIM(FldName)
1554 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1555 0 : RETURN
1556 : ENDIF
1557 : ENDIF ! FromList
1558 : ENDIF
1559 :
1560 : ! Make sure array exists
1561 0 : IF ( FailIfNotFilled .AND. .NOT. ASSOCIATED(ExtDat%Arr%Val) ) THEN
1562 0 : MSG = 'ExtState array not filled: ' // TRIM(FldName)
1563 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1564 : ENDIF
1565 :
1566 : ! Cleanup
1567 0 : IF ( ALLOCATED(Arr2D) ) DEALLOCATE(Arr2D)
1568 :
1569 : ! Return w/ success
1570 0 : RC = HCO_SUCCESS
1571 :
1572 0 : END SUBROUTINE ExtDat_Set_2S
1573 : !EOC
1574 : !------------------------------------------------------------------------------
1575 : ! Harmonized Emissions Component (HEMCO) !
1576 : !------------------------------------------------------------------------------
1577 : !BOP
1578 : !
1579 : ! !IROUTINE: ExtDat_Set_2I
1580 : !
1581 : ! !DESCRIPTION: Subroutine ExtDat\_Set\_2I sets/updates the data array of an
1582 : ! ExtDat object.
1583 : !\\
1584 : !\\
1585 : ! !INTERFACE:
1586 : !
1587 0 : SUBROUTINE ExtDat_Set_2I ( HcoState, ExtDat, &
1588 : FldName, RC, First, &
1589 : Trgt, Filled, NotFillOk )
1590 : !
1591 : ! !USES:
1592 : !
1593 : USE HCO_ARR_MOD, ONLY : HCO_ArrAssert
1594 : USE HCO_STATE_MOD, ONLY : HCO_State
1595 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
1596 : !
1597 : ! !INPUT PARAMETERS:
1598 : !
1599 : TYPE(HCO_State), POINTER :: HcoState
1600 : TYPE(ExtDat_2I), POINTER :: ExtDat
1601 : CHARACTER(LEN=*), INTENT(IN ) :: FldName
1602 : INTEGER, INTENT(INOUT) :: RC
1603 : LOGICAL, INTENT(IN ), OPTIONAL :: First
1604 : INTEGER, POINTER, OPTIONAL :: Trgt(:,:)
1605 : LOGICAL, INTENT( OUT), OPTIONAL :: Filled
1606 : LOGICAL, INTENT(IN ), OPTIONAL :: NotFillOk
1607 : !
1608 : ! !REVISION HISTORY:
1609 : ! 03 Apr 2015 - C. Keller - Initial version
1610 : ! See https://github.com/geoschem/hemco for complete history
1611 : !EOP
1612 : !------------------------------------------------------------------------------
1613 : !BOC
1614 : !
1615 : ! !LOCAL VARIABLES:
1616 : !
1617 : INTEGER :: AS, NX, NY
1618 0 : REAL(hp), ALLOCATABLE :: Arr2D(:,:)
1619 : CHARACTER(LEN=255) :: MSG
1620 : CHARACTER(LEN=255) :: LOC = 'ExtDat_Set_2I (hcox_state_mod.F90)'
1621 : LOGICAL :: FRST
1622 : LOGICAL :: FOUND
1623 : LOGICAL :: FailIfNotFilled
1624 :
1625 : ! ================================================================
1626 : ! ExtDat_Set_2I begins here
1627 : ! ================================================================
1628 :
1629 : ! Init
1630 0 : RC = HCO_SUCCESS
1631 0 : IF ( PRESENT(Filled) ) Filled = .FALSE.
1632 :
1633 : ! Nothing to do if this ExtDat field is not in use
1634 0 : IF ( .NOT. ExtDat%DoUse ) RETURN
1635 :
1636 : ! First time
1637 0 : IF ( PRESENT(FIRST) ) THEN
1638 0 : FRST = FIRST
1639 : ELSE
1640 : FRST = .FALSE.
1641 : ENDIF
1642 :
1643 : ! Check for fill requirement
1644 0 : IF ( PRESENT(NotFillOk) ) THEN
1645 0 : FailIfNotFilled = .NOT. NotFillOk
1646 : ELSE
1647 : FailIfNotFilled = .TRUE.
1648 : ENDIF
1649 :
1650 : ! On first call or if data is flagged as being read from list, get data
1651 : ! from emissions list
1652 0 : IF ( FRST .OR. ExtDat%FromList ) THEN
1653 :
1654 : ! Allocate temporary array
1655 0 : ALLOCATE(Arr2D(HcoState%NX,HcoState%NY),STAT=AS)
1656 0 : IF ( AS /= 0 ) THEN
1657 0 : CALL HCO_ERROR ( "Arr2D allocation error", RC, THISLOC=LOC )
1658 0 : RETURN
1659 : ENDIF
1660 :
1661 : ! Try to get data from list
1662 0 : CALL HCO_EvalFld( HcoState, TRIM(FldName), Arr2D, RC, FOUND=FOUND )
1663 0 : IF ( RC /= HCO_SUCCESS ) THEN
1664 0 : CALL HCO_ERROR( 'ERROR 61', RC, THISLOC=LOC )
1665 0 : RETURN
1666 : ENDIF
1667 :
1668 : ! On first call, need to make additional checks
1669 0 : IF ( FRST ) THEN
1670 :
1671 : ! If read from list
1672 0 : IF ( FOUND ) THEN
1673 0 : ExtDat%FromList = .TRUE.
1674 :
1675 : ! Make sure array is allocated
1676 0 : CALL HCO_ArrAssert( ExtDat%Arr, HcoState%NX, HcoState%NY, RC )
1677 0 : IF ( RC /= HCO_SUCCESS ) THEN
1678 0 : CALL HCO_ERROR( 'ERROR 62', RC, THISLOC=LOC )
1679 0 : RETURN
1680 : ENDIF
1681 :
1682 : ! Verbose
1683 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1684 0 : MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName)
1685 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1686 : ENDIF
1687 :
1688 : ! Target to data
1689 0 : ELSEIF ( PRESENT(Trgt) ) THEN
1690 :
1691 : ! If target is not associated:
1692 0 : IF ( .NOT. ASSOCIATED(Trgt) ) THEN
1693 0 : IF ( FailIfNotFilled ) THEN
1694 : MSG = 'Cannot fill extension field ' // TRIM(FldName) // &
1695 0 : ' because target field is not associated.'
1696 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1697 0 : RETURN
1698 : ENDIF
1699 :
1700 : ! If target is associated:
1701 : ELSE
1702 :
1703 : ! Make sure dimensions agree
1704 0 : NX = SIZE(Trgt,1)
1705 0 : NY = SIZE(Trgt,2)
1706 :
1707 : ! Must cover the horizontal grid
1708 0 : IF ( (NX /= HcoState%NX) .OR. (NY /= HcoState%NY) ) THEN
1709 0 : WRITE(MSG,*) 'Horizontal dimensions of target data do not ', &
1710 0 : 'correspond to simulation grid: ', &
1711 0 : 'Expected dimensions: ', HcoState%NX, HcoState%NY, &
1712 0 : '; encountered dimensions: ', NX, NY, '. Error occured ', &
1713 0 : 'for field ', TRIM(FldName)
1714 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1715 0 : RETURN
1716 : ENDIF
1717 :
1718 : ! Link data to target
1719 0 : ExtDat%Arr%Val => Trgt
1720 :
1721 : ! Make sure it's not from list
1722 0 : ExtDat%FromList = .FALSE.
1723 :
1724 : ! Mark as filled
1725 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1726 :
1727 : ! Verbose
1728 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1729 0 : MSG = 'Set extension field pointer to external data: ' // TRIM(FldName)
1730 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1731 : ENDIF
1732 : ENDIF
1733 :
1734 : ! Not found in list and no target defined
1735 0 : ELSEIF ( FailIfNotFilled ) THEN
1736 0 : MSG = 'Cannot fill extension field ' // TRIM(FldName)
1737 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1738 0 : RETURN
1739 : ENDIF
1740 :
1741 : ENDIF ! FIRST
1742 :
1743 : ! Eventually copy field from HEMCO list to ExtState. We need to
1744 : ! make a copy and cannot just set a pointer because ExtState fields
1745 : ! are in HEMCO precision but the EmisList fields are in single
1746 : ! precisions.
1747 0 : IF ( ExtDat%FromList ) THEN
1748 0 : IF ( FOUND ) THEN
1749 :
1750 : ! Copy values and mark as filled
1751 0 : ExtDat%Arr%Val(:,:) = Arr2D(:,:)
1752 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1753 :
1754 0 : ELSEIF ( FailIfNotFilled ) THEN
1755 0 : MSG = 'Cannot find extension field in HEMCO data list: ' // TRIM(FldName)
1756 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1757 0 : RETURN
1758 : ENDIF
1759 :
1760 : ENDIF !FromList
1761 : ENDIF
1762 :
1763 : ! Make sure array exists
1764 0 : IF ( FailIfNotFilled .AND. .NOT. ASSOCIATED(ExtDat%Arr%Val) ) THEN
1765 0 : MSG = 'ExtState array not filled: ' // TRIM(FldName)
1766 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1767 : ENDIF
1768 :
1769 : ! Cleanup
1770 0 : IF ( ALLOCATED(Arr2D) ) DEALLOCATE(Arr2D)
1771 :
1772 : ! Return w/ success
1773 0 : RC = HCO_SUCCESS
1774 :
1775 0 : END SUBROUTINE ExtDat_Set_2I
1776 : !EOC
1777 : !------------------------------------------------------------------------------
1778 : ! Harmonized Emissions Component (HEMCO) !
1779 : !------------------------------------------------------------------------------
1780 : !BOP
1781 : !
1782 : ! !IROUTINE: ExtDat_Set_3R
1783 : !
1784 : ! !DESCRIPTION: Subroutine ExtDat\_Set\_3R sets/updates the data array of an
1785 : ! ExtDat object.
1786 : !\\
1787 : !\\
1788 : ! !INTERFACE:
1789 : !
1790 0 : SUBROUTINE ExtDat_Set_3R ( HcoState, ExtDat, FldName, &
1791 : RC, First, Trgt, OnLevEdge, &
1792 : Filled, NotFillOk )
1793 : !
1794 : ! !USES:
1795 : !
1796 : USE HCO_ARR_MOD, ONLY : HCO_ArrAssert
1797 : USE HCO_STATE_MOD, ONLY : HCO_State
1798 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
1799 : !
1800 : ! !INPUT PARAMETERS:
1801 : !
1802 : TYPE(HCO_State), POINTER :: HcoState
1803 : TYPE(ExtDat_3R), POINTER :: ExtDat
1804 : CHARACTER(LEN=*), INTENT(IN ) :: FldName
1805 : INTEGER, INTENT(INOUT) :: RC
1806 : LOGICAL, INTENT(IN ), OPTIONAL :: First
1807 : REAL(hp), POINTER , OPTIONAL :: Trgt(:,:,:)
1808 : LOGICAL, INTENT(IN ), OPTIONAL :: OnLevEdge
1809 : LOGICAL, INTENT( OUT), OPTIONAL :: Filled
1810 : LOGICAL, INTENT(IN ), OPTIONAL :: NotFillOk
1811 : !
1812 : ! !REVISION HISTORY:
1813 : ! 03 Apr 2015 - C. Keller - Initial version
1814 : ! See https://github.com/geoschem/hemco for complete history
1815 : !EOP
1816 : !------------------------------------------------------------------------------
1817 : !BOC
1818 : !
1819 : ! !LOCAL VARIABLES:
1820 : !
1821 : INTEGER :: AS, NX, NY, NZ, NZ_EXPECTED
1822 : INTEGER :: L
1823 : LOGICAL :: FRST
1824 : LOGICAL :: FOUND
1825 : LOGICAL :: FailIfNotFilled
1826 0 : REAL(hp), ALLOCATABLE :: Arr3D(:,:,:)
1827 : CHARACTER(LEN=255) :: MSG
1828 : CHARACTER(LEN=255) :: LOC = 'ExtDat_Set_3R (hcox_state_mod.F90)'
1829 :
1830 : ! ================================================================
1831 : ! ExtDat_Set_3R begins here
1832 : ! ================================================================
1833 :
1834 : ! Init
1835 0 : RC = HCO_SUCCESS
1836 0 : IF ( PRESENT(Filled) ) Filled = .FALSE.
1837 :
1838 : ! Nothing to do if this ExtDat field is not in use
1839 0 : IF ( .NOT. ExtDat%DoUse ) RETURN
1840 :
1841 : ! First time
1842 0 : IF ( PRESENT(FIRST) ) THEN
1843 0 : FRST = FIRST
1844 : ELSE
1845 : FRST = .FALSE.
1846 : ENDIF
1847 :
1848 : ! Check for fill requirement
1849 0 : IF ( PRESENT(NotFillOk) ) THEN
1850 0 : FailIfNotFilled = .NOT. NotFillOk
1851 : ELSE
1852 : FailIfNotFilled = .TRUE.
1853 : ENDIF
1854 :
1855 : ! Expected number of vertical levels: NZ if not on edge, NZ+1 if on edge
1856 0 : NZ_EXPECTED = HcoState%NZ
1857 0 : IF ( PRESENT(OnLevEdge) ) THEN
1858 0 : IF ( OnLevEdge ) THEN
1859 0 : NZ_EXPECTED = HcoState%NZ + 1
1860 : ENDIF
1861 : ENDIF
1862 :
1863 : ! On first call or if data is flagged as being read from list, get data
1864 : ! from emissions list
1865 0 : IF ( FRST .OR. ExtDat%FromList ) THEN
1866 :
1867 : ! Allocate temporary array
1868 0 : ALLOCATE(Arr3D(HcoState%NX,HcoState%NY,NZ_EXPECTED),STAT=AS)
1869 0 : IF ( AS /= 0 ) THEN
1870 0 : CALL HCO_ERROR ( "Arr3D allocation error", RC, THISLOC=LOC )
1871 0 : RETURN
1872 : ENDIF
1873 :
1874 : ! Try to get data from list
1875 0 : CALL HCO_EvalFld( HcoState, TRIM(FldName), Arr3D, RC, FOUND=FOUND )
1876 0 : IF ( RC /= HCO_SUCCESS ) THEN
1877 0 : CALL HCO_ERROR( 'ERROR 63', RC, THISLOC=LOC )
1878 0 : RETURN
1879 : ENDIF
1880 :
1881 : ! On first call, need to make additional checks
1882 0 : IF ( FRST ) THEN
1883 :
1884 : ! If read from list
1885 0 : IF ( FOUND ) THEN
1886 0 : ExtDat%FromList = .TRUE.
1887 :
1888 : ! Make sure array is allocated
1889 0 : CALL HCO_ArrAssert( ExtDat%Arr, HcoState%NX, HcoState%NY, NZ_EXPECTED, RC )
1890 0 : IF ( RC /= HCO_SUCCESS ) THEN
1891 0 : CALL HCO_ERROR( 'ERROR 64', RC, THISLOC=LOC )
1892 0 : RETURN
1893 : ENDIF
1894 :
1895 : ! Verbose
1896 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1897 0 : MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName)
1898 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1899 : ENDIF
1900 :
1901 : ! Target to data
1902 0 : ELSEIF ( PRESENT(Trgt) ) THEN
1903 :
1904 : ! If target is not associated:
1905 0 : IF ( .NOT. ASSOCIATED(Trgt) ) THEN
1906 0 : IF ( FailIfNotFilled ) THEN
1907 : MSG = 'Cannot fill extension field ' // TRIM(FldName) // &
1908 0 : ' because target field is not associated.'
1909 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1910 0 : RETURN
1911 : ENDIF
1912 :
1913 : ! If target is associated:
1914 : ELSE
1915 :
1916 : ! Make sure dimensions agree
1917 0 : NX = SIZE(Trgt,1)
1918 0 : NY = SIZE(Trgt,2)
1919 0 : NZ = SIZE(Trgt,3)
1920 :
1921 : ! Must cover the horizontal grid
1922 0 : IF ( (NX/=HcoState%NX) .OR. (NY/=HcoState%NY) .OR. (NZ/=NZ_EXPECTED) ) THEN
1923 0 : WRITE(MSG,*) 'Dimensions of target data do not ', &
1924 0 : 'correspond to simulation grid: ', &
1925 0 : 'Expected dimensions: ', HcoState%NX, HcoState%NY, NZ_EXPECTED, &
1926 0 : '; encountered dimensions: ', NX, NY, NZ, '. Error occured ', &
1927 0 : 'for field ', TRIM(FldName)
1928 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1929 0 : RETURN
1930 : ENDIF
1931 :
1932 : ! Link data to target
1933 0 : ExtDat%Arr%Val => Trgt
1934 :
1935 : ! Make sure it's not from list
1936 0 : ExtDat%FromList = .FALSE.
1937 :
1938 : ! Mark as filled
1939 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1940 :
1941 : ! Verbose
1942 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
1943 0 : MSG = 'Set extension field pointer to external data: ' // TRIM(FldName)
1944 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1945 : ENDIF
1946 : ENDIF
1947 :
1948 : ! Not found in list and no target defined
1949 0 : ELSEIF ( FailIfNotFilled ) THEN
1950 : ! Target array must be present
1951 : IF ( .NOT. PRESENT(Trgt) ) THEN
1952 0 : MSG = 'Cannot fill extension field ' // TRIM(FldName)
1953 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1954 0 : RETURN
1955 : ENDIF
1956 : ENDIF
1957 :
1958 : ENDIF ! FIRST
1959 :
1960 : ! Eventually copy field from HEMCO list to ExtState. We need to
1961 : ! make a copy and cannot just set a pointer because ExtState fields
1962 : ! are in HEMCO precision but the EmisList fields are in single
1963 : ! precisions.
1964 0 : IF ( ExtDat%FromList ) THEN
1965 0 : IF ( FOUND ) THEN
1966 :
1967 : ! Copy data and mark as filled
1968 0 : ExtDat%Arr%Val(:,:,:) = Arr3D(:,:,:)
1969 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
1970 :
1971 0 : ELSEIF ( FailIfNotFilled ) THEN
1972 0 : MSG = 'Cannot find extension field in HEMCO data list: ' // TRIM(FldName)
1973 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1974 0 : RETURN
1975 :
1976 : ENDIF
1977 : ENDIF !FromList
1978 : ENDIF
1979 :
1980 : ! Make sure array exists
1981 0 : IF ( FailIfNotFilled .AND. .NOT. ASSOCIATED(ExtDat%Arr%Val) ) THEN
1982 0 : MSG = 'ExtState array not filled: ' // TRIM(FldName)
1983 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
1984 : ENDIF
1985 :
1986 : ! Cleanup
1987 0 : IF ( ALLOCATED(Arr3D) ) DEALLOCATE(Arr3D)
1988 :
1989 : ! Return w/ success
1990 0 : RC = HCO_SUCCESS
1991 :
1992 0 : END SUBROUTINE ExtDat_Set_3R
1993 : !EOC
1994 : !------------------------------------------------------------------------------
1995 : ! Harmonized Emissions Component (HEMCO) !
1996 : !------------------------------------------------------------------------------
1997 : !BOP
1998 : !
1999 : ! !IROUTINE: ExtDat_Set_3S
2000 : !
2001 : ! !DESCRIPTION: Subroutine ExtDat\_Set\_3S sets/updates the data array of an
2002 : ! ExtDat object.
2003 : !\\
2004 : !\\
2005 : ! !INTERFACE:
2006 : !
2007 0 : SUBROUTINE ExtDat_Set_3S ( HcoState, ExtDat, FldName, &
2008 : RC, First, Trgt, OnLevEdge, &
2009 : Filled, NotFillOk )
2010 : !
2011 : ! !USES:
2012 : !
2013 : USE HCO_ARR_MOD, ONLY : HCO_ArrAssert
2014 : USE HCO_STATE_MOD, ONLY : HCO_State
2015 : USE HCO_CALC_MOD, ONLY : HCO_EvalFld
2016 : !
2017 : ! !INPUT PARAMETERS:
2018 : !
2019 : TYPE(HCO_State), POINTER :: HcoState
2020 : TYPE(ExtDat_3S), POINTER :: ExtDat
2021 : CHARACTER(LEN=*), INTENT(IN ) :: FldName
2022 : INTEGER, INTENT(INOUT) :: RC
2023 : LOGICAL, INTENT(IN ), OPTIONAL :: First
2024 : REAL(sp), POINTER , OPTIONAL :: Trgt(:,:,:)
2025 : LOGICAL, INTENT(IN ), OPTIONAL :: OnLevEdge
2026 : LOGICAL, INTENT( OUT), OPTIONAL :: Filled
2027 : LOGICAL, INTENT(IN ), OPTIONAL :: NotFillOk
2028 : !
2029 : ! !REVISION HISTORY:
2030 : ! 03 Apr 2015 - C. Keller - Initial version
2031 : ! See https://github.com/geoschem/hemco for complete history
2032 : !EOP
2033 : !------------------------------------------------------------------------------
2034 : !BOC
2035 : !
2036 : ! !LOCAL VARIABLES:
2037 : !
2038 : INTEGER :: AS, NX, NY, NZ, NZ_EXPECTED
2039 : INTEGER :: L
2040 : LOGICAL :: FRST
2041 : LOGICAL :: FOUND
2042 : LOGICAL :: FailIfNotFilled
2043 0 : REAL(hp), ALLOCATABLE :: Arr3D(:,:,:)
2044 : CHARACTER(LEN=255) :: MSG
2045 : CHARACTER(LEN=255) :: LOC = 'ExtDat_Set_3S (hcox_state_mod.F90)'
2046 :
2047 : ! ================================================================
2048 : ! ExtDat_Set_3S begins here
2049 : ! ================================================================
2050 :
2051 : ! Init
2052 0 : RC = HCO_SUCCESS
2053 0 : IF ( PRESENT(Filled) ) Filled = .FALSE.
2054 :
2055 : ! Nothing to do if this ExtDat field is not in use
2056 0 : IF ( .NOT. ExtDat%DoUse ) RETURN
2057 :
2058 : ! First time
2059 0 : IF ( PRESENT(FIRST) ) THEN
2060 0 : FRST = FIRST
2061 : ELSE
2062 : FRST = .FALSE.
2063 : ENDIF
2064 :
2065 : ! Check for fill requirement
2066 0 : IF ( PRESENT(NotFillOk) ) THEN
2067 0 : FailIfNotFilled = .NOT. NotFillOk
2068 : ELSE
2069 : FailIfNotFilled = .TRUE.
2070 : ENDIF
2071 :
2072 : ! Expected number of vertical levels: NZ if not on edge, NZ+1 if on edge
2073 0 : NZ_EXPECTED = HcoState%NZ
2074 0 : IF ( PRESENT(OnLevEdge) ) THEN
2075 0 : IF ( OnLevEdge ) THEN
2076 0 : NZ_EXPECTED = HcoState%NZ + 1
2077 : ENDIF
2078 : ENDIF
2079 :
2080 : ! On first call or if data is flagged as being read from list, get data
2081 : ! from emissions list
2082 0 : IF ( FRST .OR. ExtDat%FromList ) THEN
2083 :
2084 : ! Allocate temporary array
2085 0 : ALLOCATE(Arr3D(HcoState%NX,HcoState%NY,NZ_EXPECTED),STAT=AS)
2086 0 : IF ( AS /= 0 ) THEN
2087 0 : CALL HCO_ERROR ( "Arr3D allocation error", RC, THISLOC=LOC )
2088 0 : RETURN
2089 : ENDIF
2090 :
2091 : ! Try to get data from list
2092 0 : CALL HCO_EvalFld( HcoState, TRIM(FldName), Arr3D, RC, FOUND=FOUND )
2093 0 : IF ( RC /= HCO_SUCCESS ) THEN
2094 0 : CALL HCO_ERROR( 'ERROR 65', RC, THISLOC=LOC )
2095 0 : RETURN
2096 : ENDIF
2097 :
2098 : ! On first call, need to make additional checks
2099 0 : IF ( FRST ) THEN
2100 :
2101 : ! If read from list
2102 0 : IF ( FOUND ) THEN
2103 0 : ExtDat%FromList = .TRUE.
2104 :
2105 : ! Make sure array is allocated
2106 0 : CALL HCO_ArrAssert( ExtDat%Arr, HcoState%NX, HcoState%NY, NZ_EXPECTED, RC )
2107 0 : IF ( RC /= HCO_SUCCESS ) THEN
2108 0 : CALL HCO_ERROR( 'ERROR 66', RC, THISLOC=LOC )
2109 0 : RETURN
2110 : ENDIF
2111 :
2112 : ! Verbose
2113 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
2114 0 : MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName)
2115 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2116 : ENDIF
2117 :
2118 : ! Target to data
2119 0 : ELSEIF ( PRESENT(Trgt) ) THEN
2120 :
2121 : ! If target is not associated:
2122 0 : IF ( .NOT. ASSOCIATED(Trgt) ) THEN
2123 0 : IF ( FailIfNotFilled ) THEN
2124 : MSG = 'Cannot fill extension field ' // TRIM(FldName) // &
2125 0 : ' because target field is not associated.'
2126 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
2127 0 : RETURN
2128 : ENDIF
2129 :
2130 : ! If target is associated:
2131 : ELSE
2132 :
2133 : ! Make sure dimensions agree
2134 0 : NX = SIZE(Trgt,1)
2135 0 : NY = SIZE(Trgt,2)
2136 0 : NZ = SIZE(Trgt,3)
2137 :
2138 : ! Must cover the horizontal grid
2139 0 : IF ( (NX/=HcoState%NX) .OR. (NY/=HcoState%NY) .OR. (NZ/=NZ_EXPECTED) ) THEN
2140 0 : WRITE(MSG,*) 'Dimensions of target data do not ', &
2141 0 : 'correspond to simulation grid: ', &
2142 0 : 'Expected dimensions: ', HcoState%NX, HcoState%NY, NZ_EXPECTED, &
2143 0 : '; encountered dimensions: ', NX, NY, NZ, '. Error occured ', &
2144 0 : 'for field ', TRIM(FldName)
2145 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
2146 0 : RETURN
2147 : ENDIF
2148 :
2149 : ! Link data to target
2150 0 : ExtDat%Arr%Val => Trgt
2151 :
2152 : ! Make sure it's not from list
2153 0 : ExtDat%FromList = .FALSE.
2154 :
2155 : ! Mark as filled
2156 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
2157 :
2158 : ! Verbose
2159 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
2160 0 : MSG = 'Set extension field pointer to external data: ' // TRIM(FldName)
2161 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2162 : ENDIF
2163 : ENDIF
2164 :
2165 : ! Not found in list and no target defined
2166 0 : ELSEIF ( FailIfNotFilled ) THEN
2167 : ! Target array must be present
2168 : IF ( .NOT. PRESENT(Trgt) ) THEN
2169 0 : MSG = 'Cannot fill extension field ' // TRIM(FldName)
2170 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
2171 0 : RETURN
2172 : ENDIF
2173 : ENDIF
2174 :
2175 : ENDIF ! FIRST
2176 :
2177 : ! Eventually copy field from HEMCO list to ExtState. We need to
2178 : ! make a copy and cannot just set a pointer because ExtState fields
2179 : ! are in HEMCO precision but the EmisList fields are in single
2180 : ! precisions.
2181 0 : IF ( ExtDat%FromList ) THEN
2182 0 : IF ( FOUND ) THEN
2183 : ! Copy data and mark as filled
2184 0 : ExtDat%Arr%Val(:,:,:) = Arr3D(:,:,:)
2185 0 : IF ( PRESENT(Filled) ) Filled = .TRUE.
2186 0 : ELSEIF ( FailIfNotFilled ) THEN
2187 0 : MSG = 'Cannot find extension field in HEMCO data list: ' // TRIM(FldName)
2188 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
2189 0 : RETURN
2190 : ENDIF
2191 : ENDIF !FromList
2192 : ENDIF
2193 :
2194 : ! Make sure array exists
2195 0 : IF ( FailIfNotFilled .AND. .NOT. ASSOCIATED(ExtDat%Arr%Val) ) THEN
2196 0 : MSG = 'ExtState array not filled: ' // TRIM(FldName)
2197 0 : CALL HCO_ERROR(MSG, RC, THISLOC=LOC )
2198 : ENDIF
2199 :
2200 : ! Cleanup
2201 0 : IF ( ALLOCATED(Arr3D) ) DEALLOCATE(Arr3D)
2202 :
2203 : ! Return w/ success
2204 0 : RC = HCO_SUCCESS
2205 :
2206 0 : END SUBROUTINE ExtDat_Set_3S
2207 : !EOC
2208 0 : END MODULE HCOX_STATE_MOD
|
