Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_readlist_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_ReadList\_Mod contains routines and variables
9 : ! for the HEMCO ReadList. ReadList is a collection of all data containers
10 : ! used by HEMCO. They are categorized according to their reading update
11 : ! frequency, i.e all data containers that need to be updated on an annual
12 : ! basis are stored in ReadList 'Year', etc. The following reading update
13 : ! frequencies are supported:
14 : !\\
15 : !\\
16 : ! \begin{itemize}
17 : ! \item Year: update every year (annual data)
18 : ! \item Month: update every month (monthly data)
19 : ! \item Day: update every day (daily data)
20 : ! \item Hour: update every hour (hourly data)
21 : ! \item Hour3: update every 3 hours (3-hourly data)
22 : ! \item Once: update only once (time-invariant data)
23 : ! \item Always: update every time step
24 : ! \end{itemize}
25 : !
26 : ! !INTERFACE:
27 : !
28 : MODULE HCO_ReadList_Mod
29 : !
30 : ! !USES:
31 : !
32 : USE HCO_Types_Mod
33 : USE HCO_Error_MOD
34 : USE HCO_State_MOD, ONLY : HCO_State
35 :
36 : IMPLICIT NONE
37 : PRIVATE
38 : !
39 : ! !PUBLIC MEMBER FUNCTIONS:
40 : !
41 : PUBLIC :: ReadList_Init
42 : PUBLIC :: ReadList_Read
43 : PUBLIC :: ReadList_Set
44 : PUBLIC :: ReadList_Print
45 : PUBLIC :: ReadList_Cleanup
46 : PUBLIC :: ReadList_Remove
47 : !
48 : ! !PRIVATE MEMBER FUNCTIONS:
49 : !
50 : PRIVATE :: DtCont_Add
51 : PRIVATE :: ReadList_Fill
52 : !
53 : ! !REVISION HISTORY:
54 : ! 20 Apr 2013 - C. Keller - Initial version
55 : ! See https://github.com/geoschem/hemco for complete history
56 : !EOP
57 : !-----------------------------------------------------------------------------
58 : !BOC
59 : !
60 : ! !PRIVATE TYPES:
61 : !
62 : CONTAINS
63 : !EOC
64 : !------------------------------------------------------------------------------
65 : ! Harmonized Emissions Component (HEMCO) !
66 : !------------------------------------------------------------------------------
67 : !BOP
68 : !
69 : ! !IROUTINE: ReadList_Set
70 : !
71 : ! !DESCRIPTION: Subroutine ReadList\_Set places the passed data container
72 : ! Dct in one of the reading lists, according to the data update
73 : ! frequency specified in the HEMCO configuration file. Containers are
74 : ! sorted with increasing container ID.
75 : !\\
76 : !\\
77 : ! !INTERFACE:
78 : !
79 0 : SUBROUTINE ReadList_Set( HcoState, Dct, RC )
80 : !
81 : ! !USES:
82 : !
83 : USE HCO_LOGFILE_MOD, ONLY : HCO_PrintDataCont
84 : !
85 : ! !INPUT/OUTPUT PARAMETERS:
86 : !
87 : TYPE(HCO_State), POINTER :: HcoState
88 : TYPE(DataCont), POINTER :: Dct
89 : INTEGER, INTENT(INOUT) :: RC
90 : !
91 : ! !REVISION HISTORY:
92 : ! 20 Apr 2013 - C. Keller - Initial version
93 : ! See https://github.com/geoschem/hemco for complete history
94 : !EOP
95 : !------------------------------------------------------------------------------
96 : !BOC
97 : !
98 : ! !LOCAL VARIABLES:
99 : !
100 : INTEGER :: intv
101 : LOGICAL :: verb
102 : CHARACTER(LEN=255) :: MSG, LOC
103 :
104 : ! ================================================================
105 : ! ReadList_Set begins here
106 : ! ================================================================
107 0 : LOC = 'ReadList_Set (HCO_READLIST_MOD.F90)'
108 :
109 : ! For error handling
110 0 : CALL HCO_ENTER (HcoState%Config%Err, LOC, RC )
111 0 : IF ( RC /= HCO_SUCCESS ) THEN
112 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
113 0 : RETURN
114 : ENDIF
115 :
116 : ! Verbose mode
117 0 : verb = HCO_IsVerb( HcoState%Config%Err )
118 :
119 : ! Add container to ReadList according to update freqency.
120 : ! Fields in list 'Hour' will be updated (i.e. re-read) every hour,
121 : ! fields in list 'Day' every day, etc.
122 : ! If a time range instead of a single time stamp is given,
123 : ! categorize the field according to the most rapidly changing time
124 : ! stamp.
125 : ! If no time attribute exist, put the field into the 'Once' list
126 : ! which reads the file only at the beginning. Similarly, fields
127 : ! with an update flag of 'always' will be put into the 'Always'
128 : ! list. The always update flag is set in routine HCO_ExtractTime,
129 : ! which is called from Config_ReadCont (hco_config_mod.F90).
130 0 : IF ( Dct%Dta%UpdtFlag == HCO_UFLAG_ALWAYS ) THEN
131 : intv = 1
132 0 : ELSEIF ( Dct%Dta%UpdtFlag == HCO_UFLAG_3HR ) THEN
133 : intv = 7
134 0 : ELSEIF ( Dct%Dta%ncHrs(1) /= Dct%Dta%ncHrs(2) ) THEN
135 : intv = 2
136 0 : ELSEIF ( Dct%Dta%ncDys(1) /= Dct%Dta%ncDys(2) ) THEN
137 : intv = 3
138 0 : ELSEIF ( Dct%Dta%ncMts(1) /= Dct%Dta%ncMts(2) ) THEN
139 : intv = 4
140 0 : ELSEIF ( Dct%Dta%ncYrs(1) /= Dct%Dta%ncYrs(2) ) THEN
141 : intv = 5
142 : ELSE
143 0 : intv = 6
144 : ENDIF
145 :
146 : ! NOTE: In an ESMF environment, data I/O is organized through
147 : ! ESMF/MAPL. The hemco reading call (HCOIO_DATAREAD) sets a
148 : ! pointer of the data container array to the data array provided
149 : ! by MAPL. These arrays are already interpolated / updated (over
150 : ! time) by MAPL, and a pointer needs to be established only once.
151 : ! Hence, make sure that all containers are added to the one-time
152 : ! reading list!
153 0 : IF ( HcoState%Options%isESMF .AND. Dct%Dta%ncRead ) THEN
154 0 : intv = 6
155 : ENDIF
156 :
157 : ! Special handling of data with 'EXACT' or 'RANGE' flag:
158 : ! These data sets should be evaluated whenever the data
159 : ! changes (to see if it still falls within the selected
160 : ! time window).
161 0 : IF ( Dct%Dta%CycleFlag == HCO_CFLAG_RANGE .OR. &
162 : Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) THEN
163 0 : IF ( intv == 6 ) THEN
164 0 : IF ( Dct%Dta%ncHrs(1) == -1 .OR. &
165 : Dct%Dta%ncHrs(1) /= Dct%Dta%ncHrs(2) ) THEN
166 : intv = 2
167 0 : ELSEIF ( Dct%Dta%ncDys(1) == -1 .OR. &
168 : Dct%Dta%ncDys(1) /= Dct%Dta%ncDys(2) ) THEN
169 : intv = 3
170 0 : ELSEIF ( Dct%Dta%ncMts(1) == -1 .OR. &
171 : Dct%Dta%ncMts(1) /= Dct%Dta%ncMts(2) ) THEN
172 : intv = 4
173 0 : ELSEIF ( Dct%Dta%ncYrs(1) == -1 .OR. &
174 : Dct%Dta%ncYrs(1) /= Dct%Dta%ncYrs(2) ) THEN
175 : intv = 5
176 : ! Read always
177 : ELSE
178 : intv = 1
179 : ENDIF
180 : ENDIF
181 : ENDIF
182 :
183 : ! Add to ReadList according to interval flag
184 0 : IF ( intv == 1 ) THEN
185 0 : CALL DtCont_Add( HcoState%ReadLists%Always, Dct )
186 0 : ELSEIF ( intv == 2 ) THEN
187 0 : CALL DtCont_Add( HcoState%ReadLists%Hour, Dct )
188 0 : ELSEIF ( intv == 3 ) THEN
189 0 : CALL DtCont_Add( HcoState%ReadLists%Day, Dct )
190 0 : ELSEIF ( intv == 4 ) THEN
191 0 : CALL DtCont_Add( HcoState%ReadLists%Month, Dct )
192 0 : ELSEIF ( intv == 5 ) THEN
193 0 : CALL DtCont_Add( HcoState%ReadLists%Year, Dct )
194 0 : ELSEIF (intv == 7 ) THEN
195 0 : CALL DtCont_Add( HcoState%ReadLists%Hour3, Dct )
196 : ELSE
197 0 : CALL DtCont_Add( HcoState%ReadLists%Once, Dct )
198 : ENDIF
199 :
200 : ! Verbose
201 0 : IF ( Verb ) THEN
202 0 : WRITE(MSG,*) 'New container set to ReadList:'
203 0 : CALL HCO_MSG(HcoState%Config%Err, MSG)
204 0 : CALL HCO_PrintDataCont( HcoState, Dct )
205 : ENDIF
206 :
207 : ! Leave w/ success
208 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
209 :
210 : END SUBROUTINE ReadList_Set
211 : !EOC
212 : !------------------------------------------------------------------------------
213 : ! Harmonized Emissions Component (HEMCO) !
214 : !------------------------------------------------------------------------------
215 : !BOP
216 : !
217 : ! !IROUTINE: ReadList_Read
218 : !
219 : ! !DESCRIPTION: Subroutine ReadList\_Read makes sure that all arrays in the
220 : ! reading lists are up to date, i.e. it invokes the data reading calls for
221 : ! those lists that need to be refreshed.
222 : !\\
223 : !\\
224 : ! !INTERFACE:
225 : !
226 0 : SUBROUTINE ReadList_Read( HcoState, RC, ReadAll )
227 : !
228 : ! !USES:
229 : !
230 : USE HCO_CLOCK_MOD, ONLY : HcoClock_NewYear
231 : USE HCO_CLOCK_MOD, ONLY : HcoClock_NewMonth
232 : USE HCO_CLOCK_MOD, ONLY : HcoClock_NewDay
233 : USE HCO_CLOCK_MOD, ONLY : HcoClock_NewHour
234 : USE HCO_CLOCK_MOD, ONLY : HcoClock_New3Hour
235 : USE HCO_CLOCK_MOD, ONLY : HcoClock_First
236 : !
237 : ! !INPUT PARAMETERS:
238 : !
239 : LOGICAL, OPTIONAL, INTENT(IN ) :: ReadAll ! read all fields?
240 : !
241 : ! !INPUT/OUTPUT PARAMETERS:
242 : !
243 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
244 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
245 : !
246 : ! !REVISION HISTORY:
247 : ! 20 Apr 2013 - C. Keller - Initial version
248 : ! See https://github.com/geoschem/hemco for complete history
249 : !EOP
250 : !------------------------------------------------------------------------------
251 : !BOC
252 : !
253 : ! !LOCAL VARIABLES:
254 : !
255 : LOGICAL :: verb, RdAll
256 : CHARACTER(LEN=255) :: MSG
257 : CHARACTER(LEN=255) :: LOC = 'ReadList_Read (HCO_ReadList_Mod.F90)'
258 :
259 : ! ================================================================
260 : ! ReadList_Read begins here
261 : ! ================================================================
262 :
263 : ! For error handling
264 0 : CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
265 0 : IF ( RC /= HCO_SUCCESS ) THEN
266 0 : MSG = 'Error in HCO_ENTER called from HEMCO ReadList_Read'
267 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
268 0 : RETURN
269 : ENDIF
270 :
271 : ! Verbose mode
272 0 : verb = HCO_IsVerb( HcoState%Config%Err )
273 :
274 : ! Read all fields?
275 0 : RdAll = .FALSE.
276 0 : IF ( PRESENT(ReadAll) ) RdAll = ReadAll
277 : ! Now use internal counter to determine first-time reading
278 : ! (ckeller, 02/07/2019).
279 : !IF ( HcoClock_First( HcoState%Clock, .FALSE. ) ) RdAll = .TRUE.
280 0 : IF ( HcoState%ReadLists%Counter == 0 ) RdAll = .TRUE.
281 :
282 : ! Read content from one-time list on the first call
283 0 : IF ( RdAll ) THEN
284 0 : IF ( Verb ) THEN
285 0 : WRITE(MSG,*) 'Now reading once list!'
286 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
287 : ENDIF
288 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Once, RC )
289 0 : IF ( RC /= HCO_SUCCESS ) THEN
290 0 : MSG = 'Error in ReadList_Fill (1) called from HEMCO ReadList_Read'
291 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
292 0 : RETURN
293 : ENDIF
294 : ENDIF
295 :
296 : ! Read content from year list if it's a new year
297 0 : IF ( HcoClock_NewYear( HcoState%Clock, .FALSE. ) .OR. RdAll ) THEN
298 0 : IF ( Verb ) THEN
299 0 : WRITE(MSG,*) 'Now reading year list!'
300 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
301 : ENDIF
302 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Year, RC )
303 0 : IF ( RC /= HCO_SUCCESS ) THEN
304 0 : MSG = 'Error in ReadList_Fill (2) called from HEMCO ReadList_Read'
305 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
306 0 : RETURN
307 : ENDIF
308 : ENDIF
309 :
310 : ! Read content from month list if it's a new month
311 0 : IF ( HcoClock_NewMonth( HcoState%Clock, .FALSE. ) .OR. RdAll ) THEN
312 0 : IF ( Verb ) THEN
313 0 : WRITE(MSG,*) 'Now reading month list!'
314 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
315 : ENDIF
316 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Month, RC )
317 0 : IF ( RC /= HCO_SUCCESS ) THEN
318 0 : MSG = 'Error in ReadList_Fill (3) called from HEMCO ReadList_Read'
319 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
320 0 : RETURN
321 : ENDIF
322 : ENDIF
323 :
324 : ! Read content from day list if it's a new day
325 0 : IF ( HcoClock_NewDay( HcoState%Clock, .FALSE. ) .OR. RdAll ) THEN
326 0 : IF ( Verb ) THEN
327 0 : WRITE(MSG,*) 'Now reading day list!'
328 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
329 : ENDIF
330 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Day, RC )
331 0 : IF ( RC /= HCO_SUCCESS ) THEN
332 0 : MSG = 'Error in ReadList_Fill (4) called from HEMCO ReadList_Read'
333 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
334 0 : RETURN
335 : ENDIF
336 : ENDIF
337 :
338 : ! Read content from hour list if it's a new hour
339 0 : IF ( HcoClock_NewHour( HcoState%Clock, .FALSE. ) .OR. RdAll ) THEN
340 0 : IF ( Verb ) THEN
341 0 : WRITE(MSG,*) 'Now reading hour list!'
342 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
343 : ENDIF
344 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Hour, RC )
345 0 : IF ( RC /= HCO_SUCCESS ) THEN
346 0 : MSG = 'Error in ReadList_Fill (5) called from HEMCO ReadList_Read'
347 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
348 0 : RETURN
349 : ENDIF
350 : ENDIF
351 :
352 : ! Read content from 3-hour list if it's a new hour
353 0 : IF ( HcoClock_New3Hour( HcoState%Clock, .FALSE. ) .OR. RdAll ) THEN
354 0 : IF ( Verb ) THEN
355 0 : WRITE(MSG,*) 'Now reading 3-hour list!'
356 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
357 : ENDIF
358 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Hour3, RC )
359 0 : IF ( RC /= HCO_SUCCESS ) THEN
360 0 : MSG = 'Error in ReadList_Fill (6) called from HEMCO ReadList_Read'
361 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
362 0 : RETURN
363 : ENDIF
364 : ENDIF
365 :
366 : ! Always add/update content from always-list
367 0 : IF ( Verb ) THEN
368 0 : WRITE(MSG,*) 'Now reading always list!'
369 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
370 : ENDIF
371 0 : CALL ReadList_Fill( HcoState, HcoState%ReadLists%Always, RC )
372 0 : IF ( RC /= HCO_SUCCESS ) THEN
373 0 : MSG = 'Error in called ReadList_Fill (7) from HEMCO ReadList_Read'
374 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
375 0 : RETURN
376 : ENDIF
377 :
378 : ! Update counter
379 0 : HcoState%ReadLists%Counter = HcoState%ReadLists%Counter + 1
380 :
381 : ! Leave w/ success
382 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
383 :
384 : END SUBROUTINE ReadList_Read
385 : !EOC
386 : !------------------------------------------------------------------------------
387 : ! Harmonized Emissions Component (HEMCO) !
388 : !------------------------------------------------------------------------------
389 : !BOP
390 : !
391 : ! !IROUTINE: ReadList_Fill
392 : !
393 : ! !DESCRIPTION: Subroutine ReadList\_Fill (re-)reads the data from all
394 : ! containers of the passed ReadList. In a non-ESMF environment, this
395 : ! routine calls the HEMCO generic (netCDF) reading and remapping
396 : ! routines. In an ESMF environment, the arrays are obtained through
397 : ! the ESMF/MAPL software framework. ReadLIst\_Fill provides the
398 : ! interface between HEMCO and the data reading interface. See module
399 : ! HCOI\_DATAREAD\_MOD.F90 for more details on data reading.
400 : !\\
401 : !\\
402 : ! The ReadList containers are added to EmisList immediately after data
403 : ! filling. This has the advantage that data arrays are immediately
404 : ! available through routine HCO\_GetPtr. This is required for country
405 : ! mappings that depend on the country mask input field.
406 : !\\
407 : !\\
408 : ! !INTERFACE:
409 : !
410 0 : SUBROUTINE ReadList_Fill( HcoState, ReadList, RC )
411 : !
412 : ! !USES:
413 : !
414 : USE HCOIO_Util_Mod, ONLY : HCOIO_ReadOther
415 : USE HCOIO_Read_Mod, ONLY : HCOIO_CloseAll
416 : USE HCOIO_DataRead_Mod, ONLY : HCOIO_DataRead
417 : USE HCO_FileData_Mod, ONLY : FileData_ArrIsDefined
418 : USE HCO_FileData_Mod, ONLY : FileData_ArrIsTouched
419 : USE HCO_EmisList_Mod, ONLY : EmisList_Pass
420 : USE HCO_DataCont_Mod, ONLY : DataCont_Cleanup
421 : USE HCO_TIDX_MOD, ONLY : tIDx_Assign
422 : !
423 : ! !INPUT/OUTPUT PARAMETERS:
424 : !
425 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
426 : TYPE(ListCont), POINTER :: ReadList ! Current reading list
427 : INTEGER, INTENT(INOUT) :: RC ! Success or failure?
428 : !
429 : ! !REMARKS:
430 : ! Different HCOI_DATAREAD routines may be invoked depending on the
431 : ! model environment.
432 : !
433 : ! !REVISION HISTORY:
434 : ! 20 Apr 2013 - C. Keller - Initial version
435 : ! See https://github.com/geoschem/hemco for complete history
436 : !EOP
437 : !------------------------------------------------------------------------------
438 : !BOC
439 : !
440 : ! !LOCAL VARIABLES:
441 : !
442 : TYPE(ListCont), POINTER :: Lct
443 : LOGICAL :: verb
444 : CHARACTER(LEN=255) :: MSG
445 : CHARACTER(LEN=255) :: LOC = 'ReadList_Fill (HCO_ReadList_Mod.F90)'
446 :
447 : ! ================================================================
448 : ! ReadList_Fill begins here
449 : ! ================================================================
450 :
451 : ! For error handling
452 0 : CALL HCO_ENTER (HcoState%Config%Err, LOC, RC )
453 0 : IF ( RC /= HCO_SUCCESS ) THEN
454 0 : MSG = 'Error in HCO_ENTER called from HEMCO ReadList_Fill'
455 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
456 0 : RETURN
457 : ENDIF
458 :
459 : ! Verbose mode?
460 0 : verb = HCO_IsVerb ( HcoState%Config%Err )
461 :
462 : ! Loop over all containers
463 0 : Lct => ReadList
464 0 : DO WHILE ( ASSOCIATED ( Lct ) )
465 :
466 : ! Check if data has already been touched. Multiple data
467 : ! containers can have the same file data object, and we
468 : ! only need to read it once. For each file data object,
469 : ! we assign a 'home container'. Reading will only be
470 : ! performed on this container. The DtaHome flag is
471 : ! initialized to -999. Hence, the first time we read data
472 : ! for a given container, check if this data file object
473 : ! has not yet been read, in which case we define this
474 : ! container as the home container (flag=1). Otherwise, set
475 : ! flag to 0 (not home), but make sure that the DoShare flag
476 : ! of the corresponding data file object is enabled.
477 0 : IF ( Lct%Dct%DtaHome < 0 ) THEN
478 0 : IF ( FileData_ArrIsTouched(Lct%Dct%Dta) ) THEN
479 0 : Lct%Dct%DtaHome = 0
480 0 : Lct%Dct%Dta%DoShare = .TRUE.
481 : ELSE
482 0 : Lct%Dct%DtaHome = 1
483 : ENDIF
484 : ENDIF
485 :
486 : ! Read if this is the home container
487 0 : IF ( Lct%Dct%DtaHome == 1 ) THEN
488 :
489 : ! Read from other source if it's not a netCDF file
490 0 : IF ( .NOT. Lct%Dct%Dta%NcRead ) THEN
491 0 : CALL HCOIO_ReadOther( HcoState, Lct, RC )
492 0 : IF ( RC /= HCO_SUCCESS ) THEN
493 0 : MSG = 'Error in HCOIO_ReadOther called from HEMCO ReadList_Fill: ' // TRIM(Lct%Dct%cname)
494 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
495 0 : RETURN
496 : ENDIF
497 :
498 : ! Read from netCDF file otherwise
499 : ELSE
500 :
501 : ! Read data
502 0 : CALL HCOIO_DATAREAD( HcoState, Lct, RC )
503 0 : IF ( RC /= HCO_SUCCESS ) THEN
504 0 : MSG = 'Error in HCOIO_DATAREAD called from HEMCO ReadList_Fill: ' // TRIM(Lct%Dct%cname)
505 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
506 0 : RETURN
507 : ENDIF
508 : ENDIF
509 :
510 : ! We now have touched this data container
511 0 : Lct%Dct%Dta%IsTouched = .TRUE.
512 :
513 : ENDIF
514 :
515 : ! Pass container to EmisList (only if array is defined)
516 0 : IF ( FileData_ArrIsDefined(Lct%Dct%Dta) ) THEN
517 :
518 : ! Set time index pointer tIDx of this data container.
519 : ! tIDx will be set according to the number of time slices
520 : ! (and the tim einterval between them) hold by this data
521 : ! container. For hourly data (24 time slices), for example,
522 : ! tIDx will point to the corresponding 'HOURLY' or
523 : ! 'HOURLY_GRID' time index collection type defined in
524 : ! hco_tidx_mod.
525 0 : CALL tIDx_Assign ( HcoState, Lct%Dct, RC )
526 0 : IF ( RC /= HCO_SUCCESS ) THEN
527 0 : MSG = 'Error in tIDx_Assign called from HEMCO ReadList_Fill: ' // TRIM(Lct%Dct%cname)
528 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
529 0 : RETURN
530 : ENDIF
531 :
532 : ! Container is now read to be passed to emissions list.
533 0 : CALL EmisList_Pass( HcoState, Lct, RC )
534 0 : IF ( RC /= HCO_SUCCESS ) THEN
535 0 : MSG = 'Error in EmisList_Pass called from HEMCO ReadList_Fill: ' // TRIM(Lct%Dct%cname)
536 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
537 0 : RETURN
538 : ENDIF
539 :
540 : ENDIF
541 :
542 : ! Advance to next container
543 0 : Lct => Lct%NextCont
544 : ENDDO
545 :
546 : ! Make sure that all netCDF files are closed
547 0 : CALL HCOIO_CloseAll ( HcoState, RC )
548 0 : IF ( RC /= HCO_SUCCESS ) THEN
549 0 : MSG = 'Error in HCOIO_CloseAll called from HEMCO ReadList_Fill: ' // TRIM(Lct%Dct%cname)
550 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
551 0 : RETURN
552 : ENDIF
553 :
554 : ! Second loop to clean up all data that is not used in EmisList.
555 : ! This cannot be done within EmisList_Pass since it is possible
556 : ! that some container data is used by multiple containers.
557 0 : Lct => ReadList
558 0 : DO WHILE ( ASSOCIATED(Lct) )
559 :
560 : ! Remove array if not used in the emissions list
561 0 : IF ( .NOT. Lct%Dct%Dta%IsInList ) THEN
562 0 : CALL DataCont_Cleanup( Lct%Dct, ArrOnly=.TRUE. )
563 :
564 : ! Verbose mode
565 0 : IF ( verb ) THEN
566 0 : MSG = 'Remove data array of ' // TRIM(Lct%Dct%cName)
567 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
568 : ENDIF
569 : ENDIF
570 :
571 : ! Advance in list
572 0 : Lct => Lct%NextCont
573 : ENDDO
574 :
575 : ! Cleanup
576 0 : Lct => NULL()
577 :
578 : ! Leave with success
579 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
580 :
581 : END SUBROUTINE ReadList_Fill
582 : !EOC
583 : !------------------------------------------------------------------------------
584 : ! Harmonized Emissions Component (HEMCO) !
585 : !------------------------------------------------------------------------------
586 : !BOP
587 : !
588 : ! !IROUTINE: DtCont_Add
589 : !
590 : ! !DESCRIPTION: Subroutine DtCont\_Add adds a new container to the
591 : ! specified reading list.
592 : !\\
593 : !\\
594 : ! !INTERFACE:
595 : !
596 0 : SUBROUTINE DtCont_Add( ReadList, Dct )
597 : !
598 : ! !INPUT PARAMETERS:
599 : !
600 : TYPE(ListCont), POINTER :: ReadList
601 : TYPE(DataCont), POINTER :: Dct
602 : !
603 : ! !REVISION HISTORY:
604 : ! 20 Apr 2013 - C. Keller - Initial version
605 : ! See https://github.com/geoschem/hemco for complete history
606 : !EOP
607 : !------------------------------------------------------------------------------
608 : !BOC
609 : !
610 : ! !LOCAL VARIABLES:
611 : !
612 : TYPE(ListCont), POINTER :: Lct
613 : TYPE(ListCont), POINTER :: TmpLct
614 : INTEGER :: cID
615 :
616 : ! ================================================================
617 : ! DtCont_Add begins here
618 : ! ================================================================
619 :
620 : ! Init
621 0 : Lct => NULL()
622 0 : TmpLct => NULL()
623 :
624 : ! Create new container (to be added to ReadList)
625 0 : ALLOCATE ( Lct )
626 0 : Lct%NextCont => NULL()
627 :
628 : ! Make container point to passed data container
629 0 : Lct%Dct => Dct
630 :
631 : ! If ReadList is not defined yet, set new container to head of
632 : ! list.
633 0 : IF ( .NOT. ASSOCIATED ( ReadList ) ) THEN
634 0 : ReadList => Lct
635 :
636 : ! If list is already defined, place current container according
637 : ! to its container ID. Containers are sorted with increasing
638 : ! cID.
639 : ELSE
640 :
641 : ! cID of current container
642 0 : cID = Lct%Dct%cID
643 :
644 : ! TmpLct is the temporary pointer to the ReadList containers
645 0 : TmpLct => ReadList
646 :
647 : ! Check if cID of first container is higher than current ID.
648 : ! In this case, we can place current container at beginning
649 : ! of list
650 0 : IF ( TmpLct%Dct%cID > cID ) THEN
651 0 : Lct%NextCont => TmpLct
652 0 : ReadList => Lct
653 : ELSE
654 :
655 : ! Loop over containers in list until we encounter first
656 : ! container where the upcoming container has higher cID
657 : ! than currCont.
658 0 : DO WHILE ( ASSOCIATED ( TmpLct%NextCont ) )
659 0 : IF ( TmpLct%NextCont%Dct%cID > cID ) EXIT
660 0 : TmpLct => TmpLct%NextCont
661 : ENDDO
662 :
663 : ! Now place current container AFTER TmpLct
664 0 : Lct%NextCont => TmpLct%NextCont
665 0 : TmpLct%NextCont => Lct
666 : ENDIF
667 : ENDIF
668 :
669 : ! Cleanup
670 0 : TmpLct => NULL()
671 0 : Lct => NULL()
672 :
673 0 : END SUBROUTINE DtCont_Add
674 : !EOC
675 : !------------------------------------------------------------------------------
676 : ! Harmonized Emissions Component (HEMCO) !
677 : !------------------------------------------------------------------------------
678 : !BOP
679 : !
680 : ! !IROUTINE: ReadList_Init
681 : !
682 : ! !DESCRIPTION: Subroutine ReadList\_Init initializes the ReadList.
683 : !\\
684 : !\\
685 : ! !INTERFACE:
686 : !
687 0 : SUBROUTINE ReadList_Init( ReadLists, RC )
688 : !
689 : ! !INPUT/OUTPUT PARAMETERS:
690 : !
691 : TYPE(RdList), POINTER :: ReadLists
692 : INTEGER, INTENT(INOUT) :: RC
693 : !
694 : ! !REVISION HISTORY:
695 : ! 20 Apr 2013 - C. Keller - Initial version
696 : ! See https://github.com/geoschem/hemco for complete history
697 : !EOP
698 : !------------------------------------------------------------------------------
699 : !BOC
700 :
701 : CHARACTER(LEN=255) :: errMsg, thisLoc
702 :
703 : ! ================================================================
704 : ! ReadList_Init begins here
705 : ! ================================================================
706 :
707 : ! Initialize
708 0 : RC = HCO_SUCCESS
709 :
710 : ! Allocate the ReadLists object (which is really HcoState%ReadLists).
711 0 : ALLOCATE( ReadLists, STAT=RC )
712 0 : IF ( RC /= HCO_SUCCESS ) THEN
713 0 : errMsg = 'Could not allocate ReadLists (=> HcoState%ReadLists)!'
714 0 : CALL HCO_Error( errMsg, RC, thisLoc )
715 0 : RETURN
716 : ENDIF
717 :
718 : ! Nullify pointer fields
719 0 : ReadLists%Once => NULL()
720 0 : ReadLists%Year => NULL()
721 0 : ReadLists%Month => NULL()
722 0 : ReadLists%Day => NULL()
723 0 : ReadLists%Hour => NULL()
724 0 : ReadLists%Hour3 => NULL()
725 0 : ReadLists%Always => NULL()
726 :
727 : ! No file in buffer yet
728 0 : ReadLists%FileInArchive = ''
729 0 : ReadLists%FileLun = -1
730 :
731 : ! Initialize counter
732 0 : ReadLists%Counter = 0
733 :
734 : END SUBROUTINE ReadList_Init
735 : !EOC
736 : !------------------------------------------------------------------------------
737 : ! Harmonized Emissions Component (HEMCO) !
738 : !------------------------------------------------------------------------------
739 : !BOP
740 : !
741 : ! !IROUTINE: ReadList_Print
742 : !
743 : ! !DESCRIPTION: Subroutine ReadList\_Print displays the content of
744 : ! ReadList.
745 : !\\
746 : !\\
747 : ! !INTERFACE:
748 : !
749 0 : SUBROUTINE ReadList_Print( HcoState, ReadLists )
750 : !
751 : ! !USES:
752 : !
753 : USE HCO_LOGFILE_MOD, ONLY : HCO_PrintList
754 : !
755 : ! !INPUT ARGUMENTS
756 : !
757 : TYPE(HCO_State), POINTER :: HcoState
758 : TYPE(RdList), POINTER :: ReadLists
759 : !
760 : ! !REVISION HISTORY:
761 : ! 20 Apr 2013 - C. Keller - Initial version
762 : ! See https://github.com/geoschem/hemco for complete history
763 : !EOP
764 : !------------------------------------------------------------------------------
765 : !BOC
766 :
767 : CHARACTER(LEN=255) :: MSG
768 :
769 : ! ================================================================
770 : ! ReadList_Print begins here
771 : ! ================================================================
772 :
773 : ! Nothing to do if HEMCO verbose level is below passed verbose number
774 0 : IF ( .NOT. HCO_IsVerb(HcoState%Config%Err ) ) RETURN
775 :
776 : ! Print content of all lists
777 0 : IF ( ASSOCIATED(ReadLists) .and. HcoState%amIRoot ) THEN
778 :
779 0 : WRITE(MSG,*) 'Contents of one-time list:'
780 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
781 0 : CALL HCO_PrintList ( HcoState, ReadLists%Once )
782 :
783 0 : WRITE(MSG,*) 'Contents of year list:'
784 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
785 0 : CALL HCO_PrintList ( HcoState, ReadLists%Year )
786 :
787 0 : WRITE(MSG,*) 'Contents of month list:'
788 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
789 0 : CALL HCO_PrintList ( HcoState, ReadLists%Month )
790 :
791 0 : WRITE(MSG,*) 'Contents of day list:'
792 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
793 0 : CALL HCO_PrintList ( HcoState, ReadLists%Day )
794 :
795 0 : WRITE(MSG,*) 'Contents of 3-hour list:'
796 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=' )
797 0 : CALL HCO_PrintList ( HcoState, ReadLists%Hour3 )
798 :
799 0 : WRITE(MSG,*) 'Contents of hour list:'
800 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
801 0 : CALL HCO_PrintList ( HcoState, ReadLists%Hour )
802 :
803 0 : WRITE(MSG,*) 'Contents of always-to-read list:'
804 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
805 0 : CALL HCO_PrintList ( HcoState, ReadLists%Always )
806 :
807 : ELSE
808 0 : WRITE(MSG,*) 'ReadList not defined yet!!'
809 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=')
810 : ENDIF
811 :
812 : END SUBROUTINE ReadList_Print
813 : !EOC
814 : !------------------------------------------------------------------------------
815 : ! Harmonized Emissions Component (HEMCO) !
816 : !------------------------------------------------------------------------------
817 : !BOP
818 : !
819 : ! !IROUTINE: ReadList_Remove
820 : !
821 : ! !DESCRIPTION: Subroutine ReadList\_Remove removes the container given by
822 : ! name from the ReadList. If no container with the given name exist, nothing
823 : ! is done. This routine returns an error if the container already holds data.
824 : !\\
825 : !\\
826 : ! !INTERFACE:
827 : !
828 0 : SUBROUTINE ReadList_Remove( HcoState, cName, RC )
829 : !
830 : ! !USES:
831 : !
832 : !
833 : ! !INPUT PARAMETERS:
834 : !
835 : TYPE(HCO_State), POINTER :: HcoState
836 : CHARACTER(LEN=*), INTENT(IN ) :: cName
837 : !
838 : ! !INPUT/OUTPUT PARAMETERS:
839 : !
840 : INTEGER, INTENT(INOUT) :: RC
841 : !
842 : ! !REVISION HISTORY:
843 : ! 13 Jan 2015 - C. Keller - Initial version
844 : ! See https://github.com/geoschem/hemco for complete history
845 : !EOP
846 : !------------------------------------------------------------------------------
847 : !BOC
848 : !
849 : ! !LOCAL VARIABLES:
850 : !
851 : INTEGER :: I
852 : TYPE(ListCont), POINTER :: This
853 : TYPE(ListCont), POINTER :: Prev
854 : TYPE(ListCont), POINTER :: Next
855 : LOGICAL :: FOUND
856 : CHARACTER(LEN=255) :: MSG
857 : CHARACTER(LEN=255) :: LOC = 'ReadList_Remove (HCO_ReadList_Mod.F90)'
858 :
859 : ! ================================================================
860 : ! ReadList_Remove begins here
861 : ! ================================================================
862 :
863 : ! Assume success until otherwise
864 0 : RC = HCO_SUCCESS
865 0 : IF ( .NOT. ASSOCIATED(HcoState%ReadLists) ) RETURN
866 :
867 : ! Init
868 : This => NULL()
869 0 : Prev => NULL()
870 : Next => NULL()
871 :
872 : ! Search for the given container
873 0 : DO I = 1,7
874 :
875 : ! Select list to be used
876 0 : IF ( I == 1 ) This => HcoState%ReadLists%Once
877 0 : IF ( I == 2 ) This => HcoState%ReadLists%Year
878 0 : IF ( I == 3 ) This => HcoState%ReadLists%Month
879 0 : IF ( I == 4 ) This => HcoState%ReadLists%Day
880 0 : IF ( I == 5 ) This => HcoState%ReadLists%Hour
881 0 : IF ( I == 6 ) This => HcoState%ReadLists%Always
882 0 : IF ( I == 7 ) This => HcoState%ReadLists%Hour3
883 :
884 : ! Initialize working variables
885 0 : FOUND = .FALSE.
886 0 : Prev => This
887 :
888 : ! Walk through list, looking for this container
889 0 : DO WHILE ( ASSOCIATED(This) )
890 :
891 : ! Next container in list
892 0 : Next => This%NextCont
893 :
894 : ! Is that the container of interest?
895 0 : IF ( TRIM(This%Dct%cName) == TRIM(cName) ) THEN
896 0 : FOUND = .TRUE.
897 0 : EXIT
898 : ENDIF
899 :
900 : ! Advance
901 0 : Prev => This
902 0 : This => Next
903 : ENDDO !This
904 :
905 : ! Advance if not found
906 0 : IF ( .NOT. FOUND ) CYCLE
907 :
908 : ! Check first if data has already been read. In this case, the data home
909 : ! flag is updated.
910 0 : IF ( This%Dct%DtaHome >= 0 ) THEN
911 : MSG = 'Cannot remove from ReadList. Data has already been read: ' // &
912 0 : TRIM(This%Dct%cName)
913 0 : CALL HCO_ERROR( MSG, RC, THISLOC = LOC )
914 : ENDIF
915 :
916 : ! Connect previous container to next container in list:
917 : ! - Special case that this is the first container in the list
918 0 : IF ( Prev%Dct%cID == This%Dct%cID ) THEN
919 0 : IF ( I == 1 ) HcoState%ReadLists%Once => Next
920 0 : IF ( I == 2 ) HcoState%ReadLists%Year => Next
921 0 : IF ( I == 3 ) HcoState%ReadLists%Month => Next
922 0 : IF ( I == 4 ) HcoState%ReadLists%Day => Next
923 0 : IF ( I == 5 ) HcoState%ReadLists%Hour => Next
924 0 : IF ( I == 6 ) HcoState%ReadLists%Always => Next
925 0 : IF ( I == 7 ) HcoState%ReadLists%Hour3 => Next
926 :
927 : ! - Otherwise, just pop out this container from list
928 : ELSE
929 0 : Prev%NextCont => Next
930 : ENDIF
931 :
932 : ! Remove pointer to data container, detach this container from list
933 0 : This%Dct => NULL()
934 0 : This%NextCont => NULL()
935 :
936 : ! Deallocate this container
937 0 : DEALLOCATE(This)
938 :
939 : ! If we make it to here, we have successfully removed the container and
940 : ! don't need to cycle thorugh the loop any more
941 0 : EXIT
942 :
943 : ENDDO !
944 :
945 : ! Free pointer
946 0 : This => NULL()
947 0 : Prev => NULL()
948 0 : Next => NULL()
949 :
950 : ! Return w/ success
951 0 : RC = HCO_SUCCESS
952 :
953 : END SUBROUTINE ReadList_Remove
954 : !EOC
955 : !------------------------------------------------------------------------------
956 : ! Harmonized Emissions Component (HEMCO) !
957 : !------------------------------------------------------------------------------
958 : !BOP
959 : !
960 : ! !IROUTINE: ReadList_Cleanup
961 : !
962 : ! !DESCRIPTION: Subroutine ReadList\_Cleanup removes all content of ReadList.
963 : ! If RemoveDct is set to True, the content of the data containers will be
964 : ! also removed, otherwise the corresponding pointer is just nullified.
965 : !\\
966 : !\\
967 : ! !INTERFACE:
968 : !
969 0 : SUBROUTINE ReadList_Cleanup( ReadLists, RemoveDct )
970 : !
971 : ! !USES:
972 : !
973 : USE HCO_DataCont_Mod, ONLY : ListCont_Cleanup
974 : !
975 : ! !INPUT PARAMETERS:
976 : !
977 :
978 : LOGICAL, INTENT(IN ) :: RemoveDct
979 : !
980 : ! !INPUT/OUTPUT PARAMETERS:
981 : !
982 : TYPE(RdList), POINTER :: ReadLists
983 : !
984 : ! !REVISION HISTORY:
985 : ! 20 Apr 2013 - C. Keller - Initial version
986 : ! See https://github.com/geoschem/hemco for complete history
987 : !EOP
988 : !------------------------------------------------------------------------------
989 : !BOC
990 :
991 : ! ================================================================
992 : ! ReadList_Cleanup begins here
993 : ! ================================================================
994 :
995 0 : IF ( ASSOCIATED(ReadLists) ) THEN
996 :
997 : ! Remove all sublists in ReadList
998 0 : CALL ListCont_Cleanup ( ReadLists%Once, RemoveDct )
999 0 : CALL ListCont_Cleanup ( ReadLists%Year, RemoveDct )
1000 0 : CALL ListCont_Cleanup ( ReadLists%Month, RemoveDct )
1001 0 : CALL ListCont_Cleanup ( ReadLists%Day, RemoveDct )
1002 0 : CALL ListCont_Cleanup ( ReadLists%Hour, RemoveDct )
1003 0 : CALL ListCont_Cleanup ( ReadLists%Hour3, RemoveDct )
1004 0 : CALL ListCont_Cleanup ( ReadLists%Always, RemoveDct )
1005 :
1006 : ! Remove ReadList
1007 0 : DEALLOCATE ( ReadLists )
1008 : ENDIF
1009 0 : ReadLists => NULL()
1010 :
1011 0 : END SUBROUTINE ReadList_Cleanup
1012 : !EOC
1013 : END MODULE HCO_ReadList_Mod
|