Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcoio_util_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCOIO\_Util\_Mod contains utility functions
9 : ! for use in data processing including file reading, unit conversions,
10 : ! and regridding.
11 : !\\
12 : !\\
13 : ! !INTERFACE:
14 : !
15 : MODULE HCOIO_Util_Mod
16 : !
17 : ! !USES:
18 : !
19 : USE HCO_Types_Mod
20 : USE HCO_Error_Mod
21 : USE HCO_CharTools_Mod
22 : USE HCO_State_Mod, ONLY : Hco_State
23 :
24 : IMPLICIT NONE
25 : PRIVATE
26 : !
27 : ! !PUBLIC MEMBER FUNCTIONS:
28 : !
29 : #if !defined(ESMF_)
30 : PUBLIC :: GET_TIMEIDX
31 : PUBLIC :: Check_AvailYMDhm
32 : PUBLIC :: prefYMDhm_Adjust
33 : PUBLIC :: Set_tIdx2
34 : PUBLIC :: IsClosest
35 : PUBLIC :: GetIndex2Interp
36 : PUBLIC :: GetWeights
37 : PUBLIC :: YMDhm2hrs
38 : PUBLIC :: Normalize_Area
39 : PUBLIC :: SrcFile_Parse
40 : PUBLIC :: SigmaMidToEdges
41 : PUBLIC :: CheckMissVal
42 : PUBLIC :: GetArbDimIndex
43 : #endif
44 : PUBLIC :: HCOIO_ReadOther
45 : PUBLIC :: HCOIO_ReadCountryValues
46 : PUBLIC :: HCOIO_ReadFromConfig
47 : PUBLIC :: GetDataVals
48 : PUBLIC :: GetSliceIdx
49 : PUBLIC :: FillMaskBox
50 : PUBLIC :: ReadMath
51 : !
52 : ! !REVISION HISTORY:
53 : ! 12 Jun 2020 - E. Lundgren - Initial version, created from subset of
54 : ! hcoio_util_mod.F90
55 : ! See https://github.com/geoschem/hemco for complete history
56 : !EOP
57 : !------------------------------------------------------------------------------
58 : !BOC
59 : !
60 : ! !DEFINED PARAMETERS
61 : !
62 : ! Parameter used for difference testing of floating points
63 : REAL(dp), PRIVATE, PARAMETER :: EPSILON = 1.0e-5_dp
64 :
65 : CONTAINS
66 : !EOC
67 : #if !defined( ESMF_ )
68 : !------------------------------------------------------------------------------
69 : ! Harmonized Emissions Component (HEMCO) !
70 : !------------------------------------------------------------------------------
71 : !BOP
72 : !
73 : ! !IROUTINE: Get_TimeIdx
74 : !
75 : ! !DESCRIPTION: Returns the lower and upper time slice index (tidx1
76 : ! and tidx2, respectively) to be read. These values are determined
77 : ! based upon the time slice information extracted from the netCDF file,
78 : ! the time stamp settings set in the config. file, and the current
79 : ! simulation date.
80 : !\\
81 : !\\
82 : ! Return arguments wgt1 and wgt2 denote the weights to be given to
83 : ! the two time slices. This is only of relevance for data that shall
84 : ! be interpolated between two (not necessarily consecutive) time slices.
85 : ! In all other cases, the returned weights are negative and will be
86 : ! ignored.
87 : !\\
88 : !\\
89 : ! Also returns the time slice year and month, as these values may be
90 : ! used for unit conversion.
91 : !\\
92 : !\\
93 : ! !INTERFACE:
94 : !
95 0 : SUBROUTINE GET_TIMEIDX( HcoState, Lct, &
96 : ncLun, tidx1, tidx2, &
97 : wgt1, wgt2, oYMDhm, &
98 : YMDhm, YMDhm1, RC, &
99 : Year )
100 : !
101 : ! !USES:
102 : !
103 : USE HCO_Ncdf_Mod, ONLY : NC_Read_Time_YYYYMMDDhhmm
104 : USE HCO_tIdx_Mod, ONLY : HCO_GetPrefTimeAttr
105 : !
106 : ! !INPUT PARAMETERS:
107 : !
108 : TYPE(HCO_State), POINTER :: HcoState ! HcoState object
109 : TYPE(ListCont), POINTER :: Lct ! List container
110 : INTEGER, INTENT(IN ) :: ncLun ! open ncLun
111 : INTEGER, INTENT(IN ), OPTIONAL :: Year ! year to be used
112 : !
113 : ! !OUTPUT PARAMETERS:
114 : !
115 : INTEGER, INTENT( OUT) :: tidx1 ! lower time idx
116 : INTEGER, INTENT( OUT) :: tidx2 ! upper time idx
117 : REAL(sp), INTENT( OUT) :: wgt1 ! weight to tidx1
118 : REAL(sp), INTENT( OUT) :: wgt2 ! weight to tidx2
119 : REAL(dp), INTENT( OUT) :: oYMDhm ! preferred time slice
120 : REAL(dp), INTENT( OUT) :: YMDhm ! selected time slice
121 : REAL(dp), INTENT( OUT) :: YMDhm1 ! 1st time slice in file
122 : !
123 : ! !INPUT/OUTPUT PARAMETERS:
124 : !
125 : INTEGER, INTENT(INOUT) :: RC
126 : !
127 : ! !REVISION HISTORY:
128 : ! 13 Mar 2013 - C. Keller - Initial version
129 : ! See https://github.com/geoschem/hemco for complete history
130 : !EOP
131 : !------------------------------------------------------------------------------
132 : !BOC
133 : !
134 : ! !LOcAL VARIABLES:
135 : !
136 : CHARACTER(LEN=255) :: MSG, LOC
137 : CHARACTER(LEN=1023) :: MSG_LONG
138 : INTEGER :: tidx1a
139 : INTEGER :: nTime, T, CNT, NCRC
140 : INTEGER :: prefYr, prefMt, prefDy, prefHr, prefMn
141 : INTEGER :: refYear
142 : REAL(dp) :: origYMDhm, prefYMDhm
143 0 : REAL(dp), POINTER :: availYMDhm(:)
144 : LOGICAL :: ExitSearch
145 : LOGICAL :: verb
146 :
147 : !=================================================================
148 : ! GET_TIMEIDX begins here
149 : !=================================================================
150 :
151 : ! Initialize
152 0 : LOC = 'GET_TIMEIDX (HCOIO_UTIL_MOD.F90)'
153 :
154 : ! Officially enter Get_TimeIdx
155 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
156 0 : IF ( RC /= HCO_SUCCESS ) THEN
157 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
158 0 : RETURN
159 : ENDIF
160 0 : verb = HCO_IsVerb(HcoState%Config%Err,3)
161 :
162 : ! Initialize local variables for safety's sake
163 0 : nTime = 0
164 0 : cnt = 0
165 0 : prefYr = 0
166 0 : prefMt = 0
167 0 : prefDy = 0
168 0 : prefHr = 0
169 0 : prefMn = 0
170 0 : refYear = 0
171 0 : origYMDhm = 0
172 0 : prefYMDhm = 0
173 0 : tidx1 = 0
174 0 : tidx2 = 0
175 0 : tidx1a = 0
176 0 : wgt1 = -1.0_sp
177 0 : wgt2 = -1.0_sp
178 0 : oYMDhm = 0.0_dp
179 0 : YMDhm = 0.0_dp
180 0 : YMDhm1 = 0.0_dp
181 0 : ExitSearch = .FALSE.
182 0 : availYMDhm => NULL()
183 :
184 : ! ----------------------------------------------------------------
185 : ! Extract netCDF time slices (YYYYMMDDhhmm)
186 : ! ----------------------------------------------------------------
187 : CALL NC_READ_TIME_YYYYMMDDhhmm( ncLun, nTime, availYMDhm, &
188 0 : refYear=refYear, RC=NCRC )
189 0 : IF ( NCRC /= 0 ) THEN
190 0 : CALL HCO_ERROR( 'NC_READ_TIME_YYYYMMDDhhmm', RC )
191 0 : RETURN
192 : ENDIF
193 :
194 : ! Return warning if netCDF reference year prior to 1901: it seems
195 : ! like there are some problems with that and the time slices can be
196 : ! off by one day!
197 0 : IF ( (refYear <= 1900) .AND. (nTime > 0) ) THEN
198 : MSG = 'ncdf reference year is prior to 1901 - ' // &
199 0 : 'time stamps may be wrong!'
200 0 : CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1 )
201 : ENDIF
202 :
203 : ! verbose mode
204 0 : IF ( verb ) THEN
205 0 : write(MSG,*) 'Number of time slices found: ', nTime
206 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
207 0 : IF ( nTime > 0 ) THEN
208 0 : write(MSG,*) 'Time slice range : ', &
209 0 : availYMDhm(1), availYMDhm(nTime)
210 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
211 : ENDIF
212 : ENDIF
213 :
214 : ! ----------------------------------------------------------------
215 : ! Select time slices to read
216 : ! ----------------------------------------------------------------
217 :
218 : ! ----------------------------------------------------------------
219 : ! Get preferred time stamp to read based upon the specs set in the
220 : ! config. file.
221 : ! This can return value -1 for prefHr, indicating that all
222 : ! corresponding time slices shall be read.
223 : ! This call will return -1 for all date attributes if the
224 : ! simulation date is outside of the data range given in the
225 : ! configuration file.
226 : ! ----------------------------------------------------------------
227 : CALL HCO_GetPrefTimeAttr ( HcoState, Lct, &
228 0 : prefYr, prefMt, prefDy, prefHr, prefMn, RC )
229 0 : IF ( RC /= HCO_SUCCESS ) THEN
230 : MSG = &
231 0 : 'Error encountered in HCO_GetPrefTimeAttr for ' // TRIM(Lct%Dct%cName)
232 0 : CALL HCO_ERROR( MSG, RC )
233 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
234 0 : DEALLOCATE(availYMDhm)
235 : availYMDhm => NULL()
236 : ENDIF
237 0 : RETURN
238 : ENDIF
239 :
240 : ! Eventually force preferred year to passed value
241 0 : IF ( PRESENT(Year) ) prefYr = Year
242 :
243 : ! Check if we are outside of provided range
244 0 : IF ( prefYr < 0 .OR. prefMt < 0 .OR. prefDy < 0 ) THEN
245 :
246 : ! This should only happen for 'range' data
247 0 : IF ( Lct%Dct%Dta%CycleFlag /= HCO_CFLAG_RANGE ) THEN
248 0 : MSG = 'Cannot get preferred datetime for ' // TRIM(Lct%Dct%cName)
249 0 : CALL HCO_ERROR( MSG, RC )
250 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
251 0 : DEALLOCATE(availYMDhm)
252 : availYMDhm => NULL()
253 : ENDIF
254 0 : RETURN
255 : ENDIF
256 :
257 : ! If this part of the code gets executed, the data associated
258 : ! with this container shall not be used at the current date.
259 : ! To do so, set the time indeces to -1 and leave right here.
260 0 : tidx1 = -1
261 0 : tidx2 = -1
262 :
263 : ! Leave w/ success
264 0 : CALL HCO_LEAVE( HcoState%Config%Err, RC )
265 0 : RETURN
266 : ENDIF
267 :
268 : ! origYMDhm is the preferred datetime. Store into shadow variable
269 : ! prefYMDhm. prefYMDhm may be adjusted if origYMDhm is outside of the
270 : ! netCDF datetime range.
271 : ! Now put origYMDhm, prefYMDhm in YYYYMMDDhhmm format (bmy, 4/10/17)
272 : origYMDhm = ( DBLE( prefYr ) * 1.0e8_dp ) + &
273 : ( DBLE( prefMt ) * 1.0e6_dp ) + &
274 : ( DBLE( prefDy ) * 1.0e4_dp ) + &
275 : ( DBLE( MAX( prefHr, 0 ) ) * 1.0e2_dp ) + &
276 0 : ( DBLE( MAX( prefMn, 0 ) ) )
277 0 : prefYMDhm = origYMDhm
278 :
279 : ! verbose mode
280 0 : IF ( verb ) THEN
281 0 : write(MSG,'(A30,f14.0)') 'preferred datetime: ', prefYMDhm
282 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
283 : ENDIF
284 :
285 : ! ================================================================
286 : ! Case 1: Only one time slice available.
287 : ! ================================================================
288 0 : IF ( nTime == 1 ) THEN
289 0 : tidx1 = 1
290 0 : tidx2 = 1
291 :
292 : ! ================================================================
293 : ! Case 2: More than one time slice available. Determine lower
294 : ! and upper time slice index from file & HEMCO settings.
295 : ! ================================================================
296 0 : ELSEIF ( nTime > 1 ) THEN
297 :
298 : ! Init
299 0 : tidx1 = -1
300 0 : tidx2 = -1
301 :
302 : ! -------------------------------------------------------------
303 : ! Check if preferred datetime prefYMDhm is within the range
304 : ! available time slices, e.g. it falls within the interval
305 : ! of availYMDhm. In this case, set tidx1 to the index of the
306 : ! closest time slice that is not in the future.
307 : ! -------------------------------------------------------------
308 0 : CALL Check_AvailYMDhm ( Lct, nTime, availYMDhm, prefYMDhm, tidx1a )
309 :
310 : ! -------------------------------------------------------------
311 : ! Check if we need to continue search. Even if the call above
312 : ! returned a time slice, it may be possible to continue looking
313 : ! for a better suited time stamp. This is only the case if
314 : ! there are discontinuities in the time stamps, e.g. if a file
315 : ! contains monthly data for 2005 and 2020. In that case, the
316 : ! call above would return the index for Dec 2005 for any
317 : ! simulation date between 2005 and 2010 (e.g. July 2010),
318 : ! whereas it makes more sense to use July 2005 (and eventually
319 : ! interpolate between the July 2005 and July 2020 data).
320 : ! The IsClosest command checks if there are any netCDF time
321 : ! stamps (prior to the selected one) that are closer to each
322 : ! other than the difference between the preferred time stamp
323 : ! prefYMDhm and the currently selected time stamp
324 : ! availYMDhm(tidx1a). In that case, it continues the search by
325 : ! updating prefYMDhm so that it falls within the range of the
326 : ! 'high-frequency' interval.
327 : ! -------------------------------------------------------------
328 0 : ExitSearch = .FALSE.
329 0 : IF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) THEN
330 : ExitSearch = .TRUE.
331 0 : ELSE IF ( tidx1a > 0 ) THEN
332 0 : ExitSearch = IsClosest( prefYMDhm, availYMDhm, nTime, tidx1a )
333 : ENDIF
334 :
335 : ! When using the interpolation flag, use the first or last timestep
336 : ! when outside of the available date range
337 0 : IF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_INTER .and. tidx1a < 0 ) THEN
338 0 : IF ( prefYMDhm < availYMDhm(1) ) THEN
339 0 : tidx1a = 1
340 0 : ELSE IF ( prefYMDhm > availYMDhm(nTime) ) THEN
341 0 : tidx1a = nTime
342 : ENDIF
343 : ENDIF
344 :
345 : ! Do not continue search if data is to be interpolated and is
346 : ! not discontinuous (mps, 10/23/19)
347 0 : IF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_INTER .and. &
348 : .not. Lct%Dct%Dta%Discontinuous ) THEN
349 : ExitSearch = .TRUE.
350 : ENDIF
351 :
352 : ! Write to tidx1 if this is the best match.
353 0 : IF ( ExitSearch ) THEN
354 0 : tidx1 = tidx1a
355 :
356 : ! -------------------------------------------------------------
357 : ! If search shall be continued, adjust preferred year, then
358 : ! month, then day to the closest available year (month, day)
359 : ! in the time slices, and check if this is a better match.
360 : ! -------------------------------------------------------------
361 : ELSE
362 :
363 : ! Adjust year, month, and day (in this order).
364 0 : CNT = 0
365 : DO
366 0 : CNT = CNT + 1
367 0 : IF ( ExitSearch .OR. CNT > 3 ) EXIT
368 :
369 : ! Adjust prefYMDhm at the given level (1=Y, 2=M, 3=D)
370 0 : CALL prefYMDhm_Adjust ( nTime, availYMDhm, prefYMDhm, CNT, tidx1a )
371 :
372 : ! verbose mode
373 0 : IF ( verb ) THEN
374 0 : write(MSG,'(A30,f14.0)') 'adjusted preferred datetime: ', &
375 0 : prefYMDhm
376 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
377 : ENDIF
378 :
379 : ! check for time stamp with updated date/time
380 0 : CALL Check_AvailYMDhm ( Lct, nTime, availYMDhm, prefYMDhm, tidx1a )
381 :
382 : ! Can we leave now?
383 0 : ExitSearch = IsClosest( prefYMDhm, availYMDhm, nTime, tidx1a )
384 0 : IF ( ExitSearch ) tidx1 = tidx1a
385 :
386 : ENDDO
387 : ENDIF
388 :
389 : ! -------------------------------------------------------------
390 : ! If tidx1 still isn't defined, i.e. prefYMDhm is still
391 : ! outside the range of availYMDhm, set tidx1 to the closest
392 : ! available date. This must be 1 or nTime!
393 : ! -------------------------------------------------------------
394 0 : IF ( .NOT. ExitSearch ) THEN
395 0 : IF ( prefYMDhm < availYMDhm(1) ) THEN
396 0 : tidx1 = 1
397 : ELSE
398 0 : tidx1 = nTime
399 : ENDIF
400 : ENDIF
401 :
402 : ! -------------------------------------------------------------
403 : ! If we are dealing with 3-hourly or hourly data, select all timesteps
404 : ! -------------------------------------------------------------
405 :
406 : ! Hour flag is -1: wildcard
407 0 : IF ( Lct%Dct%Dta%ncHrs(1) == -1 .AND. nTime == 8 ) THEN
408 0 : tidx1 = 1
409 0 : tidx2 = nTime
410 :
411 : ! verbose mode
412 0 : IF ( verb ) THEN
413 0 : WRITE(MSG,*) 'Data is 3-hourly. Entire day will be read.'
414 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
415 : ENDIF
416 : ENDIF
417 0 : IF ( Lct%Dct%Dta%ncHrs(1) == -1 .AND. nTime == 24 ) THEN
418 0 : tidx1 = 1
419 0 : tidx2 = nTime
420 :
421 : ! verbose mode
422 0 : IF ( verb ) THEN
423 0 : WRITE(MSG,*) 'Data is hourly. Entire day will be read.'
424 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
425 : ENDIF
426 : ENDIF
427 :
428 : ! -------------------------------------------------------------
429 : ! If we are dealing with weekday data, pick the slice to be
430 : ! used based on the current day of week.
431 : ! The ncDys flag has been set in subroutine HCO_ExtractTime
432 : ! (hco_tidx_mod.F90) based upon the time attributes set in the
433 : ! configuration file. It can have the following values:
434 : ! >0 : specific days are given.
435 : ! -1 : wildcard (autodetect)
436 : ! -10 : WD (weekday).
437 : ! -999: determine from current simulation day.
438 : ! For specific days or if determined from the current datetime
439 : ! (flags >0 or -999), the weekday is not taken into account.
440 : ! If auto-detection is enabled, days are treated as weekday if
441 : ! (and only if) there are exactly 7 time slices. Otherwise, they
442 : ! are interpreted as 'regular' day data.
443 : ! If flag is set to -10, e.g. time attribute is 'WD', the current
444 : ! time index is assumed to hold Sunday data, with the following
445 : ! six slices being Mon, Tue, ..., Sat. For weekdaily data, all
446 : ! seven time slices will be read into memory so that at any given
447 : ! time, the local weekday can be taken (weekdaily data is always
448 : ! assumed to be in local time).
449 : ! -------------------------------------------------------------
450 :
451 : ! Day flag is -1: wildcard
452 0 : IF ( Lct%Dct%Dta%ncDys(1) == -1 .AND. nTime == 7 ) THEN
453 0 : tidx1 = 1
454 0 : tidx2 = nTime
455 :
456 : ! Make sure data is treated in local time
457 0 : Lct%Dct%Dta%IsLocTime = .TRUE.
458 :
459 : ! Day flag is -10: WD
460 0 : ELSEIF ( Lct%Dct%Dta%ncDys(1) == -10 ) THEN
461 :
462 : ! There must be at least 7 time slices
463 0 : IF ( nTime < 7 ) THEN
464 : MSG = 'Data must have exactly 7 time slices '// &
465 0 : 'if you set day attribute to WD: '//TRIM(Lct%Dct%cName)
466 0 : CALL HCO_ERROR( MSG, RC )
467 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
468 0 : DEALLOCATE(availYMDhm)
469 : availYMDhm => NULL()
470 : ENDIF
471 0 : RETURN
472 : ENDIF
473 :
474 : ! If there are exactly seven time slices, interpret them as
475 : ! the seven weekdays.
476 0 : IF ( nTime == 7 ) THEN
477 0 : tidx1 = 1
478 0 : tidx2 = 7
479 :
480 : ! If there are more than 7 time slices, interpret the current
481 : ! selected index as sunday of the current time frame (e.g. sunday
482 : ! data of current month), and select the time slice index
483 : ! accordingly. This requires that there are at least 6 more time
484 : ! slices following the current one.
485 : ELSE
486 0 : IF ( tidx1 < 0 ) THEN
487 0 : WRITE(MSG,*) 'Cannot get weekday slices for: ', &
488 0 : TRIM(Lct%Dct%cName), '. Cannot find first time slice.'
489 0 : CALL HCO_ERROR( MSG, RC )
490 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
491 0 : DEALLOCATE(availYMDhm)
492 : availYMDhm => NULL()
493 : ENDIF
494 0 : RETURN
495 : ENDIF
496 :
497 0 : IF ( (tidx1+6) > nTime ) THEN
498 0 : WRITE(MSG,*) 'Cannot get weekday for: ',TRIM(Lct%Dct%cName), &
499 0 : '. There are less than 6 additional time slices after ', &
500 0 : 'selected start date ', availYMDhm(tidx1)
501 0 : CALL HCO_ERROR( MSG, RC )
502 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
503 0 : DEALLOCATE(availYMDhm)
504 : availYMDhm => NULL()
505 : ENDIF
506 0 : RETURN
507 : ENDIF
508 0 : tidx2 = tidx1 + 6
509 : ENDIF
510 :
511 : ! Make sure data is treated in local time
512 0 : Lct%Dct%Dta%IsLocTime = .TRUE.
513 :
514 : ENDIF
515 :
516 : ! -------------------------------------------------------------
517 : ! Now need to set upper time slice index tidx2. This index
518 : ! is only different from tidx1 if:
519 : ! (1) We interpolate between two time slices, i.e. TimeCycle
520 : ! attribute is set to 'I'. In this case, we simply pick
521 : ! the next higher time slice index and calculate the
522 : ! weights for time1 and time2 based on the current time.
523 : ! (2) Multiple hourly slices are read (--> prefHr = -1 or -10,
524 : ! e.g. hour attribute in config. file was set to wildcard
525 : ! character or data is in local hours). In this case,
526 : ! check if there are multiple time slices for the selected
527 : ! date (y/m/d).
528 : ! tidx2 has already been set to proper value above if it's
529 : ! weekday data.
530 : ! -------------------------------------------------------------
531 0 : IF ( tidx2 < 0 ) THEN
532 :
533 : ! Interpolate between dates
534 0 : IF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_INTER ) THEN
535 :
536 : CALL GetIndex2Interp( HcoState, Lct, nTime, &
537 : availYMDhm, prefYMDhm, origYMDhm, &
538 : tidx1, tidx2, wgt1, &
539 0 : wgt2, RC )
540 0 : IF ( RC /= HCO_SUCCESS ) THEN
541 : MSG = 'Error encountered in GetIndex2Interp for: ' // &
542 0 : TRIM(Lct%Dct%Cname)
543 0 : CALL HCO_ERROR( MSG, RC )
544 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
545 0 : DEALLOCATE(availYMDhm)
546 : availYMDhm => NULL()
547 : ENDIF
548 0 : RETURN
549 : ENDIF
550 :
551 : ! Check for multiple hourly data
552 0 : ELSEIF ( tidx1 > 0 .AND. prefHr < 0 ) THEN
553 0 : CALL SET_TIDX2 ( nTime, availYMDhm, tidx1, tidx2 )
554 :
555 : ! Denote as local time if necessary
556 0 : IF ( Lct%Dct%Dta%ncHrs(1) == -10 ) THEN
557 0 : Lct%Dct%Dta%IsLocTime = .TRUE.
558 : ENDIF
559 : ELSE
560 0 : tidx2 = tidx1
561 : ENDIF
562 : ENDIF
563 :
564 : ! ================================================================
565 : ! Case 3: No time slice available. Set both indeces to zero. Data
566 : ! with no time stamp must have CycleFlag 'Cycling'.
567 : ! ================================================================
568 : ELSE
569 0 : IF ( Lct%Dct%Dta%CycleFlag /= HCO_CFLAG_CYCLE ) THEN
570 : MSG = 'Field has no time/date variable - cycle flag must' // &
571 : 'be set to `C` in the HEMCO configuration file:' // &
572 0 : TRIM(Lct%Dct%cName)
573 0 : CALL HCO_ERROR( MSG, RC )
574 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
575 0 : DEALLOCATE(availYMDhm)
576 : availYMDhm => NULL()
577 : ENDIF
578 0 : RETURN
579 : ENDIF
580 :
581 0 : tidx1 = 0
582 0 : tidx2 = 0
583 : ENDIF
584 :
585 : !-----------------------------------------------------------------
586 : ! Sanity check: if CycleFlag is set to 'Exact', the file time stamp
587 : ! must exactly match the current time.
588 : !-----------------------------------------------------------------
589 0 : IF ( (Lct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT) .AND. (tidx1 > 0) ) THEN
590 0 : IF ( availYMDhm(tidx1) /= prefYMDhm ) THEN
591 0 : tidx1 = -1
592 0 : tidx2 = -1
593 : ENDIF
594 : ENDIF
595 :
596 : !-----------------------------------------------------------------
597 : ! If multiple time slices are read, extract time interval between
598 : ! time slices in memory (in hours). This is to make sure that the
599 : ! cycling between the slices will be done at the correct rate
600 : ! (e.g. every hour, every 3 hours, ...).
601 : !-----------------------------------------------------------------
602 0 : IF ( (tidx2>tidx1) .AND. (Lct%Dct%Dta%CycleFlag/=HCO_CFLAG_INTER) ) THEN
603 0 : Lct%Dct%Dta%DeltaT = YMDhm2hrs( availYMDhm(tidx1+1) - availYMDhm(tidx1) )
604 : ELSE
605 0 : Lct%Dct%Dta%DeltaT = 0
606 : ENDIF
607 :
608 : ! verbose mode
609 0 : IF ( verb ) THEN
610 0 : WRITE(MSG,'(A30,I14)') 'selected tidx1: ', tidx1
611 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
612 0 : IF ( tidx1 > 0 ) THEN
613 0 : WRITE(MSG,'(A30,f14.0)') 'corresponding datetime 1: ', &
614 0 : availYMDhm(tidx1)
615 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
616 0 : IF ( wgt1 >= 0.0_sp ) THEN
617 0 : WRITE(MSG,*) 'weight1: ', wgt1
618 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
619 : ENDIF
620 : ENDIF
621 :
622 0 : IF ( (tidx2 /= tidx1) ) THEN
623 0 : WRITE(MSG,'(A30,I14)') 'selected tidx2: ', tidx2
624 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
625 0 : WRITE(MSG,'(A30,f14.0)') 'corresponding datetime 2: ', &
626 0 : availYMDhm(tidx2)
627 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
628 0 : IF ( wgt1 >= 0.0_sp ) THEN
629 0 : WRITE(MSG,*) 'weight2: ', wgt2
630 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
631 : ENDIF
632 : ENDIF
633 :
634 0 : WRITE(MSG,'(A30,I14)') 'assigned delta t [h]: ', Lct%Dct%Dta%DeltaT
635 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
636 0 : WRITE(MSG,*) 'local time? ', Lct%Dct%Dta%IsLocTime
637 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
638 : ENDIF
639 :
640 : ! ----------------------------------------------------------------
641 : ! TODO: set time brackets
642 : ! --> In future, we may want to set time brackets denoting the
643 : ! previous and next time slice available in the netCDF file. This
644 : ! may become useful for temporal interpolations and more efficient
645 : ! data update calls (only update if new time slice is available).
646 : ! ----------------------------------------------------------------
647 :
648 : !-----------------------------------------------------------------
649 : ! Prepare output, cleanup and leave
650 : !-----------------------------------------------------------------
651 :
652 : ! ncYr and ncMt are the year and month fo the time slice to be
653 : ! used. These values may be required to convert units to 'per
654 : ! seconds'.
655 0 : IF ( tidx1 > 0 ) THEN
656 0 : YMDhm = availYMDhm(tidx1)
657 0 : YMDhm1 = availYMDhm(1)
658 0 : oYMDhm = origYMDhm
659 : ENDIF
660 :
661 : ! Deallocate and nullify the pointer
662 0 : IF ( ASSOCIATED(availYMDhm) ) THEN
663 0 : DEALLOCATE(availYMDhm)
664 : availYMDhm => NULL()
665 : ENDIF
666 :
667 : ! Return w/ success
668 0 : CALL HCO_LEAVE ( HcoState%Config%Err, RC )
669 :
670 0 : END SUBROUTINE GET_TIMEIDX
671 : !EOC
672 : !------------------------------------------------------------------------------
673 : ! Harmonized Emissions Component (HEMCO) !
674 : !------------------------------------------------------------------------------
675 : !BOP
676 : !
677 : ! !IROUTINE: Check_AvailYMDhm
678 : !
679 : ! !DESCRIPTION: Checks if prefYMDhm is within the range of availYMDhm
680 : ! and returns the location of the closest vector element that is in
681 : ! the past (--> tidx1). tidx1 is set to -1 otherwise.
682 : !\\
683 : !\\
684 : ! !INTERFACE:
685 : !
686 0 : SUBROUTINE Check_AvailYMDhm( Lct, N, availYMDhm, prefYMDhm, tidx1 )
687 : !
688 : ! !INPUT PARAMETERS:
689 : !
690 : TYPE(ListCont), POINTER :: Lct
691 : INTEGER, INTENT(IN) :: N
692 : REAL(dp), INTENT(IN) :: availYMDhm(N)
693 : REAL(dp), INTENT(IN) :: prefYMDhm
694 : !
695 : ! !OUTPUT PARAMETERS:
696 : !
697 : INTEGER, INTENT(OUT) :: tidx1
698 : !
699 : ! !REVISION HISTORY:
700 : ! 13 Mar 2013 - C. Keller - Initial version
701 : ! See https://github.com/geoschem/hemco for complete history
702 : !EOP
703 : !------------------------------------------------------------------------------
704 : !BOC
705 : !
706 : ! !LOCAL VARIABLES:
707 : !
708 : INTEGER :: I, nTime
709 :
710 : !=================================================================
711 : ! Check_availYMDhm begins here
712 : !=================================================================
713 :
714 : ! Init
715 0 : tidx1 = -1
716 :
717 : ! Return if preferred datetime not within the vector range
718 0 : IF ( prefYMDhm < availYMDhm(1) .OR. prefYMDhm > availYMDhm(N) ) RETURN
719 :
720 : ! To avoid out-of-bounds error in the loop below:
721 : ! (1) For interpolated data, the upper loop limit should be N;
722 : ! (2) Otherwise, the upper loop limit should be N-1.
723 : ! (bmy, 4/28/21)
724 0 : nTime = N - 1
725 0 : IF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_INTER ) nTime = N
726 :
727 : ! Get closest index that is not in the future
728 0 : DO I = 1, nTime
729 :
730 : ! NOTE: Epsilon test is more robust than an equality test
731 : ! for double-precision variables (bmy, 4/11/17)
732 0 : IF ( ABS( availYMDhm(I) - prefYMDhm ) < EPSILON ) THEN
733 0 : tidx1 = I
734 0 : EXIT
735 : ENDIF
736 :
737 : ! Check if next time slice is in the future, in which case the
738 : ! current slice is selected. Don't do this for a CycleFlag of
739 : ! 3 (==> exact match).
740 0 : IF ( (availYMDhm(I+1) > prefYMDhm ) .AND. &
741 0 : (Lct%Dct%Dta%CycleFlag /= HCO_CFLAG_EXACT) ) THEN
742 0 : tidx1 = I
743 0 : EXIT
744 : ENDIF
745 : ENDDO
746 :
747 : END SUBROUTINE Check_AvailYMDhm
748 : !EOC
749 : !------------------------------------------------------------------------------
750 : ! Harmonized Emissions Component (HEMCO) !
751 : !------------------------------------------------------------------------------
752 : !BOP
753 : !
754 : ! !IROUTINE: prefYMDhm_Adjust
755 : !
756 : ! !DESCRIPTION: Adjusts prefYMDhm to the closest available time attribute. Can
757 : ! be adjusted for year (level=1), month (level=2), or day (level=3).
758 : !\\
759 : !\\
760 : ! !INTERFACE:
761 : !
762 0 : SUBROUTINE prefYMDhm_Adjust( N, availYMDhm, prefYMDhm, level, tidx1 )
763 : !
764 : ! !INPUT PARAMETERS:
765 : !
766 : INTEGER , INTENT(IN) :: N
767 : REAL(dp) , INTENT(IN) :: availYMDhm(N)
768 : INTEGER , INTENT(IN) :: level
769 : INTEGER , INTENT(IN) :: tidx1
770 : !
771 : ! !INPUT/OUTPUT PARAMETERS:
772 : !
773 : REAL(dp) , INTENT(INOUT) :: prefYMDhm
774 : !
775 : ! !REVISION HISTORY:
776 : ! 13 Mar 2013 - C. Keller - Initial version
777 : ! See https://github.com/geoschem/hemco for complete history
778 : !EOP
779 : !------------------------------------------------------------------------------
780 : !BOC
781 : !
782 : ! !LOCAL VARIABLES:
783 : !
784 : ! Scalars
785 : INTEGER :: I, IMIN, IMAX
786 : REAL(dp) :: origYr, origMt, origDy, origHr, origMi
787 : REAL(dp) :: refAttr, tmpAttr, newAttr
788 : REAL(dp) :: iDiff, minDiff
789 : REAL(dp) :: modVal
790 : REAL(dp) :: div
791 :
792 : !=================================================================
793 : ! prefYMDhm_Adjust begins here!
794 : !=================================================================
795 :
796 : ! Get original Yr, Mt, Day, Hr, Mi
797 : ! Time values are now in YYYYMMDDhhmm format (bmy, 4/11/17)
798 0 : origYr = FLOOR( MOD( prefYMDhm, 1.0e12_dp ) / 1.0e8_dp )
799 0 : origMt = FLOOR( MOD( prefYMDhm, 1.0e8_dp ) / 1.0e6_dp )
800 0 : origDy = FLOOR( MOD( prefYMDhm, 1.0e6_dp ) / 1.0e4_dp )
801 0 : origHr = FLOOR( MOD( prefYMDhm, 1.0e4_dp ) / 1.0e2_dp )
802 0 : origMi = FLOOR( MOD( prefYMDhm, 1.0e2_dp ) )
803 :
804 : ! Extract new attribute from availYMDhm and insert into prefYMDhm. Pick
805 : ! closest available value.
806 0 : SELECT CASE ( level )
807 : ! --- Year
808 : CASE ( 1 )
809 : modVal = 1.0e12_dp
810 : div = 1.0e8_dp
811 0 : refAttr = origYr
812 :
813 : ! --- Month
814 : CASE ( 2 )
815 0 : modVal = 1.0e8_dp
816 0 : div = 1.0e6_dp
817 0 : refAttr = origMt
818 :
819 : ! --- Day
820 : CASE ( 3 )
821 0 : modVal = 1.0e6_dp
822 0 : div = 1.0e4_dp
823 0 : refAttr = origMt
824 :
825 : ! --- Hour
826 : CASE ( 4 )
827 0 : modval = 1.0e4_dp
828 0 : div = 1.0e2_dp
829 0 : refAttr = origHr
830 :
831 : ! --- Minute
832 : CASE ( 5 )
833 0 : modVal = 1.0e2_dp
834 0 : div = 1.0_dp
835 0 : refAttr = origMi
836 :
837 : CASE DEFAULT
838 0 : RETURN
839 : END SELECT
840 :
841 : ! Maximum loop number:
842 : ! If tidx1 is already set, only search values in the past.
843 0 : IF ( tidx1 > 0 ) THEN
844 : IMIN = 1
845 : IMAX = tidx1
846 :
847 : ! If tidx1 is not yet set, prefYMDhm must be outside the range of
848 : ! availYMDhm. Pick only the closest available time stamp.
849 : ELSE
850 0 : IF ( prefYMDhm > availYMDhm(1) ) THEN
851 0 : IMIN = N
852 0 : IMAX = N
853 : ELSE
854 : IMIN = 1
855 : IMAX = 1
856 : ENDIF
857 : ENDIF
858 :
859 : ! Select current minimum value
860 0 : minDiff = 10000000000000000.0_dp
861 0 : newAttr = -1d0
862 0 : DO I = IMIN, IMAX
863 0 : tmpAttr = FLOOR( MOD(availYMDhm(I),modVal) / div )
864 0 : iDiff = ABS( tmpAttr - refAttr )
865 0 : IF ( iDiff < minDiff ) THEN
866 0 : newAttr = tmpAttr
867 0 : minDiff = iDiff
868 : ENDIF
869 : ENDDO
870 :
871 : ! Just reuse current value if no better value could be found
872 0 : IF ( newAttr < 0 ) THEN
873 0 : newAttr = refAttr
874 : ENDIF
875 :
876 : ! Update variable
877 : ! --- Year
878 0 : IF ( level == 1 ) THEN
879 : prefYMDhm = ( newAttr * 1.0e8_dp ) + &
880 : ( origMt * 1.0e6_dp ) + &
881 : ( origDy * 1.0e4_dp ) + &
882 : ( origHr * 1.0e2_dp ) + &
883 0 : ( origMi )
884 :
885 : ! --- Month
886 0 : ELSEIF ( level == 2 ) THEN
887 : prefYMDhm = ( origYr * 1.0e8_dp ) + &
888 : ( newAttr * 1.0e6_dp ) + &
889 : ( origDy * 1.0e4_dp ) + &
890 : ( origHr * 1.0e2_dp ) + &
891 0 : ( origMi )
892 :
893 : ! --- Day
894 0 : ELSEIF ( level == 3 ) THEN
895 : prefYMDhm = ( origYr * 1.0e8_dp ) + &
896 : ( origMt * 1.0e6_dp ) + &
897 : ( newAttr * 1.0e4_dp ) + &
898 : ( origHr * 1.0e2_dp ) + &
899 0 : ( origMi )
900 :
901 : ! --- Hour
902 0 : ELSEIF ( level == 4 ) THEN
903 : prefYMDhm = ( origYr * 1.0e8_dp ) + &
904 : ( origMt * 1.0e6_dp ) + &
905 : ( origDy * 1.0e4_dp ) + &
906 : ( newAttr * 1.0e2_dp ) + &
907 0 : ( origMi )
908 : ! --- Minute
909 0 : ELSEIF ( level == 5 ) THEN
910 : prefYMDhm = ( origYr * 1.0e8_dp ) + &
911 : ( origMt * 1.0e6_dp ) + &
912 : ( origDy * 1.0e4_dp ) + &
913 : ( origHr * 1.0e2_dp ) + &
914 0 : ( newAttr )
915 :
916 : ENDIF
917 :
918 : END SUBROUTINE prefYMDhm_Adjust
919 : !EOC
920 : !------------------------------------------------------------------------------
921 : ! Harmonized Emissions Component (HEMCO) !
922 : !------------------------------------------------------------------------------
923 : !BOP
924 : !
925 : ! !IROUTINE: Set_tIdx2
926 : !
927 : ! !DESCRIPTION: sets the upper time slice index by selecting the range
928 : ! of all elements in availYMDhm with the same date (year,month,day) as
929 : ! availYMDh(tidx1).
930 : !\\
931 : !\\
932 : ! !INTERFACE:
933 : !
934 0 : SUBROUTINE Set_tIdx2( N, availYMDhm, tidx1, tidx2 )
935 : !
936 : ! !INPUT PARAMETERS:
937 : !
938 : INTEGER, INTENT(IN) :: N ! Number of times
939 : REAL(dp), INTENT(IN) :: availYMDhm(N) ! Time stamp vector
940 : INTEGER, INTENT(IN) :: tidx1 ! Lower time slice index
941 : !
942 : ! !INPUT/OUTPUT PARAMETERS:
943 : !
944 : INTEGER, INTENT(OUT) :: tidx2 ! Upper time slice index
945 : !
946 : ! !REVISION HISTORY:
947 : ! 13 Mar 2013 - C. Keller - Initial version
948 : ! See https://github.com/geoschem/hemco for complete history
949 : !EOP
950 : !------------------------------------------------------------------------------
951 : !BOC
952 : !
953 : ! !LOCAL VARIABLES:
954 : !
955 : INTEGER :: YMD, I, IYMD
956 :
957 : !=================================================================
958 : ! SET_TIDX2 begins here!
959 : !=================================================================
960 :
961 : ! Init
962 0 : tidx2 = tidx1
963 :
964 : ! Sanity check
965 0 : IF ( tidx1 == N ) RETURN
966 :
967 : ! Get wanted YMD
968 0 : YMD = floor(availYMDhm(tidx1) / 1.0e4_dp)
969 :
970 : ! See how many more tile slices with the same YMD exist from index
971 : ! tidx1 onwards.
972 0 : DO I = tidx1, N
973 0 : iYMD = floor(availYMDhm(I) / 1.0e4_dp)
974 0 : IF ( iYMD == YMD ) THEN
975 0 : tidx2 = I
976 0 : ELSEIF ( iYMD > YMD ) THEN
977 : EXIT
978 : ENDIF
979 : ENDDO
980 :
981 : END SUBROUTINE Set_tIdx2
982 : !EOC
983 : !------------------------------------------------------------------------------
984 : ! Harmonized Emissions Component (HEMCO) !
985 : !------------------------------------------------------------------------------
986 : !BOP
987 : !
988 : ! !IROUTINE: IsClosest
989 : !
990 : ! !DESCRIPTION: function IsClosest returns true if the selected time index
991 : ! is the 'closest' one. It is defined as being closest if:
992 : ! (a) the currently selected index exactly matches the preferred one.
993 : ! (b) the time gap between the preferred time stamp and the currently selected
994 : ! index is at least as small as any other gap of consecutive prior time stamps.
995 : !\\
996 : !\\
997 : ! !INTERFACE:
998 : !
999 0 : FUNCTION IsClosest ( prefYMDhm, availYMDhm, nTime, ctidx1 ) RESULT ( Closest )
1000 : !
1001 : ! !INPUT PARAMETERS:
1002 : !
1003 : INTEGER, INTENT(IN) :: nTime
1004 : REAL(dp), INTENT(IN) :: prefYMDhm
1005 : REAL(dp), INTENT(IN) :: availYMDhm(nTime)
1006 : INTEGER, INTENT(IN) :: ctidx1
1007 : !
1008 : ! !OUTPUT PARAMETERS:
1009 : !
1010 : LOGICAL :: Closest
1011 : !
1012 : ! !REVISION HISTORY:
1013 : ! 03 Mar 2015 - C. Keller - Initial version
1014 : ! See https://github.com/geoschem/hemco for complete history
1015 : !EOP
1016 : !------------------------------------------------------------------------------
1017 : !BOC
1018 : !
1019 : ! !LOCAL VARIABLES:
1020 : !
1021 : INTEGER :: N
1022 : INTEGER :: diff, idiff
1023 :
1024 : !=================================================================
1025 : ! IsClosest begins here!
1026 : !=================================================================
1027 :
1028 : ! Init
1029 0 : Closest = .TRUE.
1030 :
1031 : ! It's not closest if index is not defined
1032 0 : IF ( ctidx1 <= 0 ) THEN
1033 0 : Closest = .FALSE.
1034 : RETURN
1035 : ENDIF
1036 :
1037 : ! It's closest if it is the first index
1038 0 : IF ( ctidx1 == 1 ) RETURN
1039 :
1040 : ! It's closest if it matches date exactly
1041 : ! NOTE: Epsilon test is more robust than an equality test
1042 : ! for double-precision variables (bmy, 4/11/17)
1043 0 : IF ( ABS( availYMDhm(ctidx1) - prefYMDhm ) < EPSILON ) RETURN
1044 :
1045 : ! It's closest if current select one is in the future
1046 0 : IF ( availYMDhm(ctidx1) > prefYMDhm ) RETURN
1047 :
1048 : ! Check if any of the time stamps in the past have closer intervals
1049 : ! than the current select time stamp to it's previous one
1050 0 : diff = prefYMDhm - availYMDhm(ctidx1)
1051 0 : DO N = 2, ctidx1
1052 0 : idiff = availYMDhm(N) - availYMDhm(N-1)
1053 0 : IF ( idiff < diff ) THEN
1054 0 : Closest = .FALSE.
1055 : RETURN
1056 : ENDIF
1057 : ENDDO
1058 :
1059 : END FUNCTION IsClosest
1060 : !EOC
1061 : !------------------------------------------------------------------------------
1062 : ! Harmonized Emissions Component (HEMCO) !
1063 : !------------------------------------------------------------------------------
1064 : !BOP
1065 : !
1066 : ! !IROUTINE: GetIndex2Interp
1067 : !
1068 : ! !DESCRIPTION: GetIndex2Interp
1069 : !\\
1070 : !\\
1071 : ! !INTERFACE:
1072 : !
1073 0 : SUBROUTINE GetIndex2Interp ( HcoState, Lct, &
1074 0 : nTime, availYMDhm, &
1075 : prefYMDhm, origYMDhm, tidx1, &
1076 : tidx2, wgt1, wgt2, RC )
1077 : !
1078 : ! !INPUT PARAMETERS:
1079 : !
1080 : TYPE(HCO_State), POINTER :: HcoState
1081 : TYPE(ListCont), POINTER :: Lct
1082 : INTEGER, INTENT(IN) :: nTime
1083 : REAL(dp), INTENT(IN) :: availYMDhm(nTime)
1084 : REAL(dp), INTENT(IN) :: prefYMDhm
1085 : REAL(dp), INTENT(IN) :: origYMDhm
1086 : INTEGER, INTENT(IN) :: tidx1
1087 : !
1088 : ! !OUTPUT PARAMETERS:
1089 : !
1090 : INTEGER, INTENT(OUT) :: tidx2
1091 : !
1092 : ! !INPUT/OUTPUT PARAMETERS:
1093 : !
1094 : REAL(sp), INTENT(INOUT) :: wgt1
1095 : REAL(sp), INTENT(INOUT) :: wgt2
1096 : INTEGER, INTENT(INOUT) :: RC
1097 : !
1098 : ! !REVISION HISTORY:
1099 : ! 02 Mar 2015 - C. Keller - Initial version
1100 : ! See https://github.com/geoschem/hemco for complete history
1101 : !EOP
1102 : !------------------------------------------------------------------------------
1103 : !BOC
1104 : !
1105 : ! !LOCAL VARIABLES:
1106 : !
1107 : ! Scalars
1108 : INTEGER :: I
1109 : REAL(dp) :: tmpYMDhm
1110 : LOGICAL :: verb
1111 :
1112 : ! Strings
1113 : CHARACTER(LEN=255) :: MSG
1114 : CHARACTER(LEN=255) :: LOC = 'GetIndex2Interp (hcoio_util_mod.F90)'
1115 :
1116 : !=================================================================
1117 : ! GetIndex2Interp begins here
1118 : !=================================================================
1119 :
1120 : ! Verbose mode?
1121 : verb = HCO_IsVerb(HcoState%Config%Err,3)
1122 :
1123 : ! If the originally wanted datetime was below the available data
1124 : ! range, set all weights to the first index.
1125 0 : IF ( origYMDhm <= availYMDhm(1) ) THEN
1126 0 : tidx2 = tidx1
1127 0 : wgt1 = 1.0_sp
1128 0 : wgt2 = 0.0_sp
1129 :
1130 : ! If the originally wanted datetime is beyond the available data
1131 : ! range, set tidx2 to tidx1 but leave weights in their original
1132 : ! values (-1.0). The reason is that we will attempt to interpolate
1133 : ! between a second file, which is only done if the weights are
1134 : ! negative.
1135 0 : ELSEIF ( origYMDhm >= availYMDhm(nTime) ) THEN
1136 0 : tidx2 = tidx1
1137 :
1138 : ! No interpolation needed if there is a time slices that exactly
1139 : ! matches the (originally) preferred datetime.
1140 : ! NOTE: An Epsilon test is more robust than an equality test
1141 : ! for double-precision variables (bmy, 4/11/17)
1142 0 : ELSEIF ( ABS( origYMDhm - availYMDhm(tidx1) ) < EPSILON ) THEN
1143 0 : tidx2 = tidx1
1144 0 : wgt1 = 1.0_sp
1145 0 : wgt2 = 0.0_sp
1146 :
1147 : ! If we are inside the data range but none of the time slices
1148 : ! matches the preferred datetime, get the second time slices that
1149 : ! shall be used for data interpolation. This not necessarily needs
1150 : ! to be the consecutive time slice. For instance, imagine a data
1151 : ! set that contains montlhly data for years 2005 and 2010. For
1152 : ! Feb 2007, we would want to interpolate between Feb 2005 and Feb
1153 : ! 2010 data. The index tidx1 already points to Feb 2005, but the
1154 : ! upper index tidx2 needs to be set accordingly.
1155 : ELSE
1156 :
1157 : ! Init
1158 0 : tidx2 = -1
1159 :
1160 : ! Search for a time slice in the future that has the same
1161 : ! month/day/hour as currently selected time slice.
1162 : tmpYMDhm = availYMDhm(tidx1)
1163 : DO
1164 : ! Increase by one year
1165 0 : tmpYMDhm = tmpYMDhm + 1.0e8_dp
1166 :
1167 : ! Exit if we are beyond available dates
1168 0 : IF ( tmpYMDhm > availYMDhm(nTime) ) EXIT
1169 :
1170 : ! Check if there is a time slice with that date
1171 0 : DO I = tidx1,nTime
1172 0 : IF ( tmpYMDhm == availYMDhm(I) ) THEN
1173 0 : tidx2 = I
1174 0 : EXIT
1175 : ENDIF
1176 : ENDDO
1177 0 : IF ( tidx2 > 0 ) EXIT
1178 : ENDDO
1179 :
1180 : ! Repeat above but now only modify month.
1181 0 : IF ( tidx2 < 0 ) THEN
1182 : tmpYMDhm = availYMDhm(tidx1)
1183 : DO
1184 : ! Increase by one month
1185 0 : tmpYMDhm = tmpYMDhm + 1.0e6_dp
1186 :
1187 : ! Exit if we are beyond available dates
1188 0 : IF ( tmpYMDhm > availYMDhm(nTime) ) EXIT
1189 :
1190 : ! Check if there is a time slice with that date
1191 0 : DO I = tidx1,nTime
1192 0 : IF ( ABS( tmpYMDhm - availYMDhm(I) ) < EPSILON ) THEN
1193 0 : tidx2 = I
1194 0 : EXIT
1195 : ENDIF
1196 : ENDDO
1197 0 : IF ( tidx2 > 0 ) EXIT
1198 : ENDDO
1199 : ENDIF
1200 :
1201 : ! Repeat above but now only modify day
1202 0 : IF ( tidx2 < 0 ) THEN
1203 : tmpYMDhm = availYMDhm(tidx1)
1204 : DO
1205 : ! Increase by one day
1206 0 : tmpYMDhm = tmpYMDhm + 1.0e4_dp
1207 :
1208 : ! Exit if we are beyond available dates
1209 0 : IF ( tmpYMDhm > availYMDhm(nTime) ) EXIT
1210 :
1211 : ! Check if there is a time slice with that date
1212 0 : DO I = tidx1,nTime
1213 0 : IF ( tmpYMDhm == availYMDhm(I) ) THEN
1214 0 : tidx2 = I
1215 0 : EXIT
1216 : ENDIF
1217 : ENDDO
1218 0 : IF ( tidx2 > 0 ) EXIT
1219 : ENDDO
1220 : ENDIF
1221 :
1222 : ! If all of those tests failed, simply get the next time
1223 : ! slice.
1224 0 : IF ( tidx2 < 0 ) THEN
1225 0 : tidx2 = tidx1 + 1
1226 :
1227 : ! Make sure that tidx2 does not exceed nTime, which is
1228 : ! the number of time slices in the file. This can cause
1229 : ! an out-of-bounds error. (bmy, 3/7/19)
1230 0 : IF ( tidx2 > nTime ) tidx2 = nTime
1231 :
1232 : ! Prompt warning
1233 0 : WRITE(MSG,*) 'Having problems in finding the next time slice ', &
1234 0 : 'to interpolate from, just take the next available ', &
1235 0 : 'slice. Interpolation will be performed from ', &
1236 0 : availYMDhm(tidx1), ' to ', availYMDhm(tidx2), '. Data ', &
1237 0 : 'container: ', TRIM(Lct%Dct%cName)
1238 0 : CALL HCO_WARNING(HcoState%Config%Err, MSG, RC, WARNLEV=1, THISLOC=LOC)
1239 : ENDIF
1240 :
1241 : ! Calculate weights wgt1 and wgt2 to be given to slice 1 and
1242 : ! slice2, respectively.
1243 0 : CALL GetWeights ( availYMDhm(tidx1), availYMDhm(tidx2), origYMDhm, &
1244 0 : wgt1, wgt2 )
1245 :
1246 : ENDIF
1247 :
1248 : ! Return w/ success
1249 0 : RC = HCO_SUCCESS
1250 :
1251 0 : END SUBROUTINE GetIndex2Interp
1252 : !EOC
1253 : !------------------------------------------------------------------------------
1254 : ! Harmonized Emissions Component (HEMCO) !
1255 : !------------------------------------------------------------------------------
1256 : !BOP
1257 : !
1258 : ! !IROUTINE: GetWeights
1259 : !
1260 : ! !DESCRIPTION: Helper function to get the interpolation weights between
1261 : ! two datetime intervals (int1, int2) and for a given time cur.
1262 : !\\
1263 : !\\
1264 : ! !INTERFACE:
1265 : !
1266 0 : SUBROUTINE GetWeights ( int1, int2, cur, wgt1, wgt2 )
1267 : !
1268 : ! !INPUT PARAMETERS:
1269 : !
1270 : REAL(dp), INTENT(IN ) :: int1, int2, cur
1271 : !
1272 : ! !INPUT/OUTPUT PARAMETERS:
1273 : !
1274 : REAL(sp), INTENT( OUT) :: wgt1, wgt2
1275 : !
1276 : ! !REVISION HISTORY:
1277 : ! 04 Mar 2015 - C. Keller - Initial version
1278 : ! See https://github.com/geoschem/hemco for complete history
1279 : !EOP
1280 : !------------------------------------------------------------------------------
1281 : !BOC
1282 : !
1283 : ! !LOCAL VARIABLES:
1284 : !
1285 : REAL(dp) :: diff1, diff2
1286 : REAL(dp) :: jdc, jd1, jd2
1287 :
1288 : !=================================================================
1289 : ! GetWeights begins here!
1290 : !=================================================================
1291 :
1292 : ! Convert dates to Julian dates
1293 0 : jdc = YMDhm2jd ( cur )
1294 0 : jd1 = YMDhm2jd ( int1 )
1295 0 : jd2 = YMDhm2jd ( int2 )
1296 :
1297 : ! Check if outside of range
1298 0 : IF ( jdc <= jd1 ) THEN
1299 0 : wgt1 = 1.0_sp
1300 0 : ELSEIF ( jdc >= jd2 ) THEN
1301 0 : wgt1 = 0.0_sp
1302 : ELSE
1303 0 : diff1 = jd2 - jdc
1304 0 : diff2 = jd2 - jd1
1305 0 : wgt1 = diff1 / diff2
1306 : ENDIF
1307 :
1308 : ! second weight is just complement of wgt1
1309 0 : wgt2 = 1.0_sp - wgt1
1310 :
1311 0 : END SUBROUTINE GetWeights
1312 : !EOC
1313 : !------------------------------------------------------------------------------
1314 : ! Harmonized Emissions Component (HEMCO) !
1315 : !------------------------------------------------------------------------------
1316 : !BOP
1317 : !
1318 : ! !IROUTINE: YMDhm2jd
1319 : !
1320 : ! !DESCRIPTION: returns the julian date of element YMDhm.
1321 : !\\
1322 : !\\
1323 : ! !INTERFACE:
1324 : !
1325 0 : FUNCTION YMDhm2jd ( YMDhm ) RESULT ( jd )
1326 : !
1327 : ! !USES:
1328 : !
1329 : USE HCO_Julday_Mod
1330 : !
1331 : ! !INPUT PARAMETERS:
1332 : !
1333 : REAL(dp), INTENT(IN) :: YMDhm
1334 : !
1335 : ! !INPUT/OUTPUT PARAMETERS:
1336 : !
1337 : REAL(hp) :: jd
1338 : !
1339 : ! !REVISION HISTORY:
1340 : ! 24 Feb 2019 - C. Keller - Initial version
1341 : ! See https://github.com/geoschem/hemco for complete history
1342 : !EOP
1343 : !------------------------------------------------------------------------------
1344 : !BOC
1345 : !
1346 : ! !LOCAL VARIABLES:
1347 : !
1348 : INTEGER :: yr, mt, dy, hr, mn
1349 : REAL(dp) :: utc, day
1350 :
1351 : !=================================================================
1352 : ! YMDh2jd begins here!
1353 : !=================================================================
1354 0 : yr = FLOOR( MOD( YMDhm, 1.0e12_dp ) / 1.0e8_dp )
1355 0 : mt = FLOOR( MOD( YMDhm, 1.0e8_dp ) / 1.0e6_dp )
1356 0 : dy = FLOOR( MOD( YMDhm, 1.0e6_dp ) / 1.0e4_dp )
1357 0 : hr = FLOOR( MOD( YMDhm, 1.0e4_dp ) / 1.0e2_dp )
1358 0 : mn = FLOOR( MOD( YMDhm, 1.0e2_dp ) )
1359 : utc = ( REAL(hr,dp) / 24.0_dp ) + &
1360 : ( REAL(mn,dp) / 1440.0_dp ) + &
1361 0 : ( REAL(0 ,dp) / 86400.0_dp )
1362 0 : day = REAL(dy,dp) + utc
1363 0 : jd = JULDAY( yr, mt, day )
1364 :
1365 0 : END FUNCTION YMDhm2jd
1366 : !EOC
1367 : !------------------------------------------------------------------------------
1368 : ! Harmonized Emissions Component (HEMCO) !
1369 : !------------------------------------------------------------------------------
1370 : !BOP
1371 : !
1372 : ! !IROUTINE: YMDhm2hrs
1373 : !
1374 : ! !DESCRIPTION: returns the hours of element YMDhm. For simplicity, 30 days are
1375 : ! assigned to every month. At the moment, this routine is only called to
1376 : ! determine the time interval between two emission time slices (DeltaT) and
1377 : ! this approximation is good enough.
1378 : !\\
1379 : !\\
1380 : ! !INTERFACE:
1381 : !
1382 0 : FUNCTION YMDhm2hrs ( YMDhm ) RESULT ( hrs )
1383 : !
1384 : ! !INPUT PARAMETERS:
1385 : !
1386 : REAL(dp), INTENT(IN) :: YMDhm
1387 : !
1388 : ! !INPUT/OUTPUT PARAMETERS:
1389 : !
1390 : INTEGER :: hrs
1391 : !
1392 : ! !REVISION HISTORY:
1393 : ! 26 Jan 2015 - C. Keller - Initial version
1394 : ! See https://github.com/geoschem/hemco for complete history
1395 : !EOP
1396 : !------------------------------------------------------------------------------
1397 : !BOC
1398 :
1399 : !=================================================================
1400 : ! YMDh2hrs begins here!
1401 : !=================================================================
1402 : hrs = FLOOR( MOD( YMDhm, 1.0e12_dp ) / 1.0e8_dp ) * 8760 + &
1403 : FLOOR( MOD( YMDhm, 1.0e8_dp ) / 1.0e6_dp ) * 720 + &
1404 : FLOOR( MOD( YMDhm, 1.0e6_dp ) / 1.0e4_dp ) * 24 + &
1405 0 : FLOOR( MOD( YMDhm, 1.0e4_dp ) / 1.0e2_dp )
1406 :
1407 0 : END FUNCTION YMDhm2hrs
1408 : !EOC
1409 : !------------------------------------------------------------------------------
1410 : ! Harmonized Emissions Component (HEMCO) !
1411 : !------------------------------------------------------------------------------
1412 : !BOP
1413 : !
1414 : ! !IROUTINE: Normalize_Area
1415 : !
1416 : ! !DESCRIPTION: Subroutine Normalize\_Area normalizes the given array
1417 : ! by the surface area calculated from the given netCDF file.
1418 : !\\
1419 : !\\
1420 : ! !INTERFACE:
1421 : !
1422 0 : SUBROUTINE Normalize_Area( HcoState, Array, nlon, LatEdge, FN, RC )
1423 : !
1424 : ! !INPUT PARAMETERS:
1425 : !
1426 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
1427 : INTEGER, INTENT(IN ) :: nlon ! # of lon midpoints
1428 : REAL(hp), POINTER :: LatEdge(:) ! lat edges
1429 : CHARACTER(LEN=*), INTENT(IN ) :: FN ! filename
1430 : !
1431 : ! !INPUT/OUTPUT PARAMETERS:
1432 : !
1433 : REAL(sp), POINTER :: Array(:,:,:,:) ! Data
1434 : INTEGER, INTENT(INOUT) :: RC ! Return code
1435 : !
1436 : ! !REVISION HISTORY:
1437 : ! 13 Mar 2013 - C. Keller - Initial version
1438 : ! See https://github.com/geoschem/hemco for complete history
1439 : !EOP
1440 : !------------------------------------------------------------------------------
1441 : !BOC
1442 : !
1443 : ! !LOCAL VARIABLES:
1444 : !
1445 : REAL(hp) :: DLAT, AREA
1446 : INTEGER :: NLAT, J
1447 : CHARACTER(LEN=255) :: MSG, LOC
1448 :
1449 : !=================================================================
1450 : ! NORNALIZE_AREA begins here!
1451 : !=================================================================
1452 :
1453 : ! Initialize
1454 0 : LOC = 'NORMALIZE_AREA (hcoio_util_mod.F90 )'
1455 :
1456 : ! Check array size
1457 0 : NLAT = SIZE(LatEdge,1) - 1
1458 :
1459 0 : IF ( SIZE(Array,1) /= nlon ) THEN
1460 0 : MSG = 'Array size does not agree with nlon: ' // TRIM(FN)
1461 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1462 0 : RETURN
1463 : ENDIF
1464 0 : IF ( SIZE(Array,2) /= NLAT ) THEN
1465 0 : MSG = 'Array size does not agree with nlat: ' // TRIM(FN)
1466 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
1467 0 : RETURN
1468 : ENDIF
1469 :
1470 : ! Loop over all latitudes
1471 0 : DO J = 1, NLAT
1472 : ! get grid box area in m2 for grid box with lower and upper latitude
1473 : ! llat/ulat: Area = 2 * PI * Re^2 * DLAT / nlon,
1474 : ! where DLAT = abs( sin(ulat) - sin(llat) )
1475 0 : DLAT = ABS( SIN(LatEdge(J+1)*HcoState%Phys%PI_180) &
1476 0 : - SIN(LatEdge(J)*HcoState%Phys%PI_180) )
1477 : AREA = ( 2_hp * HcoState%Phys%PI * DLAT * HcoState%Phys%Re**2 ) &
1478 0 : / REAL(nlon,hp)
1479 :
1480 : ! convert array data to m-2
1481 0 : ARRAY(:,J,:,:) = ARRAY(:,J,:,:) / AREA
1482 : ENDDO
1483 :
1484 : ! Prompt a warning
1485 0 : WRITE(MSG,*) 'No area unit found in ' // TRIM(FN) // ' - convert to m-2!'
1486 0 : CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, THISLOC=LOC )
1487 :
1488 : ! Leave w/ success
1489 0 : RC = HCO_SUCCESS
1490 :
1491 : END SUBROUTINE Normalize_Area
1492 : !EOC
1493 : !------------------------------------------------------------------------------
1494 : ! Harmonized Emissions Component (HEMCO) !
1495 : !------------------------------------------------------------------------------
1496 : !BOP
1497 : !
1498 : ! !IROUTINE: SrcFile_Parse
1499 : !
1500 : ! !DESCRIPTION: Routine SrcFile\_Parse parses the source file name ('ncFile')
1501 : ! of the provided list container Lct. In particular, it searches for tokens
1502 : ! such as $ROOT, $YYYY, etc., within the file name and replaces those values
1503 : ! with the intendend characters. The parsed file name is returned in string
1504 : ! srcFile, while the original file name is retained in Lct.
1505 : !\\
1506 : !\\
1507 : ! It now also checks if the file exists. If the file does not exist and the
1508 : ! file name contains date tokens, it tries to adjust the file name to the
1509 : ! closest available date in the past. The optional flag FUTURE can be used
1510 : ! to denote that the next available file in the future shall be selected,
1511 : ! even if there is a file that exactly matches the preferred date time. This
1512 : ! is useful for interpolation between fields.
1513 : !\\
1514 : !\\
1515 : ! !INTERFACE:
1516 : !
1517 0 : SUBROUTINE SrcFile_Parse ( HcoState, Lct, srcFile, FOUND, RC, &
1518 : Direction, Year )
1519 : !
1520 : ! !USES:
1521 : !
1522 : USE HCO_TIDX_MOD, ONLY : HCO_GetPrefTimeAttr
1523 : USE HCO_TIDX_MOD, ONLY : tIDx_IsInRange
1524 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Get
1525 : USE HCO_CLOCK_MOD, ONLY : Get_LastDayOfMonth
1526 : !
1527 : ! !INPUT PARAMETERS:
1528 : !
1529 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
1530 : TYPE(ListCont), POINTER :: Lct ! HEMCO list
1531 : INTEGER, INTENT(IN ), OPTIONAL :: Direction ! Look for file in
1532 : ! future (+1) or
1533 : ! past (-1)
1534 : INTEGER, INTENT(IN ), OPTIONAL :: Year ! To use fixed year
1535 : !
1536 : ! !OUTPUT PARAMETERS:
1537 : !
1538 : CHARACTER(LEN=*), INTENT( OUT) :: srcFile ! output string
1539 : LOGICAL, INTENT( OUT) :: FOUND ! Does file exist?
1540 : !
1541 : ! !INPUT/OUTPUT PARAMETERS:
1542 : !
1543 : INTEGER, INTENT(INOUT) :: RC ! return code
1544 : !
1545 : ! !REVISION HISTORY:
1546 : ! 01 Oct 2014 - C. Keller - Initial version
1547 : ! See https://github.com/geoschem/hemco for complete history
1548 : !EOP
1549 : !------------------------------------------------------------------------------
1550 : !BOC
1551 : !
1552 : ! !LOCAL VARIABLES:
1553 : !
1554 : INTEGER :: INC, CNT, TYPCNT, TYP, NEWTYP
1555 : INTEGER :: prefYr, prefMt, prefDy, prefHr, prefMn
1556 : INTEGER :: origYr, origMt, origDy, origHr
1557 : LOGICAL :: hasFile, hasYr, hasMt, hasDy, hasHr
1558 : LOGICAL :: nextTyp
1559 : CHARACTER(LEN=1023) :: MSG, LOC
1560 : CHARACTER(LEN=1023) :: srcFileOrig
1561 :
1562 : ! maximum # of iterations for file search
1563 : INTEGER, PARAMETER :: MAXIT = 10000
1564 :
1565 : !=================================================================
1566 : ! SrcFile_Parse
1567 : !=================================================================
1568 :
1569 : ! Initialize
1570 0 : LOC = 'SrcFile_Parse (HCOIO_UTIL_MOD.F90)'
1571 0 : RC = HCO_SUCCESS
1572 0 : found = .FALSE.
1573 0 : srcFile = Lct%Dct%Dta%ncFile
1574 :
1575 : ! verbose mode
1576 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
1577 0 : WRITE(MSG,*) 'Parsing source file and replacing tokens'
1578 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
1579 : ENDIF
1580 :
1581 : ! Get preferred dates (to be passed to parser)
1582 : CALL HCO_GetPrefTimeAttr ( HcoState, Lct, &
1583 0 : prefYr, prefMt, prefDy, prefHr, prefMn, RC )
1584 0 : IF ( RC /= HCO_SUCCESS ) THEN
1585 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
1586 0 : RETURN
1587 : ENDIF
1588 :
1589 : ! Make sure dates are not negative
1590 0 : IF ( prefYr <= 0 ) THEN
1591 0 : CALL HcoClock_Get( HcoState%Clock, cYYYY = prefYr, RC = RC )
1592 0 : IF ( RC /= HCO_SUCCESS ) THEN
1593 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
1594 0 : RETURN
1595 : ENDIF
1596 : ENDIF
1597 0 : IF ( prefMt <= 0 ) THEN
1598 0 : CALL HcoClock_Get( HcoState%Clock, cMM = prefMt, RC = RC )
1599 0 : IF ( RC /= HCO_SUCCESS ) THEN
1600 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
1601 0 : RETURN
1602 : ENDIF
1603 : ENDIF
1604 0 : IF ( prefDy <= 0 ) THEN
1605 0 : CALL HcoClock_Get( HcoState%Clock, cDD = prefDy, RC = RC )
1606 0 : IF ( RC /= HCO_SUCCESS ) THEN
1607 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
1608 0 : RETURN
1609 : ENDIF
1610 : ENDIF
1611 0 : IF ( prefHr < 0 ) THEN
1612 0 : CALL HcoClock_Get( HcoState%Clock, cH = prefHr, RC = RC )
1613 0 : IF ( RC /= HCO_SUCCESS ) THEN
1614 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
1615 0 : RETURN
1616 : ENDIF
1617 : ENDIF
1618 :
1619 : ! Eventually replace default preferred year with specified one
1620 0 : IF ( PRESENT(Year) ) prefYr = Year
1621 :
1622 : ! Call the parser
1623 : CALL HCO_CharParse ( HcoState%Config, srcFile, prefYr, prefMt, &
1624 0 : prefDy, prefHr, prefMn, RC )
1625 0 : IF ( RC /= HCO_SUCCESS ) THEN
1626 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
1627 0 : RETURN
1628 : ENDIF
1629 0 : srcFileOrig = TRIM(srcFile)
1630 :
1631 : ! Check if file exists
1632 0 : INQUIRE( FILE=TRIM(srcFile), EXIST=HasFile )
1633 :
1634 : ! If the direction flag is on, force HasFile to be false.
1635 0 : IF ( PRESENT(Direction) ) THEN
1636 0 : IF ( Direction /= 0 ) HasFile = .FALSE.
1637 : ENDIF
1638 :
1639 : !-----------------------------------------------------------------------
1640 : ! If this is a HEMCO dry-run simulation, then do not enter the loop
1641 : ! where we will attempt to go back in time until a file is found.
1642 : ! For the dry-run we need to report all files, even missing.
1643 : ! This fixes Github issue geoschem/geos-chem #312. (bmy, 6/9/20)
1644 : !-----------------------------------------------------------------------
1645 0 : IF ( HcoState%Options%isDryRun ) THEN
1646 :
1647 : ! Make sure that the year is not 1, this indicates that the
1648 : ! preferred year is outside of the years specified in the
1649 : ! time range settings in the configuration file, and will
1650 : ! lead to files with a year of "0001" in the path.
1651 : ! (bmy, 6/9/20)
1652 0 : IF ( prefyr == 1 ) THEN
1653 : MSG = 'Cannot find file for current simulation time: ' // &
1654 : TRIM(srcFile) // ' - Cannot get field ' // &
1655 : TRIM(Lct%Dct%cName) // '. Please check file name ' // &
1656 0 : 'and time (incl. time range flag) in the config. file'
1657 0 : CALL HCO_ERROR( MSG, RC )
1658 0 : RETURN
1659 : ENDIF
1660 :
1661 : ! Otherwise return with success
1662 0 : RC = HCO_SUCCESS
1663 0 : Found = HasFile
1664 0 : RETURN
1665 : ENDIF
1666 :
1667 : ! If file does not exist, check if we can adjust prefYr, prefMt, etc.
1668 0 : IF ( .NOT. HasFile .AND. Lct%Dct%DctType /= HCO_CFLAG_EXACT ) THEN
1669 :
1670 : ! Check if any token exist
1671 0 : HasYr = ( INDEX(TRIM(Lct%Dct%Dta%ncFile),'YYYY') > 0 )
1672 0 : HasMt = ( INDEX(TRIM(Lct%Dct%Dta%ncFile),'MM' ) > 0 )
1673 0 : HasDy = ( INDEX(TRIM(Lct%Dct%Dta%ncFile),'DD' ) > 0 )
1674 0 : HasHr = ( INDEX(TRIM(Lct%Dct%Dta%ncFile),'HH' ) > 0 )
1675 :
1676 : ! Search for file
1677 0 : IF ( HasYr .OR. HasMt .OR. HasDy .OR. HasHr ) THEN
1678 :
1679 : ! Date increments
1680 0 : INC = -1
1681 0 : IF ( PRESENT(Direction) ) THEN
1682 0 : INC = Direction
1683 : ENDIF
1684 :
1685 : ! Initialize counters
1686 0 : CNT = 0
1687 :
1688 : ! Type is the update type (see below)
1689 0 : TYP = 0
1690 :
1691 : ! Mirror preferred variables
1692 0 : origYr = prefYr
1693 0 : origMt = prefMt
1694 0 : origDy = prefDy
1695 0 : origHr = prefHr
1696 :
1697 : ! Do until file is found or counter exceeds threshold
1698 0 : DO WHILE ( .NOT. HasFile )
1699 :
1700 : ! Inrease counter
1701 0 : CNT = CNT + 1
1702 0 : IF ( CNT > MAXIT ) EXIT
1703 :
1704 : ! Increase update type if needed:
1705 0 : nextTyp = .FALSE.
1706 :
1707 : ! Type 0: Initialization
1708 0 : IF ( TYP == 0 ) THEN
1709 : nextTyp = .TRUE.
1710 : ! Type 1: update hour only
1711 0 : ELSEIF ( TYP == 1 .AND. TYPCNT > 24 ) THEN
1712 : nextTyp = .TRUE.
1713 : ! Type 2: update day only
1714 0 : ELSEIF ( TYP == 2 .AND. TYPCNT > 31 ) THEN
1715 : nextTyp = .TRUE.
1716 : ! Type 3: update month only
1717 0 : ELSEIF ( TYP == 3 .AND. TYPCNT > 12 ) THEN
1718 : nextTyp = .TRUE.
1719 : ! Type 4: update year only
1720 0 : ELSEIF ( TYP == 4 .AND. TYPCNT > 300 ) THEN
1721 : nextTyp = .TRUE.
1722 : ! Type 5: update hour and day
1723 0 : ELSEIF ( TYP == 5 .AND. TYPCNT > 744 ) THEN
1724 : nextTyp = .TRUE.
1725 : ! Type 6: update day and month
1726 0 : ELSEIF ( TYP == 6 .AND. TYPCNT > 372 ) THEN
1727 : nextTyp = .TRUE.
1728 : ! Type 7: update month and year
1729 0 : ELSEIF ( TYP == 7 .AND. TYPCNT > 3600 ) THEN
1730 : EXIT
1731 : ENDIF
1732 :
1733 : ! Get next type
1734 : IF ( nextTyp ) THEN
1735 0 : NEWTYP = -1
1736 0 : IF ( hasHr .AND. TYP < 1 ) THEN
1737 : NEWTYP = 1
1738 0 : ELSEIF ( hasDy .AND. TYP < 2 ) THEN
1739 : NEWTYP = 2
1740 0 : ELSEIF ( hasMt .AND. TYP < 3 ) THEN
1741 : NEWTYP = 3
1742 0 : ELSEIF ( hasYr .AND. TYP < 4 ) THEN
1743 : NEWTYP = 4
1744 : ELSEIF ( hasDy .AND. TYP < 2 ) THEN
1745 : NEWTYP = 5
1746 : ELSEIF ( hasDy .AND. TYP < 2 ) THEN
1747 : NEWTYP = 6
1748 : ELSEIF ( hasDy .AND. TYP < 2 ) THEN
1749 : NEWTYP = 7
1750 : ENDIF
1751 :
1752 : ! Exit if no other type found
1753 : IF ( NEWTYP < 0 ) EXIT
1754 :
1755 : ! This is the new type, reset type counter
1756 0 : TYP = NEWTYP
1757 0 : TYPCNT = 0
1758 :
1759 : ! Make sure we reset all values
1760 0 : prefYr = origYr
1761 0 : prefMt = origMt
1762 0 : prefDy = origDy
1763 0 : prefHr = origHr
1764 :
1765 : ENDIF
1766 :
1767 : ! Update preferred datetimes
1768 0 : SELECT CASE ( TYP )
1769 : ! Adjust hour only
1770 : CASE ( 1 )
1771 0 : prefHr = prefHr + INC
1772 : ! Adjust day only
1773 : CASE ( 2 )
1774 0 : prefDy = prefDy + INC
1775 : ! Adjust month only
1776 : CASE ( 3 )
1777 0 : prefMt = prefMt + INC
1778 : ! Adjust year only
1779 : CASE ( 4 )
1780 0 : prefYr = prefYr + INC
1781 : ! Adjust hour and day
1782 : CASE ( 5 )
1783 0 : prefHr = prefHr + INC
1784 0 : IF ( MOD(TYPCNT,24) == 0 ) prefDy = prefDy + INC
1785 : ! Adjust day and month
1786 : CASE ( 6 )
1787 0 : prefDy = prefDy + INC
1788 0 : IF ( MOD(TYPCNT,31) == 0 ) prefMt = prefMt + INC
1789 : ! Adjust month and year
1790 : CASE ( 7 )
1791 0 : prefMt = prefMt + INC
1792 0 : IF ( MOD(TYPCNT,12) == 0 ) prefYr = prefYr + INC
1793 : CASE DEFAULT
1794 0 : EXIT
1795 : END SELECT
1796 :
1797 : ! Check if we need to adjust a year/month/day/hour
1798 0 : IF ( prefHr < 0 ) THEN
1799 0 : prefHr = 23
1800 0 : prefDy = prefDy - 1
1801 : ENDIF
1802 0 : IF ( prefHr > 23 ) THEN
1803 0 : prefHr = 0
1804 0 : prefDy = prefDy + 1
1805 : ENDIF
1806 0 : IF ( prefDy < 1 ) THEN
1807 0 : prefDy = 31
1808 0 : prefMt = prefMt - 1
1809 : ENDIF
1810 0 : IF ( prefDy > 31 ) THEN
1811 0 : prefDy = 1
1812 0 : prefMt = prefMt + 1
1813 : ENDIF
1814 0 : IF ( prefMt < 1 ) THEN
1815 0 : prefMt = 12
1816 0 : prefYr = prefYr - 1
1817 : ENDIF
1818 0 : IF ( prefMt > 12 ) THEN
1819 0 : prefMt = 1
1820 0 : prefYr = prefYr + 1
1821 : ENDIF
1822 :
1823 : ! Make sure day does not exceed max. number of days in this month
1824 0 : prefDy = MIN( prefDy, Get_LastDayOfMonth( prefMt, prefYr ) )
1825 :
1826 : ! Mirror original file
1827 0 : srcFile = Lct%Dct%Dta%ncFile
1828 :
1829 : ! Call the parser with adjusted values
1830 : CALL HCO_CharParse ( HcoState%Config, srcFile, prefYr, &
1831 0 : prefMt, prefDy, prefHr, prefMn, RC )
1832 0 : IF ( RC /= HCO_SUCCESS ) THEN
1833 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
1834 0 : RETURN
1835 : ENDIF
1836 :
1837 : ! Check if this file exists
1838 0 : INQUIRE( FILE=TRIM(srcFile), EXIST=HasFile )
1839 :
1840 : ! Update counter
1841 0 : TYPCNT = TYPCNT + 1
1842 : ENDDO
1843 : ENDIF
1844 : ENDIF
1845 :
1846 : ! Additional check for data with a given range: make sure that the selected
1847 : ! field is not outside of the given range
1848 0 : IF ( HasFile .AND. ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) ) THEN
1849 0 : HasFile = TIDX_IsInRange ( Lct, prefYr, prefMt, prefDy, prefHr )
1850 : ENDIF
1851 :
1852 : ! Restore original source file name and date to avoid confusion in log file
1853 0 : IF ( .not. HasFile ) THEN
1854 0 : srcFile = Trim(srcFileOrig)
1855 : ENDIF
1856 :
1857 : ! Return variable
1858 0 : FOUND = HasFile
1859 :
1860 : ! Return w/ success
1861 0 : RC = HCO_SUCCESS
1862 :
1863 0 : END SUBROUTINE SrcFile_Parse
1864 : !EOC
1865 : !------------------------------------------------------------------------------
1866 : ! Harmonized Emissions Component (HEMCO) !
1867 : !------------------------------------------------------------------------------
1868 : !BOP
1869 : !
1870 : ! !IROUTINE: SigmaMidToEdges
1871 : !
1872 : ! !DESCRIPTION: Helper routine to interpolate sigma mid point values to edges.
1873 : ! A simple linear interpolation is performed.
1874 : !\\
1875 : !\\
1876 : ! !INTERFACE:
1877 : !
1878 0 : SUBROUTINE SigmaMidToEdges ( HcoState, SigMid, SigEdge, RC )
1879 : !
1880 : ! !INPUT PARAMETERS:
1881 : !
1882 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
1883 : REAL(hp), POINTER :: SigMid(:,:,:) ! sigma levels
1884 : !
1885 : ! !OUTPUT PARAMETERS:
1886 : !
1887 : REAL(hp), POINTER :: SigEdge(:,:,:) ! sigma edges
1888 : INTEGER, INTENT( OUT) :: RC ! return code
1889 : !
1890 : ! !REVISION HISTORY:
1891 : ! 03 Oct 2013 - C. Keller - Initial version
1892 : ! See https://github.com/geoschem/hemco for complete history
1893 : !EOP
1894 : !------------------------------------------------------------------------------
1895 : !BOC
1896 : !
1897 : ! !LOCAL VARIABLES:
1898 : !
1899 : INTEGER :: L, AS
1900 : INTEGER :: nx, ny, nz
1901 : CHARACTER(LEN=255) :: MSG
1902 : CHARACTER(LEN=255) :: LOC = 'SigmaMidToEdges (hcoio_util_mod.F90)'
1903 :
1904 : !=================================================================
1905 : ! SigmaMidToEdges begins here!
1906 : !=================================================================
1907 :
1908 : ! Allocate space as required
1909 0 : nx = SIZE(SigMid,1)
1910 0 : ny = SIZE(SigMid,2)
1911 0 : nz = SIZE(SigMid,3)
1912 0 : IF ( ASSOCIATED(SigEdge) ) DEALLOCATE(SigEdge)
1913 0 : ALLOCATE(SigEdge(nx,ny,nz+1),STAT=AS)
1914 0 : IF ( AS/=0 ) THEN
1915 : CALL HCO_ERROR( 'Allocate SigEdge', RC, &
1916 0 : THISLOC=LOC )
1917 0 : RETURN
1918 : ENDIF
1919 0 : SigEdge = 0.0_hp
1920 :
1921 : ! Calculate sigma edges by linear interpolation (symmetric mid-points)
1922 0 : DO L = 1, nz-1
1923 0 : SigEdge(:,:,L+1) = ( SigMid(:,:,L) + SigMid(:,:,L+1) ) / 2.0_hp
1924 : ENDDO
1925 :
1926 : ! Get outermost values:
1927 0 : SigEdge(:,:,1 ) = SigMid(:,:,1 ) - ( SigEdge(:,:,2) - SigMid(:,:,1) )
1928 0 : SigEdge(:,:,nz+1) = SigMid(:,:,nz) + ( SigMid(:,:,nz) - SigEdge(:,:,nz) )
1929 :
1930 : ! Return w/ success
1931 0 : RC = HCO_SUCCESS
1932 :
1933 : END SUBROUTINE SigmaMidToEdges
1934 : !EOC
1935 : !------------------------------------------------------------------------------
1936 : ! Harmonized Emissions Component (HEMCO) !
1937 : !------------------------------------------------------------------------------
1938 : !BOP
1939 : !
1940 : ! !IROUTINE: CheckMissVal
1941 : !
1942 : ! !DESCRIPTION: Checks for missing values in the passed array. Missing values
1943 : ! of base emissions and masks are set to 0, missing values of scale factors
1944 : ! are set to 1.
1945 : !\\
1946 : ! !INTERFACE:
1947 : !
1948 0 : SUBROUTINE CheckMissVal ( Lct, Arr )
1949 : !
1950 : ! !INPUT PARAMETERS:
1951 : !
1952 : TYPE(ListCont), POINTER :: Lct
1953 : REAL(sp), POINTER :: Arr(:,:,:,:)
1954 : !
1955 : ! !REVISION HISTORY:
1956 : ! 04 Mar 2015 - C. Keller - Initial version
1957 : ! See https://github.com/geoschem/hemco for complete history
1958 : !EOP
1959 : !------------------------------------------------------------------------------
1960 : !BOC
1961 : !
1962 : ! !LOCAL VARIABLES:
1963 : !
1964 : !=================================================================
1965 : ! CheckMissVal begins here!
1966 : !=================================================================
1967 :
1968 : ! Error trap
1969 0 : IF ( .NOT. ASSOCIATED(Arr) ) RETURN
1970 :
1971 0 : IF ( ANY(Arr == HCO_MISSVAL) ) THEN
1972 : ! Base emissions
1973 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
1974 0 : WHERE(Arr == HCO_MISSVAL) Arr = 0.0_sp
1975 : ! Scale factor
1976 0 : ELSEIF ( Lct%Dct%DctType == HCO_DCTTYPE_SCAL ) THEN
1977 0 : WHERE(Arr == HCO_MISSVAL) Arr = 1.0_sp
1978 : ! Mask
1979 0 : ELSEIF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK ) THEN
1980 0 : WHERE(Arr == HCO_MISSVAL) Arr = 0.0_sp
1981 : ENDIF
1982 : ENDIF
1983 :
1984 : END SUBROUTINE CheckMissVal
1985 : !EOC
1986 : !------------------------------------------------------------------------------
1987 : ! Harmonized Emissions Component (HEMCO) !
1988 : !------------------------------------------------------------------------------
1989 : !BOP
1990 : !
1991 : ! !IROUTINE: GetArbDimIndex
1992 : !
1993 : ! !DESCRIPTION: Subroutine GetArbDimIndex returns the index of the arbitrary
1994 : ! file dimension. -1 if no such dimension is defined.
1995 : !\\
1996 : ! !INTERFACE:
1997 : !
1998 0 : SUBROUTINE GetArbDimIndex( HcoState, Lun, Lct, ArbIdx, RC )
1999 : !
2000 : ! !USES:
2001 : !
2002 : USE HCO_m_netcdf_io_checks
2003 : USE HCO_m_netcdf_io_get_dimlen
2004 : USE HCO_ExtList_Mod, ONLY : GetExtOpt
2005 : !
2006 : ! !INPUT PARAMETERS:
2007 : !
2008 : TYPE(HCO_State), POINTER :: HcoState
2009 : INTEGER, INTENT(IN ) :: Lun
2010 : TYPE(ListCont), POINTER :: Lct
2011 : !
2012 : ! !OUTPUT PARAMETERS:
2013 : !
2014 : INTEGER, INTENT( OUT) :: ArbIdx
2015 : INTEGER, INTENT( OUT) :: RC
2016 : !
2017 : ! !REVISION HISTORY:
2018 : ! 22 Sep 2015 - C. Keller - Initial version
2019 : ! See https://github.com/geoschem/hemco for complete history
2020 : !EOP
2021 : !------------------------------------------------------------------------------
2022 : !BOC
2023 : !
2024 : ! !LOCAL VARIABLES:
2025 : !
2026 : INTEGER :: TargetVal, nVal
2027 : LOGICAL :: Found
2028 : CHARACTER(LEN=255) :: ArbDimVal
2029 : CHARACTER(LEN=511) :: MSG
2030 : CHARACTER(LEN=255) :: LOC = 'GetArbDimIndex (hcoio_util_mod.F90)'
2031 :
2032 : !=================================================================
2033 : ! GetArbDimIndex
2034 : !=================================================================
2035 :
2036 : ! Assume success until otherwise
2037 0 : RC = HCO_SUCCESS
2038 :
2039 : ! Init
2040 0 : ArbIdx = -1
2041 0 : IF ( TRIM(Lct%Dct%Dta%ArbDimName) == 'none' ) RETURN
2042 :
2043 : ! Check if variable exists
2044 0 : Found = Ncdoes_Dim_Exist ( Lun, TRIM(Lct%Dct%Dta%ArbDimName) )
2045 0 : IF ( .NOT. Found ) THEN
2046 : MSG = 'Cannot read dimension ' // TRIM(Lct%Dct%Dta%ArbDimName) &
2047 : // ' from file ' // &
2048 0 : TRIM(Lct%Dct%Dta%ncFile)
2049 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2050 0 : RETURN
2051 : ENDIF
2052 :
2053 : ! Get dimension length
2054 0 : CALL Ncget_Dimlen ( Lun, TRIM(Lct%Dct%Dta%ArbDimName), nVal )
2055 :
2056 : ! Get value to look for. This is archived in variable ArbDimVal.
2057 : ! Eventually need to extract value from HEMCO settings
2058 0 : ArbDimVal = TRIM(Lct%Dct%Dta%ArbDimVal)
2059 :
2060 : ! If string starts with a number, evaluate value directly
2061 : IF ( ArbDimVal(1:1) == '0' .OR. &
2062 : ArbDimVal(1:1) == '1' .OR. &
2063 : ArbDimVal(1:1) == '2' .OR. &
2064 : ArbDimVal(1:1) == '3' .OR. &
2065 : ArbDimVal(1:1) == '4' .OR. &
2066 : ArbDimVal(1:1) == '5' .OR. &
2067 : ArbDimVal(1:1) == '6' .OR. &
2068 : ArbDimVal(1:1) == '7' .OR. &
2069 0 : ArbDimVal(1:1) == '8' .OR. &
2070 : ArbDimVal(1:1) == '9' ) THEN
2071 0 : READ(ArbDimVal,*) TargetVal
2072 :
2073 : ! Otherwise, assume this is a HEMCO option (including a token)
2074 : ELSE
2075 0 : IF ( ArbDimVal(1:1) == '$' ) ArbDimVal = ArbDimVal(2:LEN(ArbDimVal))
2076 : CALL GetExtOpt ( HcoState%Config, ExtNr=-999, &
2077 : OptName=TRIM(ArbDimVal), &
2078 0 : OptValInt=TargetVal, FOUND=Found, RC=RC )
2079 0 : IF ( RC /= HCO_SUCCESS ) THEN
2080 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
2081 0 : RETURN
2082 : ENDIF
2083 0 : IF ( .NOT. Found ) THEN
2084 0 : WRITE(MSG,*) 'Cannot evaluate additional dimension value ', &
2085 0 : TRIM(ArbDimVal), '. This does not seem to be a number nor ', &
2086 0 : 'a HEMCO token/setting. This error happened when evaluating ', &
2087 0 : 'dimension ', TRIM(Lct%Dct%Dta%ArbDimName), ' belonging to ', &
2088 0 : 'file ', TRIM(Lct%Dct%Dta%ncFile)
2089 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2090 0 : RETURN
2091 : ENDIF
2092 : ENDIF
2093 :
2094 0 : IF ( TargetVal > nVal ) THEN
2095 0 : WRITE(MSG,*) 'Desired dimension value ', TargetVal, &
2096 0 : ' exceeds corresponding dimension length on that file: ', nVal, &
2097 0 : 'This error happened when evaluating ', &
2098 0 : 'dimension ', TRIM(Lct%Dct%Dta%ArbDimName), ' belonging to ', &
2099 0 : 'file ', TRIM(Lct%Dct%Dta%ncFile)
2100 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2101 0 : RETURN
2102 :
2103 : ELSE
2104 0 : ArbIdx = TargetVal
2105 : ENDIF
2106 :
2107 : ! Verbose
2108 0 : IF ( HcoState%amIRoot .AND. HCO_IsVerb( HcoState%Config%Err, 2 ) ) THEN
2109 0 : WRITE(MSG,*) 'Additional dimension ', TRIM(Lct%Dct%Dta%ArbDimName), &
2110 0 : ' in ', TRIM(Lct%Dct%Dta%ncFile), ': use index ', &
2111 0 : ArbIdx, ' (set: ', Lct%Dct%Dta%ArbDimVal, ')'
2112 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2113 : ENDIF
2114 :
2115 : ! Return w/ success
2116 0 : RC = HCO_SUCCESS
2117 :
2118 : END SUBROUTINE GetArbDimIndex
2119 : !EOC
2120 : #endif
2121 : !------------------------------------------------------------------------------
2122 : ! Harmonized Emissions Component (HEMCO) !
2123 : !------------------------------------------------------------------------------
2124 : !BOP
2125 : !
2126 : ! !IROUTINE: HCOIO_ReadOther
2127 : !
2128 : ! !DESCRIPTION: Subroutine HCOIO\_ReadOther is a wrapper routine to
2129 : ! read data from sources other than netCDF.
2130 : !\\
2131 : !\\
2132 : ! If a file name is given (ending with '.txt'), the data are assumed
2133 : ! to hold country-specific values (e.g. diurnal scale factors). In all
2134 : ! other cases, the data is directly read from the configuration file
2135 : ! (scalars).
2136 : !\\
2137 : !\\
2138 : ! !INTERFACE:
2139 : !
2140 0 : SUBROUTINE HCOIO_ReadOther( HcoState, Lct, RC )
2141 : !
2142 : ! !USES:
2143 : !
2144 : !
2145 : ! !INPUT PARAMTERS:
2146 : !
2147 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
2148 : !
2149 : ! !INPUT/OUTPUT PARAMETERS:
2150 : !
2151 : TYPE(ListCont), POINTER :: Lct
2152 : INTEGER, INTENT(INOUT) :: RC
2153 : !
2154 : ! !REVISION HISTORY:
2155 : ! 22 Dec 2014 - C. Keller: Initial version
2156 : ! See https://github.com/geoschem/hemco for complete history
2157 : !EOP
2158 : !------------------------------------------------------------------------------
2159 : !BOC
2160 : !
2161 : ! !LOCAL VARIABLES:
2162 : !
2163 : CHARACTER(LEN=255) :: MSG, LOC
2164 :
2165 : !======================================================================
2166 : ! HCOIO_ReadOther begins here
2167 : !======================================================================
2168 0 : LOC = 'HCOIO_ReadOther (HCOIO_UTIL_MOD.F90)'
2169 :
2170 : ! Error check: data must be in local time
2171 0 : IF ( .NOT. Lct%Dct%Dta%IsLocTime ) THEN
2172 : MSG = 'Cannot read data from file that is not in local time: ' // &
2173 0 : TRIM(Lct%Dct%cName)
2174 0 : CALL HCO_ERROR( MSG, RC, THISLOC='HCOIO_ReadOther (hcoio_dataread_mod.F90)' )
2175 0 : RETURN
2176 : ENDIF
2177 :
2178 : ! Read an ASCII file as country values
2179 0 : IF ( INDEX( TRIM(Lct%Dct%Dta%ncFile), '.txt' ) > 0 ) THEN
2180 0 : CALL HCOIO_ReadCountryValues( HcoState, Lct, RC )
2181 0 : IF ( RC /= HCO_SUCCESS ) THEN
2182 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
2183 0 : RETURN
2184 : ENDIF
2185 :
2186 : ! Directly read from configuration file otherwise
2187 : ELSE
2188 0 : CALL HCOIO_ReadFromConfig( HcoState, Lct, RC )
2189 0 : IF ( RC /= HCO_SUCCESS ) THEN
2190 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
2191 0 : RETURN
2192 : ENDIF
2193 : ENDIF
2194 :
2195 : ! Return w/ success
2196 0 : RC = HCO_SUCCESS
2197 :
2198 : END SUBROUTINE HCOIO_ReadOther
2199 : !EOC
2200 : !------------------------------------------------------------------------------
2201 : ! Harmonized Emissions Component (HEMCO) !
2202 : !------------------------------------------------------------------------------
2203 : !BOP
2204 : !
2205 : ! !IROUTINE: HCOIO_ReadCountryValues
2206 : !
2207 : ! !DESCRIPTION: Subroutine HCOIO\_ReadCountryValues
2208 : !\\
2209 : !\\
2210 : ! !INTERFACE:
2211 : !
2212 0 : SUBROUTINE HCOIO_ReadCountryValues ( HcoState, Lct, RC )
2213 : !
2214 : ! !USES:
2215 : !
2216 : USE HCO_inquireMod, ONLY : findFreeLUN
2217 : USE HCO_CHARTOOLS_MOD, ONLY : HCO_CMT, HCO_SPC, NextCharPos
2218 : USE HCO_EmisList_Mod, ONLY : HCO_GetPtr
2219 : USE HCO_FileData_Mod, ONLY : FileData_ArrCheck
2220 : !
2221 : ! !INPUT PARAMTERS:
2222 : !
2223 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
2224 : !
2225 : ! !INPUT/OUTPUT PARAMETERS:
2226 : !
2227 : TYPE(ListCont), POINTER :: Lct
2228 : INTEGER, INTENT(INOUT) :: RC
2229 : !
2230 : ! !REVISION HISTORY:
2231 : ! 22 Dec 2014 - C. Keller: Initial version
2232 : ! See https://github.com/geoschem/hemco for complete history
2233 : !EOP
2234 : !------------------------------------------------------------------------------
2235 : !BOC
2236 : !
2237 : ! !LOCAL VARIABLES:
2238 : !
2239 : INTEGER :: IUFILE, IOS
2240 : INTEGER :: ID1, ID2, I, NT, CID, NLINE
2241 0 : REAL(sp), POINTER :: CNTR(:,:)
2242 0 : INTEGER, ALLOCATABLE :: CIDS(:,:)
2243 0 : REAL(hp), POINTER :: Vals(:)
2244 : LOGICAL :: Verb
2245 : CHARACTER(LEN=2047) :: LINE
2246 : CHARACTER(LEN=255) :: MSG, DUM, CNT
2247 : CHARACTER(LEN=255) :: LOC = 'HCOIO_ReadCountryValues (hcoio_util_mod.F90)'
2248 :
2249 : !======================================================================
2250 : ! HCOIO_ReadCountryValues begins here
2251 : !======================================================================
2252 :
2253 : ! Init
2254 0 : CNTR => NULL()
2255 0 : Vals => NULL()
2256 :
2257 : ! verbose mode?
2258 0 : Verb = HCO_IsVerb(HcoState%Config%Err,2)
2259 :
2260 : ! Verbose
2261 0 : IF ( Verb ) THEN
2262 0 : MSG = 'Use country-specific values for ' // TRIM(Lct%Dct%cName)
2263 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2264 0 : MSG = '- Source file: ' // TRIM(Lct%Dct%Dta%ncFile)
2265 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2266 : ENDIF
2267 :
2268 : ! Open file
2269 0 : IUFILE = FindFreeLun()
2270 0 : OPEN ( IUFILE, FILE=TRIM( Lct%Dct%Dta%ncFile ), STATUS='OLD', IOSTAT=IOS )
2271 0 : IF ( IOS /= 0 ) THEN
2272 0 : MSG = 'Cannot open ' // TRIM(Lct%Dct%Dta%ncFile)
2273 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2274 0 : RETURN
2275 : ENDIF
2276 :
2277 : ! Repeat for every line
2278 : NLINE = 0
2279 : DO
2280 :
2281 : ! Read line
2282 0 : READ( IUFILE, '(a)', IOSTAT=IOS ) LINE
2283 :
2284 : ! End of file?
2285 0 : IF ( IOS < 0 ) EXIT
2286 :
2287 : ! Error?
2288 0 : IF ( IOS > 0 ) THEN
2289 0 : MSG = 'Error reading ' // TRIM(Lct%Dct%Dta%ncFile)
2290 0 : MSG = TRIM(MSG) // ' - last valid line: ' // TRIM(LINE)
2291 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2292 0 : RETURN
2293 : ENDIF
2294 :
2295 : ! Skip commented lines and/or empty lines
2296 0 : IF ( TRIM(LINE) == '' ) CYCLE
2297 0 : IF ( LINE(1:1) == HCO_CMT ) CYCLE
2298 :
2299 : ! First (valid) line holds the name of the mask container
2300 0 : IF ( NLINE == 0 ) THEN
2301 :
2302 : ! Get pointer to mask. Convert to integer
2303 0 : CALL HCO_GetPtr( HcoState, TRIM(LINE), CNTR, RC )
2304 0 : IF ( RC /= HCO_SUCCESS ) THEN
2305 0 : CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
2306 0 : RETURN
2307 : ENDIF
2308 0 : ALLOCATE( CIDS(HcoState%NX, HcoState%NY), STAT=IOS )
2309 0 : IF ( IOS /= 0 ) THEN
2310 0 : CALL HCO_ERROR( 'Cannot allocate CIDS', RC, THISLOC=LOC )
2311 0 : RETURN
2312 : ENDIF
2313 0 : CIDS = NINT(CNTR)
2314 :
2315 : ! Verbose
2316 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
2317 0 : MSG = '- Use ID mask ' // TRIM(LINE)
2318 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2319 : ENDIF
2320 :
2321 : ! Go to next line
2322 0 : NLINE = NLINE + 1
2323 0 : CYCLE
2324 : ENDIF
2325 :
2326 : ! Get first space character to skip country name.
2327 : ! We assume here that a country name is given right at the
2328 : ! beginning of the line, e.g. 'USA 744 1.05/1.02/...'
2329 0 : ID1 = NextCharPos( LINE, HCO_SPC )
2330 0 : CNT = LINE(1:ID1)
2331 :
2332 : ! Get country ID
2333 0 : DO I = ID1, LEN(LINE)
2334 0 : IF ( LINE(I:I) /= HCO_SPC ) EXIT
2335 : ENDDO
2336 0 : ID1 = I
2337 0 : ID2 = NextCharPos( LINE, HCO_SPC, START=ID1 )
2338 :
2339 0 : IF ( ID2 >= LEN(LINE) .OR. ID2 < 0 ) THEN
2340 0 : MSG = 'Cannot extract country ID from: ' // TRIM(LINE)
2341 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2342 0 : RETURN
2343 : ENDIF
2344 0 : DUM = LINE(ID1:ID2)
2345 0 : READ( DUM, * ) CID
2346 :
2347 : ! Extract data values
2348 0 : ID1 = ID2+1
2349 0 : ID2 = LEN(LINE)
2350 0 : LINE = LINE(ID1:ID2)
2351 0 : CALL GetDataVals( HcoState, Lct, LINE, Vals, RC )
2352 0 : IF ( RC /= HCO_SUCCESS ) THEN
2353 0 : CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
2354 0 : RETURN
2355 : ENDIF
2356 :
2357 : ! Check data / array dimensions
2358 0 : NT = SIZE(Vals,1)
2359 : CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, &
2360 0 : HcoState%NX, HcoState%NY, NT, RC )
2361 0 : IF ( RC /= HCO_SUCCESS ) THEN
2362 0 : CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
2363 0 : RETURN
2364 : ENDIF
2365 :
2366 : ! Pass to data array. If the country ID is larger than zero, fill
2367 : ! only those grid boxes. Otherwise, fill all grid boxes that have
2368 : ! not yet been filled.
2369 0 : DO I = 1, NT
2370 0 : IF ( CID == 0 ) THEN
2371 0 : WHERE ( Lct%Dct%Dta%V2(I)%Val <= 0.0_sp )
2372 0 : Lct%Dct%Dta%V2(I)%Val = Vals(I)
2373 : ENDWHERE
2374 : ELSE
2375 0 : WHERE ( CIDS == CID )
2376 0 : Lct%Dct%Dta%V2(I)%Val = Vals(I)
2377 : ENDWHERE
2378 : ENDIF
2379 : ENDDO
2380 :
2381 : ! Verbose
2382 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN
2383 0 : WRITE(MSG,*) '- Obtained values for ',TRIM(CNT),' ==> ID:', CID
2384 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2385 : ENDIF
2386 :
2387 : ! Cleanup
2388 0 : IF ( ASSOCIATED(Vals) ) DEALLOCATE( Vals )
2389 0 : Vals => NULL()
2390 :
2391 : ! Update # of read lines
2392 0 : NLINE = NLINE + 1
2393 : ENDDO
2394 :
2395 : ! Close file
2396 0 : CLOSE ( IUFILE )
2397 :
2398 : ! Data is 2D
2399 0 : Lct%Dct%Dta%SpaceDim = 2
2400 :
2401 : ! Make sure data is in local time
2402 0 : IF ( .NOT. Lct%Dct%Dta%IsLocTime ) THEN
2403 0 : Lct%Dct%Dta%IsLocTime = .TRUE.
2404 : MSG = 'Data assigned to mask regions will be treated in local time: '//&
2405 0 : TRIM(Lct%Dct%cName)
2406 0 : CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=2, THISLOC=LOC )
2407 : ENDIF
2408 :
2409 : ! Cleanup
2410 0 : Cntr => NULL()
2411 0 : IF ( ALLOCATED(CIDS) ) DEALLOCATE ( CIDS )
2412 :
2413 : ! Return w/ success
2414 0 : RC = HCO_SUCCESS
2415 :
2416 0 : END SUBROUTINE HCOIO_ReadCountryValues
2417 : !EOC
2418 : !------------------------------------------------------------------------------
2419 : ! Harmonized Emissions Component (HEMCO) !
2420 : !------------------------------------------------------------------------------
2421 : !BOP
2422 : !
2423 : ! !IROUTINE: HCOIO_ReadFromConfig
2424 : !
2425 : ! !DESCRIPTION: Subroutine HCOIO\_ReadFromConfig reads data directly from
2426 : ! the configuration file (instead of reading it from a netCDF file).
2427 : ! These data is always assumed to be spatially uniform, but it is possible
2428 : ! to specify multiple time slices by separating the individual time slice
2429 : ! values by the HEMCO separator sign ('/' by default). The time dimension
2430 : ! of these data is either determined from the srcTime attribute or estimated
2431 : ! from the number of time slices provided. For example, if no srcTime is
2432 : ! specified and 24 time slices are provided, data is assumed to represent
2433 : ! hourly data. Similarly, data is assumed to represent weekdaily or monthly
2434 : ! data for 7 or 12 time slices, respectively.
2435 : !\\
2436 : !\\
2437 : ! If the srcTime attribute is defined, the time slices are determined from
2438 : ! this attribute. Only one time dimension (year, month, day, or hour) can
2439 : ! be defined for scalar fields!
2440 : !\\
2441 : !\\
2442 : ! !INTERFACE:
2443 : !
2444 0 : SUBROUTINE HCOIO_ReadFromConfig( HcoState, Lct, RC )
2445 : !
2446 : ! !USES:
2447 : !
2448 : USE HCO_FILEDATA_MOD, ONLY : FileData_ArrCheck
2449 : !
2450 : ! !INPUT PARAMTERS:
2451 : !
2452 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
2453 : !
2454 : ! !INPUT/OUTPUT PARAMETERS:
2455 : !
2456 : TYPE(ListCont), POINTER :: Lct
2457 : INTEGER, INTENT(INOUT) :: RC
2458 : !
2459 : ! !REVISION HISTORY:
2460 : ! 24 Jul 2014 - C. Keller: Initial version
2461 : ! See https://github.com/geoschem/hemco for complete history
2462 : !EOP
2463 : !------------------------------------------------------------------------------
2464 : !BOC
2465 : !
2466 : ! !LOCAL VARIABLES:
2467 : !
2468 : INTEGER :: I, NT
2469 0 : REAL(hp), POINTER :: Vals(:)
2470 : CHARACTER(LEN=255) :: MSG
2471 : CHARACTER(LEN=255) :: LOC = 'HCOIO_ReadFromConfig (hcoio_util_mod.F90)'
2472 :
2473 : !======================================================================
2474 : ! HCOIO_ReadFromConfig begins here
2475 : !======================================================================
2476 :
2477 : ! Init
2478 0 : Vals => NULL()
2479 :
2480 : ! Verbose
2481 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN
2482 0 : WRITE(MSG, *) 'Read from config file: ', TRIM(Lct%Dct%cName)
2483 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
2484 : ENDIF
2485 :
2486 : !-------------------------------------------------------------------
2487 : ! Get data values for this time step.
2488 : !-------------------------------------------------------------------
2489 0 : CALL GetDataVals( HcoState, Lct, Lct%Dct%Dta%ncFile, Vals, RC )
2490 0 : IF ( RC /= HCO_SUCCESS ) THEN
2491 0 : CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
2492 0 : RETURN
2493 : ENDIF
2494 :
2495 : !-------------------------------------------------------------------
2496 : ! Copy data into array.
2497 : !-------------------------------------------------------------------
2498 :
2499 : ! Number of values
2500 0 : NT = SIZE(Vals,1)
2501 :
2502 : ! For masks, interpret data as mask corners (lon1/lat1/lon2/lat2)
2503 : ! with no time dimension
2504 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK ) THEN
2505 :
2506 : ! Make sure data is allocated
2507 : CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, &
2508 0 : HcoState%NX, HcoState%NY, 1, RC )
2509 0 : IF ( RC /= HCO_SUCCESS ) THEN
2510 0 : CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
2511 0 : RETURN
2512 : ENDIF
2513 :
2514 : ! Fill array: 1.0 within grid box, 0.0 outside.
2515 0 : CALL FillMaskBox( HcoState, Lct, Vals, RC )
2516 0 : IF ( RC /= HCO_SUCCESS ) THEN
2517 0 : CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
2518 0 : RETURN
2519 : ENDIF
2520 :
2521 : ! Data is 2D
2522 0 : Lct%Dct%Dta%SpaceDim = 2
2523 :
2524 : ! For base emissions and scale factors, interpret data as scalar
2525 : ! values with a time dimension.
2526 : ELSE
2527 :
2528 0 : CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, 1, 1, NT, RC )
2529 0 : IF ( RC /= HCO_SUCCESS ) THEN
2530 0 : CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
2531 0 : RETURN
2532 : ENDIF
2533 0 : DO I = 1, NT
2534 0 : Lct%Dct%Dta%V2(I)%Val(1,1) = Vals(I)
2535 : !==============================================================================
2536 : ! KLUDGE BY BOB YANTOSCA (05 Jan 2016)
2537 : !
2538 : ! This WRITE statement avoids a seg fault in some Intel Fortran Compiler
2539 : ! versions, such as ifort 12 and ifort 13. The ADVANCE="no" prevents
2540 : ! carriage returns from being added to the log file, and the '' character
2541 : ! will prevent text from creeping across the screen.
2542 : !
2543 : ! NOTE: This section only gets executed during the initialization phase,
2544 : ! when we save data not read from netCDF files into the HEMCO data structure.
2545 : ! This type of data includes scale factors and mask data specified as vectors
2546 : ! in the HEMCO configuration file. Therefore, this section will only get
2547 : ! executed at startup, so the WRITE statment should not add significant
2548 : ! overhead to the simulation.
2549 : !
2550 : ! The root issue seems to be an optimization bug in the compiler.
2551 : !==============================================================================
2552 : #if defined( LINUX_IFORT )
2553 : WRITE( 6, '(a)', ADVANCE='no' ) ''
2554 : #endif
2555 :
2556 : ENDDO
2557 :
2558 : ! Data is 1D
2559 0 : Lct%Dct%Dta%SpaceDim = 1
2560 :
2561 : ! Make sure data is in local time
2562 0 : IF ( .NOT. Lct%Dct%Dta%IsLocTime ) THEN
2563 0 : Lct%Dct%Dta%IsLocTime = .TRUE.
2564 : MSG = 'Scale factors read from file are treated as local time: '// &
2565 0 : TRIM(Lct%Dct%cName)
2566 : CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=2, &
2567 0 : THISLOC=LOC )
2568 : ENDIF
2569 :
2570 : ENDIF
2571 :
2572 : ! Cleanup
2573 0 : IF ( ASSOCIATED(Vals) ) DEALLOCATE(Vals)
2574 :
2575 : ! Return w/ success
2576 0 : RC = HCO_SUCCESS
2577 :
2578 0 : END SUBROUTINE HCOIO_ReadFromConfig
2579 : !EOC
2580 : !------------------------------------------------------------------------------
2581 : ! Harmonized Emissions Component (HEMCO) !
2582 : !------------------------------------------------------------------------------
2583 : !BOP
2584 : !
2585 : ! !IROUTINE: GetSliceIdx
2586 : !
2587 : ! !DESCRIPTION: gets the time slice index to be used for data directly
2588 : ! read from the HEMCO configuration file. prefDt denotes the preferred
2589 : ! time attribute (year, month, or day). DtType is used to identify the
2590 : ! time attribute type (1=year, 2=month, 3=day). The time slice index will
2591 : ! be selected based upon those two variables. IDX is the selected time
2592 : ! slice index. It will be set to -1 if the current simulation date
2593 : ! is outside of the specified time range and the time cycle attribute is
2594 : ! not enabled for this field.
2595 : !\\
2596 : !\\
2597 : ! !INTERFACE:
2598 : !
2599 0 : SUBROUTINE GetSliceIdx ( HcoState, Lct, DtType, prefDt, IDX, RC )
2600 : !
2601 : ! !INPUT PARAMETERS:
2602 : !
2603 : TYPE(HCO_State), POINTER :: HcoState
2604 : TYPE(ListCont), POINTER :: Lct
2605 : INTEGER, INTENT(IN ) :: DtType
2606 : INTEGER, INTENT(IN ) :: prefDt
2607 : !
2608 : ! !INPUT/OUTPUT PARAMETERS:
2609 : !
2610 : INTEGER, INTENT(INOUT) :: IDX
2611 : INTEGER, INTENT(INOUT) :: RC
2612 : !
2613 : ! !REVISION HISTORY:
2614 : ! 13 Mar 2013 - C. Keller - Initial version
2615 : ! See https://github.com/geoschem/hemco for complete history
2616 : !EOP
2617 : !------------------------------------------------------------------------------
2618 : !BOC
2619 : !
2620 : ! !LOCAL VARIABLES:
2621 : !
2622 : INTEGER :: lowDt, uppDt
2623 : CHARACTER(LEN=255) :: MSG
2624 : CHARACTER(LEN=255) :: LOC = 'GetSliceIdx (hcoio_util_mod.F90)'
2625 :
2626 : !=================================================================
2627 : ! GetSliceIdx begins here!
2628 : !=================================================================
2629 :
2630 : ! Init
2631 0 : RC = HCO_SUCCESS
2632 :
2633 : ! Get upper and lower time range
2634 0 : IF ( DtType == 1 ) THEN
2635 0 : lowDt = Lct%Dct%Dta%ncYrs(1)
2636 0 : uppDt = Lct%Dct%Dta%ncYrs(2)
2637 0 : ELSEIF ( DtType == 2 ) THEN
2638 0 : lowDt = Lct%Dct%Dta%ncMts(1)
2639 0 : uppDt = Lct%Dct%Dta%ncMts(2)
2640 0 : ELSEIF ( DtType == 3 ) THEN
2641 0 : lowDt = Lct%Dct%Dta%ncDys(1)
2642 0 : uppDt = Lct%Dct%Dta%ncDys(2)
2643 : ELSE
2644 0 : WRITE(MSG,*) "DtType must be one of 1, 2, 3: ", DtType
2645 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2646 0 : RETURN
2647 : ENDIF
2648 :
2649 : ! Check for cycle flags:
2650 :
2651 : ! Data cycle set to range or exact date: in these cases, the
2652 : ! the preferred date will be equal to the current date, so
2653 : ! check if the preferred date is indeed within the available
2654 : ! range (lowDt, uppDt).
2655 : ! For data only to be used within the specified range, set
2656 : ! index to -1. This will force the scale factors to be set to
2657 : ! zero!
2658 0 : IF ( prefDt < lowDt .OR. prefDt > uppDt ) THEN
2659 0 : IF ( ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) .OR. &
2660 : ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) ) THEN
2661 0 : IDX = -1
2662 0 : RETURN
2663 : ELSE
2664 : ! this here should never happen, since for a cycle flag of 1,
2665 : ! the preferred date should always be restricted to the range
2666 : ! of available time stamps.
2667 0 : MSG = 'preferred date is outside of range: ' // TRIM(Lct%Dct%cName)
2668 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2669 0 : RETURN
2670 : ENDIF
2671 : ENDIF
2672 :
2673 : ! If the code makes it to here, prefDt is within the available data range
2674 : ! and we simply get the wanted index from the current index and the lowest
2675 : ! available index.
2676 0 : IDX = prefDt - lowDt + 1
2677 :
2678 : END SUBROUTINE GetSliceIdx
2679 : !EOC
2680 : !------------------------------------------------------------------------------
2681 : ! Harmonized Emissions Component (HEMCO) !
2682 : !------------------------------------------------------------------------------
2683 : !BOP
2684 : !
2685 : ! !IROUTINE: GetDataVals
2686 : !
2687 : ! !DESCRIPTION: Subroutine GetDataVals extracts the data values from ValStr
2688 : ! and writes them into vector Vals. ValStr is typically a character string
2689 : ! read from an external ASCII file or directly from the HEMCO configuration
2690 : ! file. Depending on the time specifications provided in the configuration
2691 : ! file, Vals will be filled with only a subset of the values of ValStr.
2692 : !\\
2693 : !\\
2694 : ! !INTERFACE:
2695 : !
2696 0 : SUBROUTINE GetDataVals ( HcoState, Lct, ValStr, Vals, RC )
2697 : !
2698 : ! !USES:
2699 : !
2700 : USE HCO_CHARTOOLS_MOD, ONLY : HCO_CharSplit
2701 : USE HCO_EXTLIST_MOD, ONLY : HCO_GetOpt
2702 : USE HCO_UNIT_MOD, ONLY : HCO_Unit_Change
2703 : USE HCO_tIdx_Mod, ONLY : HCO_GetPrefTimeAttr
2704 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Get
2705 : !
2706 : ! !INPUT PARAMTERS:
2707 : !
2708 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
2709 : CHARACTER(LEN=*), INTENT(IN ) :: ValStr
2710 : !
2711 : ! !INPUT/OUTPUT PARAMETERS:
2712 : !
2713 : TYPE(ListCont), POINTER :: Lct
2714 : INTEGER, INTENT(INOUT) :: RC
2715 : !
2716 : ! !OUTPUT PARAMETERS:
2717 : !
2718 : REAL(hp), POINTER :: Vals(:)
2719 : !
2720 : ! !REVISION HISTORY:
2721 : ! 22 Dec 2014 - C. Keller: Initial version
2722 : ! See https://github.com/geoschem/hemco for complete history
2723 : !EOP
2724 : !------------------------------------------------------------------------------
2725 : !BOC
2726 : !
2727 : ! !LOCAL VARIABLES:
2728 : !
2729 : INTEGER :: HcoID
2730 : INTEGER :: I, N, NUSE, AS
2731 : INTEGER :: IDX1, IDX2
2732 : INTEGER :: AreaFlag, TimeFlag, Check
2733 : INTEGER :: prefYr, prefMt, prefDy, prefHr, prefMn
2734 : INTEGER :: cYr, cMt, cDy, cHr
2735 : REAL(hp) :: MW_g
2736 : REAL(hp) :: UnitFactor
2737 : REAL(hp) :: FileVals(100)
2738 0 : REAL(hp), POINTER :: FileArr(:,:,:,:)
2739 : LOGICAL :: IsPerArea
2740 : LOGICAL :: IsMath
2741 : CHARACTER(LEN=255) :: MSG
2742 : CHARACTER(LEN=255) :: LOC = 'GetDataVals (hcoio_util_mod.F90)'
2743 :
2744 : !======================================================================
2745 : ! GetDataVals begins here
2746 : !======================================================================
2747 :
2748 : ! Initialize
2749 0 : FileArr => NULL()
2750 :
2751 : ! Shadow species properties needed for unit conversion
2752 0 : HcoID = Lct%Dct%HcoID
2753 0 : IF ( HcoID > 0 ) THEN
2754 0 : MW_g = HcoState%Spc(HcoID)%MW_g
2755 : ELSE
2756 0 : MW_g = -999.0_hp
2757 : ENDIF
2758 :
2759 : ! Is this a math expression?
2760 0 : IsMath = .FALSE.
2761 0 : IF ( LEN(ValStr) > 5 ) THEN
2762 0 : IF ( ValStr(1:5)=='MATH:' ) IsMath = .TRUE.
2763 : ENDIF
2764 :
2765 : ! Evaluate math expression if string starts with 'MATH:'
2766 : IF ( IsMath ) THEN
2767 0 : CALL ReadMath ( HcoState, Lct, ValStr, FileVals, N, RC )
2768 0 : IF ( RC /= HCO_SUCCESS ) THEN
2769 0 : CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
2770 0 : RETURN
2771 : ENDIF
2772 :
2773 : ! Use regular string parser otherwise
2774 : ELSE
2775 : CALL HCO_CharSplit ( ValStr, &
2776 : HCO_GetOpt(HcoState%Config%ExtList,'Separator'), &
2777 : HCO_GetOpt(HcoState%Config%ExtList,'Wildcard'), &
2778 0 : FileVals, N, RC )
2779 0 : IF ( RC /= HCO_SUCCESS ) THEN
2780 0 : CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
2781 0 : RETURN
2782 : ENDIF
2783 : ENDIF
2784 :
2785 : ! Return w/ error if no scale factor defined
2786 0 : IF ( N == 0 ) THEN
2787 : MSG = 'Cannot read data: ' // TRIM(Lct%Dct%cName) // &
2788 0 : ': ' // TRIM(ValStr)
2789 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC)
2790 0 : RETURN
2791 : ENDIF
2792 :
2793 : ! Get the preferred times, i.e. the preferred year, month, day,
2794 : ! or hour (as specified in the configuration file).
2795 : CALL HCO_GetPrefTimeAttr( HcoState, Lct, &
2796 0 : prefYr, prefMt, prefDy, prefHr, prefMn, RC )
2797 0 : IF ( RC /= HCO_SUCCESS ) THEN
2798 0 : CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
2799 0 : RETURN
2800 : ENDIF
2801 :
2802 : ! ----------------------------------------------------------------
2803 : ! For masks, assume that values represent the corners of the mask
2804 : ! box, e.g. there must be four values. Masks are time-independent
2805 : ! and unitless
2806 : ! ----------------------------------------------------------------
2807 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK ) THEN
2808 :
2809 : ! There must be exactly four values
2810 0 : IF ( N /= 4 ) THEN
2811 : MSG = 'Mask values are not lon1/lat1/lon2/lat2: ' // &
2812 0 : TRIM(ValStr) // ' --> ' // TRIM(Lct%Dct%cName)
2813 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2814 0 : RETURN
2815 : ENDIF
2816 :
2817 : ! Pass to FileArr array (will be used below)
2818 0 : NUSE = 4
2819 0 : ALLOCATE( FileArr(1,1,1,NUSE), STAT=AS )
2820 : IF ( AS /= 0 ) THEN
2821 0 : MSG = 'Cannot allocate FileArr'
2822 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2823 0 : RETURN
2824 : ENDIF
2825 0 : FileArr(1,1,1,:) = FileVals(1:NUSE)
2826 :
2827 : ! ----------------------------------------------------------------
2828 : ! For non-masks, the data is interpreted as uniform values with
2829 : ! a time dimension. Need to select the time slices to be used at
2830 : ! this time (depending on the provided time attributes), as well
2831 : ! as to ensure that values are in the correct units.
2832 : ! Use all time slices unless a time interval is provided in
2833 : ! attribute srcTime of the configuration file.
2834 : ! ----------------------------------------------------------------
2835 : ELSE
2836 :
2837 : ! If there is only one value use this one and ignore any time
2838 : ! preferences.
2839 0 : IF ( N == 1 ) THEN
2840 0 : NUSE = 1
2841 0 : IDX1 = 1
2842 0 : IDX2 = 1
2843 :
2844 : ! If it's a math expression use all passed values
2845 0 : ELSEIF ( IsMath ) THEN
2846 0 : NUSE = N
2847 0 : IDX1 = 1
2848 0 : IDX2 = N
2849 :
2850 : ELSE
2851 : ! Currently, data read directly from the configuration file can only
2852 : ! represent one time dimension, i.e. it can only be yearly, monthly,
2853 : ! daily (or hourly data, but this is read all at the same time).
2854 :
2855 : ! Annual data
2856 0 : IF ( Lct%Dct%Dta%ncYrs(1) /= Lct%Dct%Dta%ncYrs(2) ) THEN
2857 : ! Error check
2858 : IF ( Lct%Dct%Dta%ncMts(1) /= Lct%Dct%Dta%ncMts(2) .OR. &
2859 0 : Lct%Dct%Dta%ncDys(1) /= Lct%Dct%Dta%ncDys(2) .OR. &
2860 : Lct%Dct%Dta%ncHrs(1) /= Lct%Dct%Dta%ncHrs(2) ) THEN
2861 : MSG = 'Data must not have more than one time dimension: ' // &
2862 0 : TRIM(Lct%Dct%cName)
2863 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2864 0 : RETURN
2865 : ENDIF
2866 :
2867 0 : CALL GetSliceIdx ( HcoState, Lct, 1, prefYr, IDX1, RC )
2868 0 : IF ( RC /= HCO_SUCCESS ) THEN
2869 0 : CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
2870 0 : RETURN
2871 : ENDIF
2872 0 : IDX2 = IDX1
2873 0 : NUSE = 1
2874 :
2875 : ! Monthly data
2876 0 : ELSEIF ( Lct%Dct%Dta%ncMts(1) /= Lct%Dct%Dta%ncMts(2) ) THEN
2877 : ! Error check
2878 0 : IF ( Lct%Dct%Dta%ncDys(1) /= Lct%Dct%Dta%ncDys(2) .OR. &
2879 : Lct%Dct%Dta%ncHrs(1) /= Lct%Dct%Dta%ncHrs(2) ) THEN
2880 : MSG = 'Data must only have one time dimension: ' // &
2881 0 : TRIM(Lct%Dct%cName)
2882 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2883 0 : RETURN
2884 : ENDIF
2885 :
2886 0 : CALL GetSliceIdx ( HcoState, Lct, 2, prefMt, IDX1, RC )
2887 0 : IF ( RC /= HCO_SUCCESS ) THEN
2888 0 : CALL HCO_ERROR( 'ERROR 22', RC, THISLOC=LOC )
2889 0 : RETURN
2890 : ENDIF
2891 0 : IDX2 = IDX1
2892 0 : NUSE = 1
2893 :
2894 : ! Daily data
2895 0 : ELSEIF ( Lct%Dct%Dta%ncDys(1) /= Lct%Dct%Dta%ncDys(2) ) THEN
2896 : ! Error check
2897 0 : IF ( Lct%Dct%Dta%ncHrs(1) /= Lct%Dct%Dta%ncHrs(2) ) THEN
2898 : MSG = 'Data must only have one time dimension: ' // &
2899 0 : TRIM(Lct%Dct%cName)
2900 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2901 0 : RETURN
2902 : ENDIF
2903 :
2904 0 : CALL GetSliceIdx ( HcoState, Lct, 3, prefDy, IDX1, RC )
2905 0 : IF ( RC /= HCO_SUCCESS ) THEN
2906 0 : CALL HCO_ERROR( 'ERROR 23', RC, THISLOC=LOC )
2907 0 : RETURN
2908 : ENDIF
2909 0 : IDX2 = IDX1
2910 0 : NUSE = 1
2911 :
2912 : ! All other cases (incl. hourly data): read all time slices).
2913 : ELSE
2914 0 : IDX1 = 1
2915 0 : IDX2 = N
2916 0 : NUSE = N
2917 : ENDIF
2918 : ENDIF
2919 :
2920 : ! ----------------------------------------------------------------
2921 : ! Read selected time slice(s) into data array
2922 : ! ----------------------------------------------------------------
2923 0 : IF ( IDX2 > N ) THEN
2924 0 : WRITE(MSG,*) 'Index ', IDX2, ' is larger than number of ', &
2925 0 : 'values found: ', TRIM(Lct%Dct%cName)
2926 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2927 0 : RETURN
2928 : ENDIF
2929 :
2930 0 : ALLOCATE( FileArr(1,1,1,NUSE), STAT=AS )
2931 : IF ( AS /= 0 ) THEN
2932 0 : MSG = 'Cannot allocate FileArr'
2933 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
2934 0 : RETURN
2935 : ENDIF
2936 :
2937 : ! Check for range/exact flag
2938 : ! If range is given, the preferred Yr/Mt/Dy/Hr will be negative
2939 : ! if we are outside the desired range.
2940 0 : IF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) THEN
2941 0 : IF ( prefYr == -1 .OR. prefMt == -1 .OR. prefDy == -1 ) IDX1 = -1
2942 0 : IF ( Lct%Dct%Dta%ncHrs(1) >= 0 .AND. prefHr == -1 ) IDX1 = -1
2943 :
2944 : ! If flag is exact, the preferred date must be equal to the current
2945 : ! simulation date.
2946 0 : ELSEIF ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) THEN
2947 0 : IF ( Lct%Dct%Dta%ncYrs(1) > 0 ) THEN
2948 0 : IF ( prefYr < Lct%Dct%Dta%ncYrs(1) .OR. &
2949 0 : prefYr > Lct%Dct%Dta%ncYrs(2) ) IDX1 = -1
2950 : ENDIF
2951 0 : IF ( Lct%Dct%Dta%ncMts(1) > 0 ) THEN
2952 0 : IF ( prefMt < Lct%Dct%Dta%ncMts(1) .OR. &
2953 0 : prefMt > Lct%Dct%Dta%ncMts(2) ) IDX1 = -1
2954 : ENDIF
2955 0 : IF ( Lct%Dct%Dta%ncDys(1) > 0 ) THEN
2956 0 : IF ( prefDy < Lct%Dct%Dta%ncDys(1) .OR. &
2957 0 : prefDy > Lct%Dct%Dta%ncDys(2) ) IDX1 = -1
2958 : ENDIF
2959 0 : IF ( Lct%Dct%Dta%ncHrs(1) >= 0 ) THEN
2960 0 : IF ( prefHr < Lct%Dct%Dta%ncHrs(1) .OR. &
2961 0 : prefHr > Lct%Dct%Dta%ncHrs(2) ) IDX1 = -1
2962 : ENDIF
2963 : ENDIF
2964 :
2965 : ! IDX1 becomes -1 for data that is outside of the valid range
2966 : ! (and no time cycling enabled). In this case, make sure that
2967 : ! scale factor is set to zero.
2968 0 : IF ( IDX1 < 0 ) THEN
2969 0 : IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
2970 0 : FileArr(1,1,1,:) = 0.0_hp
2971 : MSG = 'Base field outside of range - set to zero: ' // &
2972 0 : TRIM(Lct%Dct%cName)
2973 : CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, &
2974 0 : THISLOC=LOC )
2975 : #if defined( MODEL_GEOS )
2976 : ELSEIF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK ) THEN
2977 : FileArr(1,1,1,:) = 0.0_hp
2978 : MSG = 'Mask outside of range - set to zero: ' // &
2979 : TRIM(Lct%Dct%cName)
2980 : CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, &
2981 : THISLOC=LOC )
2982 : #endif
2983 : ELSE
2984 0 : FileArr(1,1,1,:) = 1.0_hp
2985 : MSG = 'Scale factor outside of range - set to one: ' // &
2986 0 : TRIM(Lct%Dct%cName)
2987 : CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, &
2988 0 : THISLOC=LOC )
2989 : ENDIF
2990 : ELSE
2991 0 : FileArr(1,1,1,:) = FileVals(IDX1:IDX2)
2992 : ENDIF
2993 :
2994 : ! ----------------------------------------------------------------
2995 : ! Convert data to HEMCO units
2996 : ! ----------------------------------------------------------------
2997 : CALL HCO_UNIT_CHANGE( HcoConfig = HcoState%Config, &
2998 : Array = FileArr, &
2999 : Units = TRIM(Lct%Dct%Dta%OrigUnit), &
3000 : MW = MW_g, &
3001 : YYYY = -999, &
3002 : MM = -999, &
3003 : AreaFlag = AreaFlag, &
3004 : TimeFlag = TimeFlag, &
3005 : FACT = UnitFactor, &
3006 0 : RC = RC )
3007 0 : IF ( RC /= HCO_SUCCESS ) THEN
3008 0 : CALL HCO_ERROR( 'ERROR 24', RC, THISLOC=LOC )
3009 0 : RETURN
3010 : ENDIF
3011 :
3012 : ! Verbose mode
3013 0 : IF ( UnitFactor /= 1.0_hp ) THEN
3014 0 : IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN
3015 0 : WRITE(MSG,*) 'Data was in units of ', TRIM(Lct%Dct%Dta%OrigUnit), &
3016 0 : ' - converted to HEMCO units by applying ', &
3017 0 : 'scale factor ', UnitFactor
3018 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3019 : ENDIF
3020 : ELSE
3021 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN
3022 0 : WRITE(MSG,*) 'Data was in units of ', TRIM(Lct%Dct%Dta%OrigUnit), &
3023 0 : ' - unit conversion factor is ', UnitFactor
3024 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3025 : ENDIF
3026 : ENDIF
3027 :
3028 : ! Data must be ...
3029 : ! ... concentration ...
3030 0 : IF ( AreaFlag == 3 .AND. TimeFlag == 0 ) THEN
3031 0 : Lct%Dct%Dta%IsConc = .TRUE.
3032 :
3033 0 : ELSEIF ( AreaFlag == 3 .AND. TimeFlag == 1 ) THEN
3034 0 : Lct%Dct%Dta%IsConc = .TRUE.
3035 0 : FileArr = FileArr * HcoState%TS_EMIS
3036 : MSG = 'Data converted from kg/m3/s to kg/m3: ' // &
3037 0 : TRIM(Lct%Dct%cName) // ': ' // TRIM(Lct%Dct%Dta%OrigUnit)
3038 : CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, &
3039 0 : THISLOC=LOC )
3040 :
3041 : ! ... emissions or unitless ...
3042 0 : ELSEIF ( (AreaFlag == -1 .AND. TimeFlag == -1) .OR. &
3043 : (AreaFlag == 2 .AND. TimeFlag == 1) ) THEN
3044 0 : Lct%Dct%Dta%IsConc = .FALSE.
3045 :
3046 : ! ... invalid otherwise:
3047 : ELSE
3048 : MSG = 'Unit must be unitless, emission or concentration: ' // &
3049 0 : TRIM(Lct%Dct%cName) // ': ' // TRIM(Lct%Dct%Dta%OrigUnit)
3050 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3051 0 : RETURN
3052 : ENDIF
3053 :
3054 : ! Auto-detect delta t [in hours] between time slices.
3055 : ! Scale factors can be:
3056 : ! length 1 : constant
3057 : ! length 7 : weekday factors: Sun, Mon, ..., Sat
3058 : ! length 12: monthly factors: Jan, Feb, ..., Dec
3059 : ! length 24: hourly factors: 12am, 1am, ... 11pm
3060 0 : IF ( NUSE == 1 ) THEN
3061 0 : Lct%Dct%Dta%DeltaT = 0
3062 0 : ELSEIF ( NUSE == 7 ) THEN
3063 0 : Lct%Dct%Dta%DeltaT = 24
3064 0 : ELSEIF ( NUSE == 12 ) THEN
3065 0 : Lct%Dct%Dta%DeltaT = 720
3066 0 : ELSEIF ( NUSE == 24 ) THEN
3067 0 : Lct%Dct%Dta%DeltaT = 1
3068 : ELSE
3069 : MSG = 'Factor must be of length 1, 7, 12, or 24!' // &
3070 0 : TRIM(Lct%Dct%cName)
3071 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC)
3072 0 : RETURN
3073 : ENDIF
3074 :
3075 : ENDIF ! Masks vs. non-masks
3076 :
3077 : ! Copy data into output array.
3078 0 : IF ( ASSOCIATED(Vals) ) DEALLOCATE( Vals )
3079 0 : ALLOCATE( Vals(NUSE), STAT=AS )
3080 : IF ( AS /= 0 ) THEN
3081 0 : MSG = 'Cannot allocate Vals'
3082 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3083 0 : RETURN
3084 : ENDIF
3085 0 : Vals(:) = FileArr(1,1,1,:)
3086 :
3087 : ! Cleanup
3088 0 : IF ( ASSOCIATED(FileArr) ) DEALLOCATE(FileArr)
3089 0 : FileArr => NULL()
3090 :
3091 : ! Return w/ success
3092 0 : RC = HCO_SUCCESS
3093 :
3094 0 : END SUBROUTINE GetDataVals
3095 : !EOC
3096 : !------------------------------------------------------------------------------
3097 : ! Harmonized Emissions Component (HEMCO) !
3098 : !------------------------------------------------------------------------------
3099 : !BOP
3100 : !
3101 : ! !IROUTINE: FillMaskBox
3102 : !
3103 : ! !DESCRIPTION: Subroutine FillMaskBox fills the data array of the passed list
3104 : ! container Lct according to the mask region provided in Vals. Vals contains
3105 : ! the mask region of interest, denoted by the lower left and upper right grid
3106 : ! box corners: lon1, lat1, lon2, lat2. The data array of Lct is filled such
3107 : ! that all grid boxes are set to 1 whose mid-point is inside of the given box
3108 : ! range.
3109 : !\\
3110 : !\\
3111 : ! !INTERFACE:
3112 : !
3113 0 : SUBROUTINE FillMaskBox ( HcoState, Lct, Vals, RC )
3114 : !
3115 : ! !USES:
3116 : !
3117 : !
3118 : ! !INPUT PARAMTERS:
3119 : !
3120 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
3121 : REAL(hp) , POINTER :: Vals(:)
3122 : !
3123 : ! !INPUT/OUTPUT PARAMETERS:
3124 : !
3125 : TYPE(ListCont), POINTER :: Lct
3126 : INTEGER, INTENT(INOUT) :: RC
3127 : !
3128 : ! !REVISION HISTORY:
3129 : ! 29 Dec 2014 - C. Keller - Initial version
3130 : ! See https://github.com/geoschem/hemco for complete history
3131 : !EOP
3132 : !------------------------------------------------------------------------------
3133 : !BOC
3134 : !
3135 : ! !LOCAL VARIABLES:
3136 : !
3137 : LOGICAL :: GridPoint
3138 : INTEGER :: I, J
3139 : REAL(hp) :: LON1, LON2, LAT1, LAT2
3140 : REAL(hp) :: XDG1, XDG2, YDG1, YDG2
3141 : REAL(hp) :: ILON, ILAT
3142 : CHARACTER(LEN=255) :: MSG
3143 : CHARACTER(LEN=255) :: LOC = 'FillMaskBox (hcoio_util_mod.F90)'
3144 :
3145 : !=================================================================
3146 : ! FillMaskBox begins here!
3147 : !=================================================================
3148 :
3149 : ! Extract lon1, lon2, lat1, lat2
3150 0 : LON1 = VALS(1)
3151 0 : LAT1 = VALS(2)
3152 0 : LON2 = VALS(3)
3153 0 : LAT2 = VALS(4)
3154 :
3155 : ! Check if this is mask is a point. In this case, we need the grid
3156 : ! box edges being defined.
3157 0 : GridPoint = .FALSE.
3158 0 : IF ( ( LON1 == LON2 ) .AND. ( LAT1 == LAT2 ) ) THEN
3159 0 : IF ( .NOT. ASSOCIATED(HcoState%Grid%XEDGE%Val) .OR. &
3160 : .NOT. ASSOCIATED(HcoState%Grid%YEDGE%Val) ) THEN
3161 : MSG = 'Cannot evaluate grid point mask - need grid box ' // &
3162 : 'edges for this. This error occurs if a mask covers '// &
3163 : 'a fixed grid point (e.g. lon1=lon2 and lat1=lat2) ' // &
3164 0 : 'but HEMCO grid edges are not defined.'
3165 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3166 0 : RETURN
3167 : ENDIF
3168 : GridPoint = .TRUE.
3169 : ENDIF
3170 :
3171 : ! Check for every grid box if mid point is within mask region.
3172 : ! Set to 1.0 if this is the case.
3173 : !$OMP PARALLEL DO &
3174 : !$OMP DEFAULT( SHARED ) &
3175 : !$OMP PRIVATE( I, J, ILON, ILAT ) &
3176 : !$OMP PRIVATE( XDG1, XDG2, YDG1, YDG2 ) &
3177 : !$OMP SCHEDULE( DYNAMIC )
3178 0 : DO J = 1, HcoState%NY
3179 0 : DO I = 1, HcoState%NX
3180 :
3181 : ! If it's a grid point, check if it's within this
3182 : ! grid box
3183 0 : IF ( GridPoint ) THEN
3184 0 : XDG1 = HcoState%Grid%XEDGE%Val(I ,J )
3185 0 : XDG2 = HcoState%Grid%XEDGE%Val(I+1,J )
3186 0 : YDG1 = HcoState%Grid%YEDGE%Val(I ,J )
3187 0 : YDG2 = HcoState%Grid%YEDGE%Val(I ,J+1)
3188 0 : IF ( XDG1 >= 180.0_hp ) XDG1 = XDG1 - 360.0_hp
3189 0 : IF ( XDG2 >= 180.0_hp ) XDG2 = XDG2 - 360.0_hp
3190 :
3191 : IF ( LON1 >= XDG1 .AND. LON1 <= XDG2 .AND. &
3192 0 : LAT1 >= YDG1 .AND. LAT1 <= YDG2 ) THEN
3193 0 : Lct%Dct%Dta%V2(1)%Val(I,J) = 1.0_sp
3194 : ENDIF
3195 :
3196 : ! Check if mid point is within mask region
3197 : ELSE
3198 : ! Get longitude and latitude at this grid box
3199 0 : ILON = HcoState%Grid%XMID%Val(I,J)
3200 0 : ILAT = HcoState%Grid%YMID%Val(I,J)
3201 0 : IF ( ILON >= 180.0_hp ) ILON = ILON - 360.0_hp
3202 :
3203 : IF ( ILON >= LON1 .AND. ILON <= LON2 .AND. &
3204 0 : ILAT >= LAT1 .AND. ILAT <= LAT2 ) THEN
3205 0 : Lct%Dct%Dta%V2(1)%Val(I,J) = 1.0_sp
3206 : ENDIF
3207 : ENDIF
3208 :
3209 : ENDDO
3210 : ENDDO
3211 : !$OMP END PARALLEL DO
3212 :
3213 : ! Return w/ success
3214 0 : RC = HCO_SUCCESS
3215 :
3216 : END SUBROUTINE FillMaskBox
3217 : !EOC
3218 : !------------------------------------------------------------------------------
3219 : ! Harmonized Emissions Component (HEMCO) !
3220 : !------------------------------------------------------------------------------
3221 : !BOP
3222 : !
3223 : ! !IROUTINE: ReadMath
3224 : !
3225 : ! !DESCRIPTION: Subroutine ReadMath reads and evaluates a mathematical
3226 : ! expression. Mathematical expressions can combine time-stamps with
3227 : ! mathematical functions, e.g. to yield the sine of current simulation hour.
3228 : ! Mathematical expressions must start with the identifier 'MATH:', followed
3229 : ! by the actual expression. Each expression must include at least one
3230 : ! variable (evaluated at runtime). The following variables are currently
3231 : ! supported: YYYY (year), MM (month), DD (day), HH (hour), LH (local hour),
3232 : ! NN (minute), SS (second), WD (weekday), LWD (local weekday),
3233 : ! DOY (day of year), ELH (elapsed hours), ELS (elapsed seconds).
3234 : ! In addition, the following variables can be used: PI (3.141...), DOM
3235 : ! (\# of days of current month).
3236 : ! For example, the following expression would yield a continuous sine
3237 : ! curve as function of hour of day: 'MATH:sin(HH/24*PI*2)'.
3238 : !\\
3239 : !\\
3240 : ! For a full list of valid mathematical expressions, see module interpreter.F90.
3241 : !\\
3242 : !\\
3243 : ! !INTERFACE:
3244 : !
3245 0 : SUBROUTINE ReadMath( HcoState, Lct, ValStr, Vals, N, RC )
3246 : !
3247 : ! !USES:
3248 : !
3249 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Get
3250 : USE HCO_tIdx_Mod, ONLY : HCO_GetPrefTimeAttr
3251 : USE INTERPRETER
3252 : !
3253 : ! !INPUT PARAMTERS:
3254 : !
3255 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state
3256 : TYPE(ListCont), POINTER :: Lct
3257 : CHARACTER(LEN=*), INTENT(IN ) :: ValStr
3258 : !
3259 : ! !INPUT/OUTPUT PARAMETERS:
3260 : !
3261 : REAL(hp), INTENT(INOUT) :: Vals(:)
3262 : INTEGER, INTENT(INOUT) :: RC
3263 : !
3264 : ! !OUTPUT PARAMETERS:
3265 : !
3266 : INTEGER, INTENT( OUT) :: N
3267 : !
3268 : ! !REVISION HISTORY:
3269 : ! 11 May 2017 - C. Keller - Initial version
3270 : ! See https://github.com/geoschem/hemco for complete history
3271 : !EOP
3272 : !------------------------------------------------------------------------------
3273 : !BOC
3274 : !
3275 : ! !LOCAL VARIABLES:
3276 : !
3277 : LOGICAL :: EOS
3278 : INTEGER :: STRL
3279 : INTEGER :: I, NVAL, LHIDX, LWDIDX
3280 : INTEGER :: prefYr, prefMt, prefDy, prefHr, prefMn
3281 : INTEGER :: prefWD, prefDOY, prefS, LMD, cHr
3282 : INTEGER :: nSteps
3283 : REAL(hp) :: ELH, ELS
3284 : REAL(hp) :: Val
3285 : CHARACTER(LEN=255) :: MSG
3286 : CHARACTER(LEN=255) :: LOC = 'ReadMath (hcoio_util_mod.F90)'
3287 :
3288 : ! Variables used by the evaluator to build and to determine the value
3289 : ! of the expressions
3290 : character(len = 10) :: all_variables(12)
3291 : real(hp) :: all_variablesvalues(12)
3292 :
3293 : !String variable that will store the function that the evaluator will build
3294 : character (len = 275) :: func
3295 :
3296 : !String variable that will return the building of the expression result
3297 : !If everything was ok then statusflag = 'ok', otherwise statusflag = 'error'
3298 : character (len = 5) :: statusflag
3299 :
3300 : !======================================================================
3301 : ! ReadMath begins here
3302 : !======================================================================
3303 :
3304 : ! Substring (without flag 'MATH:')
3305 0 : STRL = LEN(ValStr)
3306 0 : IF ( STRL < 6 ) THEN
3307 : MSG = 'Math expression is too short - expected `MATH:<expr>`: ' &
3308 0 : //TRIM(ValStr)
3309 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3310 0 : RETURN
3311 : ENDIF
3312 0 : func = ValStr(6:STRL)
3313 :
3314 : ! Get preferred time stamps
3315 : CALL HCO_GetPrefTimeAttr( HcoState, Lct, &
3316 0 : prefYr, prefMt, prefDy, prefHr, prefMn, RC )
3317 0 : IF ( RC /= HCO_SUCCESS ) THEN
3318 0 : CALL HCO_ERROR( 'ERROR 25', RC, THISLOC=LOC )
3319 0 : RETURN
3320 : ENDIF
3321 :
3322 : ! Get some other current time stamps
3323 : CALL HcoClock_Get( HcoState%Clock, cS=prefS, cH=cHr, &
3324 : cWEEKDAY=prefWD, cDOY=prefDOY, LMD=LMD, &
3325 0 : nSteps=nSteps, RC=RC )
3326 0 : IF ( RC /= HCO_SUCCESS ) THEN
3327 0 : CALL HCO_ERROR( 'ERROR 26', RC, THISLOC=LOC )
3328 0 : RETURN
3329 : ENDIF
3330 :
3331 : ! GetPrefTimeAttr can return -999 for hour. In this case set to current
3332 : ! simulation hour
3333 0 : IF ( prefHr < 0 ) prefHr = cHr
3334 :
3335 : ! Parse function. This will replace any tokens in the function with the
3336 : ! actual token values. (ckeller, 7/7/17)
3337 : CALL HCO_CharParse ( HcoState%Config, func, &
3338 0 : prefYr, prefMt, prefDy, prefHr, prefMn, RC )
3339 0 : IF ( RC /= HCO_SUCCESS ) THEN
3340 0 : CALL HCO_ERROR( 'ERROR 27', RC, THISLOC=LOC )
3341 0 : RETURN
3342 : ENDIF
3343 :
3344 : ! Elapsed hours and seconds since start time
3345 0 : ELS = HcoState%TS_DYN * nSteps
3346 0 : ELH = ELS / 3600.0_hp
3347 :
3348 : ! Check which variables are in string.
3349 : ! Possible variables are YYYY, MM, DD, WD, HH, NN, SS, DOY, ELH, ELS
3350 0 : NVAL = 0
3351 0 : LHIDX = -1
3352 0 : LWDIDX = -1
3353 :
3354 0 : IF ( INDEX(func,'YYYY') > 0 ) THEN
3355 0 : NVAL = NVAL + 1
3356 0 : all_variables(NVAL) = 'yyyy'
3357 0 : all_variablesvalues(NVAL) = prefYr
3358 : ENDIF
3359 0 : IF ( INDEX(func,'MM') > 0 ) THEN
3360 0 : NVAL = NVAL + 1
3361 0 : all_variables(NVAL) = 'mm'
3362 0 : all_variablesvalues(NVAL) = prefMt
3363 : ENDIF
3364 0 : IF ( INDEX(func,'DD') > 0 ) THEN
3365 0 : NVAL = NVAL + 1
3366 0 : all_variables(NVAL) = 'dd'
3367 0 : all_variablesvalues(NVAL) = prefDy
3368 : ENDIF
3369 0 : IF ( INDEX(func,'WD') > 0 ) THEN
3370 0 : NVAL = NVAL + 1
3371 0 : all_variables(NVAL) = 'wd'
3372 0 : all_variablesvalues(NVAL) = prefWD
3373 : ENDIF
3374 0 : IF ( INDEX(func,'LWD') > 0 ) THEN
3375 0 : NVAL = NVAL + 1
3376 0 : all_variables(NVAL) = 'lwd'
3377 0 : all_variablesvalues(NVAL) = prefWD
3378 0 : LWDIDX = NVAL
3379 : ENDIF
3380 0 : IF ( INDEX(func,'HH') > 0 ) THEN
3381 0 : NVAL = NVAL + 1
3382 0 : all_variables(NVAL) = 'hh'
3383 0 : all_variablesvalues(NVAL) = prefHr
3384 : ENDIF
3385 0 : IF ( INDEX(func,'LH') > 0 ) THEN
3386 0 : NVAL = NVAL + 1
3387 0 : all_variables(NVAL) = 'lh'
3388 0 : all_variablesvalues(NVAL) = prefHr
3389 0 : LHIDX = NVAL
3390 : ENDIF
3391 0 : IF ( INDEX(func,'NN') > 0 ) THEN
3392 0 : NVAL = NVAL + 1
3393 0 : all_variables(NVAL) = 'nn'
3394 0 : all_variablesvalues(NVAL) = prefMn
3395 : ENDIF
3396 0 : IF ( INDEX(func,'SS') > 0 ) THEN
3397 0 : NVAL = NVAL + 1
3398 0 : all_variables(NVAL) = 'ss'
3399 0 : all_variablesvalues(NVAL) = prefS
3400 : ENDIF
3401 0 : IF ( INDEX(func,'DOY') > 0 ) THEN
3402 0 : NVAL = NVAL + 1
3403 0 : all_variables(NVAL) = 'doy'
3404 0 : all_variablesvalues(NVAL) = prefDOY
3405 : ENDIF
3406 0 : IF ( INDEX(func,'PI') > 0 ) THEN
3407 0 : NVAL = NVAL + 1
3408 0 : all_variables(NVAL) = 'pi'
3409 0 : all_variablesvalues(NVAL) = HcoState%Phys%PI
3410 : ENDIF
3411 0 : IF ( INDEX(func,'DOM') > 0 ) THEN
3412 0 : NVAL = NVAL + 1
3413 0 : all_variables(NVAL) = 'dom'
3414 0 : all_variablesvalues(NVAL) = LMD
3415 : ENDIF
3416 0 : IF ( INDEX(func,'ELH') > 0 ) THEN
3417 0 : NVAL = NVAL + 1
3418 0 : all_variables(NVAL) = 'elh'
3419 0 : all_variablesvalues(NVAL) = ELH
3420 : ENDIF
3421 0 : IF ( INDEX(func,'ELS') > 0 ) THEN
3422 0 : NVAL = NVAL + 1
3423 0 : all_variables(NVAL) = 'els'
3424 0 : all_variablesvalues(NVAL) = ELS
3425 : ENDIF
3426 :
3427 : ! Error trap: cannot have local hour and local weekday in
3428 : ! same expression
3429 0 : IF ( LHIDX > 0 .AND. LWDIDX > 0 ) THEN
3430 : MSG = 'Cannot have local hour and local weekday in '//&
3431 0 : 'same expression: '//TRIM(func)
3432 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3433 0 : RETURN
3434 : ENDIF
3435 :
3436 : ! N is the number of expressions.
3437 0 : Vals(:) = -999.0_hp
3438 0 : IF ( LHIDX > 0 ) THEN
3439 0 : N = 24
3440 0 : ELSEIF ( LWDIDX > 0 ) THEN
3441 0 : N = 7
3442 : ELSE
3443 0 : N = 1
3444 : ENDIF
3445 :
3446 : ! Evaluate expression
3447 : !Initialize function
3448 0 : call init (func, all_variables(1:NVAL), statusflag)
3449 0 : IF(statusflag == 'ok') THEN
3450 0 : DO I=1,N
3451 0 : IF ( LHIDX > 0 ) all_variablesvalues(LHIDX) = I-1
3452 0 : IF ( LWDIDX > 0 ) all_variablesvalues(LWDIDX) = I-1
3453 0 : Val = evaluate( all_variablesvalues(1:NVAL) )
3454 0 : Vals(I) = Val
3455 :
3456 : ! Verbose
3457 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN
3458 0 : WRITE(MSG,*) 'Evaluated function: ',TRIM(func),' --> ', Val
3459 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
3460 : ENDIF
3461 : ENDDO
3462 : ELSE
3463 0 : MSG = 'Error evaluation function: '//TRIM(func)
3464 0 : CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
3465 0 : RETURN
3466 : ENDIF
3467 0 : call destroyfunc()
3468 :
3469 : ! Return w/ success
3470 0 : RC = HCO_SUCCESS
3471 :
3472 : END SUBROUTINE ReadMath
3473 : !EOC
3474 : END MODULE HCOIO_Util_Mod
|