LCOV - code coverage report
Current view: top level - hemco/HEMCO/src/Core - hcoio_util_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 0 1032 0.0 %
Date: 2025-03-13 18:55:17 Functions: 0 21 0.0 %

          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

Generated by: LCOV version 1.14