LCOV - code coverage report
Current view: top level - hemco/HEMCO/src/Core - hco_emislist_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 0 226 0.0 %
Date: 2024-12-17 17:57:11 Functions: 0 5 0.0 %

          Line data    Source code
       1             : !------------------------------------------------------------------------------
       2             : !                   Harmonized Emissions Component (HEMCO)                    !
       3             : !------------------------------------------------------------------------------
       4             : !BOP
       5             : !
       6             : ! !MODULE: hco_emislist_mod.F90
       7             : !
       8             : ! !DESCRIPTION: Module HCO\_EmisList\_Mod contains routines and variables
       9             : ! for the HEMCO emissions list EmisList. EmisList is a sorted collection
      10             : ! of all data containers needed for emission calculation. The containers
      11             : ! are sorted by data type, species, emission category, and emission
      12             : ! hierarchy (in this order).
      13             : !\\
      14             : !\\
      15             : ! !INTERFACE:
      16             : !
      17             : MODULE HCO_EMISLIST_MOD
      18             : !
      19             : ! !USES:
      20             : !
      21             :   USE HCO_ERROR_MOD
      22             :   USE HCO_TYPES_MOD
      23             :   USE HCO_STATE_MOD,    ONLY : HCO_State
      24             : 
      25             :   IMPLICIT NONE
      26             :   PRIVATE
      27             : !
      28             : ! !PUBLIC MEMBER FUNCTIONS:
      29             : !
      30             :   PUBLIC  :: HCO_GetPtr
      31             :   PUBLIC  :: EmisList_Pass
      32             : !  PUBLIC  :: EmisList_Update
      33             : !
      34             : ! !PRIVATE MEMBER FUNCTIONS:
      35             : !
      36             :   PRIVATE :: EmisList_Add
      37             :   PRIVATE :: Add2EmisList
      38             : !
      39             : ! !REVISION HISTORY:
      40             : !  04 Dec 2012 - C. Keller   - Initialization
      41             : !  See https://github.com/geoschem/hemco for complete history
      42             : !EOP
      43             : !------------------------------------------------------------------------------
      44             : !BOC
      45             : !
      46             : ! !PRIVATE TYPES:
      47             : !
      48             :   INTERFACE HCO_GetPtr
      49             :      MODULE PROCEDURE HCO_GetPtr_2D
      50             :      MODULE PROCEDURE HCO_GetPtr_3D
      51             :   END INTERFACE HCO_GetPtr
      52             : 
      53             : CONTAINS
      54             : !EOC
      55             : !------------------------------------------------------------------------------
      56             : !                   Harmonized Emissions Component (HEMCO)                    !
      57             : !------------------------------------------------------------------------------
      58             : !BOP
      59             : !
      60             : ! !IROUTINE: EmisList_Add
      61             : !
      62             : ! !DESCRIPTION: Subroutine EmisList\_Add adds the passed data container
      63             : ! Dct to EmisList. Within EmisList, Dct becomes placed with
      64             : ! increasing data type, species ID, category and hierarchy (in this order).
      65             : !\\
      66             : !\\
      67             : ! !INTERFACE:
      68             : !
      69           0 :   SUBROUTINE EmisList_Add( Dct, HcoState, RC )
      70             : !
      71             : ! !USES:
      72             : !
      73             :     USE HCO_DATACONT_MOD,  ONLY : ListCont_Find
      74             :     USE HCO_LOGFILE_MOD,   ONLY : HCO_PrintDataCont
      75             : !
      76             : ! !INPUT PARAMETERS:
      77             : !
      78             :     TYPE(DataCont),    POINTER       :: Dct        ! Data cont.
      79             :     TYPE(HCO_State),   POINTER       :: HcoState   ! HEMCO state
      80             : !
      81             : ! !INPUT/OUTPUT PARAMETERS:
      82             : !
      83             :     INTEGER,           INTENT(INOUT) :: RC         ! Return code
      84             : !
      85             : ! !REVISION HISTORY:
      86             : !  04 Dec 2012 - C. Keller - Initial version
      87             : !  See https://github.com/geoschem/hemco for complete history
      88             : !EOP
      89             : !------------------------------------------------------------------------------
      90             : !BOC
      91             : !
      92             : ! !LOCAL ARGUMENTS:
      93             : !
      94             :     TYPE(ListCont), POINTER                 :: Lct
      95             :     LOGICAL                                 :: FOUND, VERBOSE, NEW
      96             :     CHARACTER(LEN=255)                      :: MSG, LOC
      97             :     CHARACTER(LEN= 31)                      :: TempRes
      98             : 
      99             :     !======================================================================
     100             :     ! EmisList_Add begins here!
     101             :     !======================================================================
     102           0 :     LOC = 'EmisList_Add (HCO_EMISLIST.F90)'
     103             : 
     104             :     ! Enter
     105           0 :     CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
     106           0 :     IF(RC /= HCO_SUCCESS) RETURN
     107             : 
     108             :     ! Set verbose flag
     109           0 :     VERBOSE = HCO_IsVerb( HcoState%Config%Err )
     110             : 
     111             :     ! Init
     112           0 :     Lct => NULL()
     113             : 
     114             :     ! ----------------------------------------------------------------
     115             :     ! Nothing to do if it's not a new container, i.e. if container
     116             :     ! already exists in EmisList.
     117             :     ! ----------------------------------------------------------------
     118           0 :     CALL ListCont_Find ( HcoState%EmisList, Dct%cID, 0, FOUND, Lct )
     119           0 :     IF ( FOUND ) THEN
     120           0 :        CALL HCO_LEAVE ( HcoState%Config%Err, RC )
     121           0 :        RETURN
     122             :     ENDIF
     123             : 
     124             :     ! ----------------------------------------------------------------
     125             :     ! Define new list container. This container points to the passed
     126             :     ! data container.
     127             :     ! ----------------------------------------------------------------
     128           0 :     ALLOCATE ( Lct )
     129           0 :     Lct%NextCont => NULL()
     130           0 :     IF ( .not. ASSOCIATED( Dct ) ) THEN
     131           0 :        PRINT*, '#### DCT is not associated!'
     132             :     ENDIF
     133           0 :     Lct%Dct      => Dct
     134             : 
     135             :     ! ----------------------------------------------------------------
     136             :     ! Add the new container to EmisList. The container will be placed
     137             :     ! according to data type, species ID, hierarchy, and category.
     138             :     ! ----------------------------------------------------------------
     139           0 :     CALL Add2EmisList ( HcoState, Lct, RC )
     140           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     141           0 :         CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
     142           0 :         RETURN
     143             :     ENDIF
     144             : 
     145             :     ! ----------------------------------------------------------------
     146             :     ! Verbose mode
     147             :     ! ----------------------------------------------------------------
     148           0 :     IF ( VERBOSE ) THEN
     149           0 :        MSG = 'Container added to EmisList:'
     150           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
     151           0 :        CALL HCO_PrintDataCont( HcoState, Lct%Dct )
     152             :     ENDIF
     153             : 
     154             :     ! Leave w/ success
     155           0 :     CALL HCO_LEAVE ( HcoState%Config%Err, RC )
     156             : 
     157             :   END SUBROUTINE EmisList_Add
     158             : !EOC
     159             : !------------------------------------------------------------------------------
     160             : !                   Harmonized Emissions Component (HEMCO)                    !
     161             : !------------------------------------------------------------------------------
     162             : !BOP
     163             : !
     164             : ! !IROUTINE: Add2EmisList
     165             : !
     166             : ! !DESCRIPTION: Subroutine Add2EmisList adds list container Lct to
     167             : ! EmisList. Base emission fields (Data type = 1) are sorted based on
     168             : ! species ID, category and hierarchy (for fields of same category). Scale
     169             : ! fields and masks are added to the end of EmisList.
     170             : !\\
     171             : !\\
     172             : ! !INTERFACE:
     173             : !
     174           0 :   SUBROUTINE Add2EmisList( HcoState, Lct, RC )
     175             : !
     176             : ! !INPUT PARAMETERS:
     177             : !
     178             :     TYPE(HCO_State), POINTER       :: HcoState   ! HEMCO state
     179             :     TYPE(ListCont),  POINTER       :: Lct
     180             : !
     181             : ! !INPUT/OUTPUT PARAMETERS:
     182             : !
     183             :     INTEGER,         INTENT(INOUT) :: RC
     184             : !
     185             : ! !REVISION HISTORY:
     186             : !  06 Dec 2012 - C. Keller - Initial version
     187             : !  See https://github.com/geoschem/hemco for complete history
     188             : !EOP
     189             : !------------------------------------------------------------------------------
     190             : !BOC
     191             : !
     192             : ! !LOCAL VARIABLES:
     193             : !
     194             :     ! Scalars
     195             :     INTEGER                   :: NEWCAT, NEWHIR, NEWSPC
     196             :     CHARACTER(LEN=255)        :: MSG, LOC
     197             : 
     198             :     ! Pointers
     199             :     TYPE(ListCont), POINTER   :: TmpLct => NULL()
     200             : 
     201             :     !======================================================================
     202             :     ! Add2EmisList begins here!
     203             :     !======================================================================
     204           0 :     LOC = 'Add2EmisList (HCO_EMISLIST_MOD.F90)'
     205             : 
     206             :     ! Enter
     207           0 :     CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
     208           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     209           0 :         CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
     210           0 :         RETURN
     211             :     ENDIF
     212             : 
     213             :     ! Update number of containers in EmisList
     214           0 :     HcoState%nnEmisCont = HcoState%nnEmisCont + 1
     215             : 
     216             :     ! Flag the content of this container as being used in EmisList
     217           0 :     Lct%Dct%Dta%IsInList = .TRUE.
     218             : 
     219             :     ! If this is the first container, we can simply place it at the
     220             :     ! beginning of the list.
     221           0 :     IF ( HcoState%nnEmisCont == 1 ) THEN
     222           0 :        HcoState%EmisList => Lct
     223           0 :        CALL HCO_LEAVE( HcoState%Config%Err, RC )
     224           0 :        RETURN ! Leave routine
     225             :     ENDIF
     226             : 
     227             :     ! Special case where the linked list consists of scale factors
     228             :     ! only: In this case, we can place the new container at the
     229             :     ! beginning no matter of its content!
     230           0 :     IF ( HcoState%EmisList%Dct%DctType /= HCO_DCTTYPE_BASE ) THEN
     231           0 :        Lct%NextCont      => HcoState%EmisList
     232           0 :        HcoState%EmisList => Lct
     233           0 :        CALL HCO_LEAVE( HcoState%Config%Err, RC )
     234           0 :        RETURN
     235             :     ENDIF
     236             : 
     237             :     ! Get field species ID, category and priority of the new container
     238           0 :     NEWSPC  = Lct%Dct%HcoID
     239           0 :     NEWCAT  = Lct%Dct%Cat
     240           0 :     NEWHIR  = Lct%Dct%Hier
     241             : 
     242             :     ! Containers are listed with increasing species ID. If the current
     243             :     ! container has lower speciesID than the first container, just add
     244             :     ! it at the beginning of the list.
     245           0 :     IF ( (NEWSPC > 0) .AND. (NEWSPC < HcoState%EmisList%Dct%HcoID) ) THEN
     246           0 :        Lct%NextCont      => HcoState%EmisList
     247           0 :        HcoState%EmisList => Lct
     248           0 :        CALL HCO_LEAVE( HcoState%Config%Err, RC )
     249           0 :        RETURN
     250             :     ENDIF
     251             : 
     252             :     ! In case that the current container has the same species ID
     253             :     ! as the first container in the list: If this container has
     254             :     ! lower category, or same category and lower hierarchy, place
     255             :     ! it before the first container in the list:
     256           0 :     IF ( NEWSPC == HcoState%EmisList%Dct%HcoID ) THEN
     257           0 :        IF ( (HcoState%EmisList%Dct%Cat  >  NEWCAT) .OR.  &
     258             :             (HcoState%EmisList%Dct%Cat  == NEWCAT  .AND. &
     259             :              HcoState%EmisList%Dct%Hier >  NEWHIR)        ) THEN
     260           0 :           Lct%NextCont      => HcoState%EmisList
     261           0 :           HcoState%EmisList => Lct
     262           0 :           CALL HCO_LEAVE( HcoState%Config%Err, RC )
     263           0 :           RETURN
     264             :        ENDIF
     265             :     ENDIF
     266             : 
     267             :     ! TmpLct is the temporary working pointer, looping through
     268             :     ! the entire EmisList until the correct place for the new
     269             :     ! container is found.
     270           0 :     TmpLct => HcoState%EmisList
     271             : 
     272             :     ! If the new container contains base data (i.e. data type is 1)
     273             :     ! we have to move the TmpLct pointer to the position where the
     274             :     ! next container is also a base container and one of the
     275             :     ! following: (a) the first container with the same species ID
     276             :     ! as the new container; (b) a container with higher species ID;
     277             :     ! (c) scale factors. From there, we can determine where to place
     278             :     ! the container exactly.
     279           0 :     IF ( Lct%Dct%DctType == HCO_DCTTYPE_BASE ) THEN
     280             : 
     281             :        ! Loop over list
     282           0 :        DO WHILE ( ASSOCIATED ( TmpLct%NextCont ) )
     283             : 
     284             :           ! Check if next container's species ID is higher or if it's a
     285             :           ! scale factor, in which case we have to exit.
     286           0 :           IF ( TmpLct%NextCont%Dct%HcoID   >  NEWSPC          .OR. &
     287             :                TmpLct%NextCont%Dct%DctType /= HCO_DCTTYPE_BASE      ) THEN
     288             :              EXIT
     289             :           ENDIF
     290             : 
     291             :           ! Check if next container has the same species ID but a
     292             :           ! higher category or the same category but higher hierarchy,
     293             :           ! in which case we have to exit.
     294           0 :           IF ( TmpLct%NextCont%Dct%HcoID == NEWSPC ) THEN
     295           0 :              IF ( TmpLct%NextCont%Dct%Cat > NEWCAT ) THEN
     296             :                 EXIT
     297             :              ENDIF
     298           0 :              IF ( TmpLct%NextCont%Dct%Cat  == NEWCAT .AND. &
     299             :                   TmpLct%NextCont%Dct%Hier >  NEWHIR        ) THEN
     300             :                 EXIT
     301             :              ENDIF
     302             :           ENDIF
     303             : 
     304             :           ! Advance in list if none of the above checks was true.
     305           0 :           TmpLct => TmpLct%NextCont
     306             :        ENDDO
     307             : 
     308             :     ! Scale factors and masks are collected at the end of the list.
     309             :     ! Hence, make TmpLct pointer point to the last container w/ base
     310             :     ! emissions (or the last container in the list).
     311             :     ELSE
     312             : 
     313             :        ! Loop over list
     314           0 :        DO WHILE ( ASSOCIATED ( TmpLct%NextCont ) )
     315             : 
     316             :           ! Check if next container is scale factor
     317           0 :           IF ( TmpLct%NextCont%Dct%DctType /= HCO_DCTTYPE_BASE ) EXIT
     318             : 
     319             :           ! Advance in list
     320           0 :           TmpLct => TmpLct%NextCont
     321             :        ENDDO
     322             : 
     323             :     ENDIF
     324             : 
     325             :     ! Add new container AFTER current one
     326           0 :     Lct%NextCont    => TmpLct%NextCont
     327           0 :     TmpLct%NextCont => Lct
     328             : 
     329             :     ! Cleanup and leave
     330           0 :     TmpLct => NULL()
     331           0 :     CALL HCO_LEAVE( HcoState%Config%Err, RC )
     332             : 
     333             :   END SUBROUTINE Add2EmisList
     334             : !EOC
     335             : !!------------------------------------------------------------------------------
     336             : !!                   Harmonized Emissions Component (HEMCO)                    !
     337             : !!------------------------------------------------------------------------------
     338             : !!BOP
     339             : !!
     340             : !! !IROUTINE: EmisList_Update
     341             : !!
     342             : !! !DESCRIPTION: Subroutine EmisList\_Update makes sure that all containers
     343             : !! of the reading list ReadList are correctly referenced in emissions list
     344             : !! EmisList. If a container of ReadList does not yet have a corresponding
     345             : !! container in EmisList, such a container is created. Also, additive data
     346             : !! arrays (i.e. targetID different than container ID) are added to their
     347             : !! target array during this call.
     348             : !!\\
     349             : !!\\
     350             : !! !INTERFACE:
     351             : !!
     352             : !  SUBROUTINE EmisList_Update ( HcoState, ReadList, RC )
     353             : !!
     354             : !! !USES:
     355             : !!
     356             : !    USE HCO_FILEDATA_MOD, ONLY : FileData_ArrIsDefined
     357             : !!
     358             : !! !INPUT PARAMETERS:
     359             : !!
     360             : !    TYPE(HCO_State), POINTER       :: HcoState   ! Hemco state object
     361             : !    TYPE(ListCont),  POINTER       :: ReadList   ! reading list
     362             : !!
     363             : !! !INPUT/OUTPUT PARAMETERS:
     364             : !!
     365             : !    INTEGER,         INTENT(INOUT) :: RC         ! Return code
     366             : !!
     367             : !! !REVISION HISTORY:
     368             : !!  20 Apr 2013 - C. Keller - Initial version
     369             : !!  See https://github.com/geoschem/hemco for complete history
     370             : !!EOP
     371             : !!------------------------------------------------------------------------------
     372             : !!BOC
     373             : !!
     374             : !! !LOCAL VARIABLES:
     375             : !!
     376             : !    ! Scalars
     377             : !    INTEGER                     :: cID, iScalID
     378             : !    INTEGER                     :: I
     379             : !    CHARACTER(LEN=31)           :: ScalName
     380             : !
     381             : !    ! Pointers
     382             : !    TYPE(ListCont), POINTER     :: TmpLct => NULL()
     383             : !
     384             : !    ! ================================================================
     385             : !    ! EmisList_Update begins here
     386             : !    ! ================================================================
     387             : !
     388             : !    ! Enter
     389             : !    CALL HCO_ENTER ( HcoState%Config%Err, 'EmisList_Update', RC )
     390             : !    IF ( RC /= HCO_SUCCESS ) RETURN
     391             : !
     392             : !    ! Loop over all containers in ReadList
     393             : !    TmpLct => ReadList
     394             : !    DO WHILE ( ASSOCIATED( TmpLct ) )
     395             : !
     396             : !       ! only if array is defined...
     397             : !       IF ( FileData_ArrIsDefined(TmpLct%Dct%Dta) ) THEN
     398             : !
     399             : !          ! Pass container to EmisList
     400             : !          CALL EmisList_Pass( HcoState, TmpLct, RC )
     401             : !          IF ( RC /= HCO_SUCCESS ) RETURN
     402             : !       ENDIF
     403             : !
     404             : !       ! Advance to next container in ReadList
     405             : !       TmpLct => TmpLct%NextCont
     406             : !    ENDDO
     407             : !
     408             : !    ! Leave w/ success
     409             : !    CALL HCO_LEAVE ( HcoState%Config%Err, RC )
     410             : !
     411             : !  END SUBROUTINE EmisList_Update
     412             : !!EOC
     413             : !------------------------------------------------------------------------------
     414             : !                   Harmonized Emissions Component (HEMCO)                    !
     415             : !------------------------------------------------------------------------------
     416             : !BOP
     417             : !
     418             : ! !IROUTINE: EmisList_Pass
     419             : !
     420             : ! !DESCRIPTION: Subroutine EmisList\_Pass passes (the ReadList)
     421             : ! container Lct to EmisList. This routine mostly checks for
     422             : ! additive arrays, i.e. if arrays from multiple containers have
     423             : ! to be added together prior to emission calculation (e.g. sectoral
     424             : ! data).
     425             : !\\
     426             : !\\
     427             : ! !INTERFACE:
     428             : !
     429           0 :   SUBROUTINE EmisList_Pass( HcoState, Lct, RC )
     430             : !
     431             : ! !USES:
     432             : !
     433             :     USE HCO_DATACONT_MOD, ONLY : ListCont_Find
     434             :     USE HCO_FILEDATA_MOD, ONLY : FileData_ArrCheck
     435             : !
     436             : ! !INPUT PARAMETERS:
     437             : !
     438             :     TYPE(HCO_State),  POINTER       :: HcoState
     439             :     TYPE(ListCont),   POINTER       :: Lct        ! list container
     440             : !
     441             : ! !INPUT/OUTPUT PARAMETERS:
     442             : !
     443             :     INTEGER,          INTENT(INOUT) :: RC         ! Success
     444             : !
     445             : ! !REVISION HISTORY:
     446             : !  28 Mar 2013 - C. Keller - Initial version
     447             : !  See https://github.com/geoschem/hemco for complete history
     448             : !EOP
     449             : !------------------------------------------------------------------------------
     450             : !BOC
     451             : !
     452             : ! !LOCAL VARIABLES:
     453             : !
     454             :     ! Pointers
     455             :     TYPE(ListCont),  POINTER  :: TargetLct
     456             : 
     457             :     ! Scalars
     458             :     INTEGER                   :: I, J, L, T
     459             :     LOGICAL                   :: FOUND, verb, Add
     460             :     CHARACTER(LEN=255)        :: MSG, LOC
     461             : 
     462             :     ! ================================================================
     463             :     ! EmisList_Pass begins here
     464             :     ! ================================================================
     465           0 :     LOC = 'EmisList_Pass (HCO_EMISLIST_MOD.F90)'
     466             : 
     467             :     ! Enter
     468           0 :     CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC )
     469           0 :     IF(RC /= HCO_SUCCESS) RETURN
     470             : 
     471             :     ! Init
     472           0 :     TargetLct => NULL()
     473             : 
     474             :     ! Verbose mode
     475           0 :     verb = HCO_IsVerb( HcoState%Config%Err )
     476             : 
     477             :     ! Initialize Add flag. This fill only be set to FALSE
     478             :     ! if the data of the current container is added to the data of
     479             :     ! an existing container in EmisList instead of adding the container
     480             :     ! alltogether.
     481           0 :     Add = .TRUE.
     482             : 
     483             :     ! ----------------------------------------------------------------
     484             :     ! Add data arrays if required
     485             :     ! ----------------------------------------------------------------
     486             : 
     487             :     ! The target ID of a container denotes the ID (cID) of the
     488             :     ! container to which the data shall be added. For example, if
     489             :     ! container 1 has a target ID of 5, its content will be added to
     490             :     ! container 5.
     491             :     ! Usually, the targetID is equal to cID and we don't have to do
     492             :     ! anything. If tID /= cID, however, the array is added to the
     493             :     ! array of the specified target container and removed afterwards
     494             :     ! from the original container.
     495             :     ! Note: arrays can only be added to each other if they are for the
     496             :     ! same species, have same dimensions, update frequencies, scale
     497             :     ! factors, categories, hierarchies, data types, etc.
     498             :     ! Note2: in an ESMF environment, this option is disabled (targetID
     499             :     ! is always equal to cID).
     500           0 :     IF ( Lct%Dct%targetID /= Lct%Dct%cID ) THEN
     501             : 
     502             :        ! TargetLct points to the container holding the target array
     503             :        CALL ListCont_Find( HcoState%EmisList, Lct%Dct%targetID, &
     504           0 :                            0, FOUND, TargetLct )
     505           0 :        IF ( .NOT. FOUND ) THEN
     506             :           MSG = 'Cannot add emissions to target array: error in ' // &
     507           0 :                TRIM(Lct%Dct%cName)
     508           0 :           CALL HCO_ERROR( MSG, RC )
     509           0 :           RETURN
     510             :        ENDIF
     511             : 
     512             :        ! Do not add data if the current data container is not the
     513             :        ! 'home' container for the data object Dta. Dta may be used
     514             :        ! by multiple containers, and only the home container should
     515             :        ! modify its content!
     516           0 :        IF ( Lct%Dct%DtaHome /= 1 ) THEN
     517             : 
     518             :           ! Verbose mode
     519           0 :           IF ( verb ) THEN
     520           0 :              WRITE(MSG,*) 'Do not add data of ', TRIM(Lct%Dct%cName), &
     521           0 :                   ' to ', TRIM(TargetLct%Dct%cName), ' because this', &
     522           0 :                   ' is not the file data home container!'
     523           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
     524             :           ENDIF
     525             : 
     526             :        ! Similarly, do not add data to target container if the target
     527             :        ! container is being shared by multiple containers.
     528           0 :        ELSEIF ( TargetLct%Dct%Dta%DoShare ) THEN
     529             : 
     530             :           ! Verbose mode
     531           0 :           IF ( verb ) THEN
     532           0 :              WRITE(MSG,*) 'Do not add data of ', TRIM(Lct%Dct%cName), &
     533           0 :                   ' to ', TRIM(TargetLct%Dct%cName), ' because the', &
     534           0 :                   ' target is being shared with other fields!'
     535           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
     536             :           ENDIF
     537             : 
     538             :        ELSE
     539             : 
     540             :           ! Check extension number
     541           0 :           IF ( Lct%Dct%ExtNr /= TargetLct%Dct%ExtNr ) THEN
     542           0 :              MSG = 'Wrong ext. number: ' // TRIM(Lct%Dct%cName)
     543           0 :              CALL HCO_ERROR( MSG, RC )
     544           0 :              RETURN
     545             :           ENDIF
     546             : 
     547             :           ! Check data type
     548           0 :           IF ( Lct%Dct%DctType /= TargetLct%Dct%DctType ) THEN
     549           0 :              MSG = 'Wrong data type: ' // TRIM(Lct%Dct%cName)
     550           0 :              CALL HCO_ERROR( MSG, RC )
     551           0 :              RETURN
     552             :           ENDIF
     553             : 
     554             :           ! Check species ID
     555           0 :           IF ( Lct%Dct%HcoID /= TargetLct%Dct%HcoID ) THEN
     556           0 :              MSG = 'Wrong species ID: ' // TRIM(Lct%Dct%cName)
     557           0 :              CALL HCO_ERROR( MSG, RC )
     558           0 :              RETURN
     559             :           ENDIF
     560             : 
     561             :           ! Check for array dimensions
     562           0 :           IF ( Lct%Dct%Dta%SpaceDim /= TargetLct%Dct%Dta%SpaceDim ) THEN
     563           0 :              MSG = 'Wrong space dimension: ' // TRIM(Lct%Dct%cName)
     564           0 :              CALL HCO_ERROR( MSG, RC )
     565           0 :              RETURN
     566             :           ENDIF
     567           0 :           IF ( Lct%Dct%Dta%nt /= TargetLct%Dct%Dta%nt ) THEN
     568           0 :              MSG = 'Wrong time dim: ' // TRIM(Lct%Dct%cName)
     569           0 :              CALL HCO_ERROR( MSG, RC )
     570           0 :              RETURN
     571             :           ENDIF
     572           0 :           IF ( Lct%Dct%Dta%SpaceDim <= 2) THEN
     573           0 :              I = SIZE(Lct%Dct%Dta%V2(1)%Val,1)
     574           0 :              J = SIZE(Lct%Dct%Dta%V2(1)%Val,2)
     575             :              CALL FileData_ArrCheck( HcoState%Config, &
     576             :                                      TargetLct%Dct%Dta, I, J, &
     577           0 :                                      Lct%Dct%Dta%nt, RC )
     578           0 :              IF ( RC /= 0 ) THEN
     579           0 :                 MSG = 'Wrong 2D array: ' // TRIM(Lct%Dct%cName)
     580           0 :                 CALL HCO_MSG(HcoState%Config%Err,MSG)
     581           0 :                 RETURN
     582             :              ENDIF
     583             :           ELSE
     584           0 :              I = SIZE(Lct%Dct%Dta%V3(1)%Val,1)
     585           0 :              J = SIZE(Lct%Dct%Dta%V3(1)%Val,2)
     586           0 :              L = SIZE(Lct%Dct%Dta%V3(1)%Val,3)
     587             :              CALL FileData_ArrCheck( HcoState%Config, &
     588             :                                      TargetLct%Dct%Dta, I, J, L, &
     589           0 :                                      Lct%Dct%Dta%nt, RC )
     590           0 :              IF ( RC /= 0 ) THEN
     591           0 :                 MSG = 'Wrong 3D array: ' // TRIM(Lct%Dct%cName)
     592           0 :                 CALL HCO_MSG(HcoState%Config%Err,MSG)
     593           0 :                 RETURN
     594             :              ENDIF
     595             :           ENDIF
     596             : 
     597             :           ! Check operator
     598           0 :           IF ( Lct%Dct%Oper /= TargetLct%Dct%Oper ) THEN
     599           0 :              MSG = 'Wrong operator: ' // TRIM(Lct%Dct%cName)
     600           0 :              CALL HCO_ERROR( MSG, RC )
     601           0 :              RETURN
     602             :           ENDIF
     603             : 
     604             :           ! Check category
     605           0 :           IF ( Lct%Dct%Cat /= TargetLct%Dct%Cat ) THEN
     606           0 :              MSG = 'Wrong category: ' // TRIM(Lct%Dct%cName)
     607           0 :              CALL HCO_ERROR( MSG, RC )
     608           0 :              RETURN
     609             :           ENDIF
     610             : 
     611             :           ! Check hierarchy
     612           0 :           IF ( Lct%Dct%Hier /= TargetLct%Dct%Hier ) THEN
     613           0 :              MSG = 'Wrong hierarchy: ' // TRIM(Lct%Dct%cName)
     614           0 :              CALL HCO_ERROR( MSG, RC )
     615           0 :              RETURN
     616             :           ENDIF
     617             : 
     618             :           ! Error check: cannot add masks if operator is 3
     619           0 :           IF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK .AND. &
     620             :                Lct%Dct%Oper    == 3                       ) THEN
     621             :              MSG = 'Cannot add masks if operator is 3: ' // &
     622           0 :                   TRIM(Lct%Dct%cName)
     623           0 :              CALL HCO_ERROR( MSG, RC )
     624           0 :              RETURN
     625             :           ENDIF
     626             : 
     627             :           ! If all checks were successful, add current array to
     628             :           ! target array.
     629           0 :           DO I = 1, TargetLct%Dct%Dta%nt
     630           0 :              IF ( TargetLct%Dct%Dta%SpaceDim <= 2 ) THEN
     631             :                 TargetLct%Dct%Dta%V2(I)%Val = &
     632           0 :                      TargetLct%Dct%Dta%V2(I)%Val + Lct%Dct%Dta%V2(I)%Val
     633             :              ELSE
     634             :                 TargetLct%Dct%Dta%V3(I)%Val = &
     635           0 :                      TargetLct%Dct%Dta%V3(I)%Val + Lct%Dct%Dta%V3(I)%Val
     636             :              ENDIF
     637             :           ENDDO
     638           0 :           IF ( verb ) THEN
     639           0 :              WRITE(MSG,*) 'Added data of ',   TRIM(Lct%Dct%cName), &
     640           0 :                   ' to ', TRIM(TargetLct%Dct%cName)
     641           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
     642             :           ENDIF
     643             : 
     644             :           ! This container does not need to be added to the emissions
     645             :           ! list
     646             :           Add = .FALSE.
     647             : 
     648             :        ENDIF
     649             :     ENDIF ! cID /= targetID
     650             : 
     651             :     ! ----------------------------------------------------------------
     652             :     ! Add/update emissions linked list container.
     653             :     ! Only add those containers that are effectively used in the
     654             :     ! emissions list, i.e. ignore the containers whose content
     655             :     ! has been added to another container (targetID /= cID). Those
     656             :     ! containers are not needed for emission calculation since its
     657             :     ! content is now stored in another container.
     658             :     ! The EmisList_Add call will set the IsInList flag of the given
     659             :     ! file data object (Lct%Dct%Dta) to TRUE, denoting that this file
     660             :     ! data object is used in EmisList. The data arrays of all file
     661             :     ! data objects that are not used in EmisList are removed in a
     662             :     ! second step of the ReadList_Read call.
     663             :     ! ----------------------------------------------------------------
     664             :     IF ( Add ) THEN
     665           0 :        CALL EmisList_Add( Lct%Dct, HcoState, RC )
     666           0 :        IF ( RC /= HCO_SUCCESS ) THEN
     667           0 :            CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
     668           0 :            RETURN
     669             :        ENDIF
     670             :     ENDIF
     671             : 
     672             :     ! ----------------------------------------------------------------
     673             :     ! Return
     674             :     ! ----------------------------------------------------------------
     675           0 :     CALL HCO_LEAVE( HcoState%Config%Err, RC )
     676             : 
     677             :   END SUBROUTINE EmisList_Pass
     678             : !EOC
     679             : !------------------------------------------------------------------------------
     680             : !                   Harmonized Emissions Component (HEMCO)                    !
     681             : !------------------------------------------------------------------------------
     682             : !BOP
     683             : !
     684             : ! !IROUTINE: HCO_GetPtr_3D
     685             : !
     686             : ! !DESCRIPTION: Subroutine HCO\_GetPtr\_3D returns the 3D data pointer
     687             : ! Ptr3D of EmisList that is associated with data container DctName. By
     688             : ! default, the routine returns an error if the given container name is
     689             : ! not found. This can be avoided by calling the routine with the optional
     690             : ! argument FOUND, in which case only this argument will be set to FALSE.
     691             : ! Similarly, the FILLED flag can be used to control the behaviour if the
     692             : ! data container is found but empty, e.g. no data is associated with it.
     693             : !\\
     694             : !\\
     695             : ! This routine returns the unevaluated data field, e.g. no scale factors
     696             : ! or masking is applied to the data. Use routine HCO\_EvalFld in
     697             : ! hco\_calc\_mod.F90 to get evaluated fields.
     698             : !\\
     699             : !\\
     700             : ! !INTERFACE:
     701             : !
     702           0 :   SUBROUTINE HCO_GetPtr_3D( HcoState, DctName, Ptr3D, &
     703             :                             RC, TIDX, FOUND, FILLED )
     704             : !
     705             : ! !USES:
     706             : !
     707             :     USE HCO_DATACONT_MOD, ONLY : ListCont_Find
     708             : !
     709             : ! !INPUT PARAMETERS:
     710             : !
     711             :     TYPE(HCO_State),  POINTER               :: HcoState       ! HEMCO state obj
     712             :     CHARACTER(LEN=*), INTENT(IN   )         :: DctName        ! container name
     713             :     INTEGER,          INTENT(IN), OPTIONAL  :: TIDX           ! time index
     714             : !                                                             ! (default=1)
     715             : ! !OUTPUT PARAMETERS:
     716             : !
     717             :     REAL(sp),         POINTER               :: Ptr3D(:,:,:)   ! output array
     718             :     LOGICAL,          INTENT(OUT), OPTIONAL :: FOUND          ! cont. found?
     719             :     LOGICAL,          INTENT(OUT), OPTIONAL :: FILLED         ! array filled?
     720             : !
     721             : ! !INPUT/OUTPUT PARAMETERS:
     722             : !
     723             :     INTEGER,          INTENT(INOUT)         :: RC             ! Success/fail
     724             : !
     725             : ! !REVISION HISTORY:
     726             : !  04 Sep 2013 - C. Keller - Initial version
     727             : !  See https://github.com/geoschem/hemco for complete history
     728             : !EOP
     729             : !------------------------------------------------------------------------------
     730             : !BOC
     731             : !
     732             : ! !LOCAL VARIABLES:
     733             : !
     734             :     ! Scalars
     735             :     INTEGER                    :: T
     736             :     LOGICAL                    :: FND
     737             :     CHARACTER(LEN=255)         :: MSG, LOC
     738             : 
     739             :     ! Pointers
     740             :     TYPE(ListCont), POINTER    :: Lct
     741             : 
     742             :     !=================================================================
     743             :     ! HCO_GetPtr_3D BEGINS HERE
     744             :     !=================================================================
     745             : 
     746             :     ! Enter
     747           0 :     LOC = 'HCO_GetPtr_3D (hco_emislist_mod.F90)'
     748             : 
     749             :     ! Init
     750           0 :     Lct => NULL()
     751             : 
     752             :     ! Define time index to use
     753           0 :     IF ( PRESENT(TIDX) ) THEN
     754           0 :        T = TIDX
     755             :     ELSE
     756             :        T = 1
     757             :     ENDIF
     758             : 
     759             :     ! Init
     760           0 :     IF ( PRESENT(FILLED) ) FILLED = .FALSE.
     761             : 
     762             :     ! Search for container in emissions linked list
     763           0 :     CALL ListCont_Find ( HcoState%EmisList, TRIM(DctName), FND, Lct )
     764           0 :     IF ( PRESENT(FOUND) ) FOUND = FND
     765             : 
     766             :     ! Check if found. If optional argument FOUND is defined, don't
     767             :     ! return an error if container not found but only pass the FOUND
     768             :     ! argument to the caller routine. Otherwise, exit with error.
     769           0 :     IF ( .NOT. FND ) THEN
     770           0 :        IF ( PRESENT(FOUND) .OR. PRESENT(FILLED) ) THEN
     771           0 :           Ptr3D => NULL()
     772           0 :           RC    = HCO_SUCCESS
     773           0 :           RETURN
     774             :        ELSE
     775           0 :           MSG = 'Container not found: ' // TRIM(DctName)
     776           0 :           CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     777           0 :           RETURN
     778             :        ENDIF
     779             :     ENDIF
     780             : 
     781             :     ! Check spatial dimension
     782           0 :     IF ( Lct%Dct%Dta%SpaceDim /= 3 ) THEN
     783           0 :        MSG = 'Container is not 3D: ' // TRIM(DctName)
     784           0 :        CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     785           0 :        RETURN
     786             :     ENDIF
     787             : 
     788             :     ! Check time dimension
     789           0 :     IF ( Lct%Dct%Dta%nt < T ) THEN
     790           0 :        MSG = 'not enough time slices: ' // TRIM(DctName)
     791           0 :        CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     792           0 :        RETURN
     793             :     ENDIF
     794             : 
     795           0 :     IF ( ASSOCIATED( Lct%Dct%Dta%V3 ) ) THEN
     796           0 :        Ptr3D => Lct%Dct%Dta%V3(T)%Val
     797           0 :        IF ( PRESENT( FILLED ) ) FILLED = .TRUE.
     798             :     ELSE
     799           0 :        IF ( PRESENT( FILLED ) ) THEN
     800           0 :           Ptr3D  => NULL()
     801             :        ELSE
     802           0 :           MSG = 'Container data not filled: ' // TRIM(DctName)
     803           0 :           CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     804           0 :           RETURN
     805             :        ENDIF
     806             :     ENDIF
     807             : 
     808             :     ! Leave w/ success
     809           0 :     RC = HCO_SUCCESS
     810             : 
     811             :   END SUBROUTINE HCO_GetPtr_3D
     812             : !EOC
     813             : !------------------------------------------------------------------------------
     814             : !                   Harmonized Emissions Component (HEMCO)                    !
     815             : !------------------------------------------------------------------------------
     816             : !BOP
     817             : !
     818             : ! !IROUTINE: HCO_GetPtr_2D
     819             : !
     820             : ! !DESCRIPTION: Subroutine HCO\_GetPtr\_2D returns the 2D data pointer
     821             : ! Ptr2D of EmisList that is associated with data container DctName. See
     822             : ! HCO\_GetPtr\_3D for more details.
     823             : !\\
     824             : !\\
     825             : ! !INTERFACE:
     826             : !
     827           0 :   SUBROUTINE HCO_GetPtr_2D( HcoState, DctName, Ptr2D, &
     828             :                             RC, TIDX, FOUND, FILLED )
     829             : !
     830             : ! !USES:
     831             : !
     832             :     USE HCO_DATACONT_MOD, ONLY : ListCont_Find
     833             : !
     834             : ! !INPUT PARAMETERS:
     835             : !
     836             :     TYPE(HCO_State),  POINTER               :: HcoState    ! HEMCO state obj
     837             :     CHARACTER(LEN=*), INTENT(IN   )         :: DctName     ! container name
     838             :     INTEGER,          INTENT(IN), OPTIONAL  :: TIDX        ! time index
     839             : !                                                          ! (default=1)
     840             : ! !OUTPUT PARAMETERS:
     841             : !
     842             :     REAL(sp),         POINTER               :: Ptr2D(:,:)  ! output array
     843             :     LOGICAL,          INTENT(OUT), OPTIONAL :: FOUND       ! cont. found?
     844             :     LOGICAL,          INTENT(OUT), OPTIONAL :: FILLED      ! array filled?
     845             : !
     846             : ! !INPUT/OUTPUT PARAMETERS:
     847             : !
     848             :     INTEGER,          INTENT(INOUT)         :: RC          ! Success/fail
     849             : !
     850             : ! !REVISION HISTORY:
     851             : !  04 Sep 2013 - C. Keller - Initial version
     852             : !  See https://github.com/geoschem/hemco for complete history
     853             : !EOP
     854             : !------------------------------------------------------------------------------
     855             : !BOC
     856             : !
     857             : ! !LOCAL VARIABLES:
     858             : !
     859             :     ! Scalars
     860             :     INTEGER                    :: T
     861             :     LOGICAL                    :: FND
     862             :     CHARACTER(LEN=255)         :: MSG, LOC
     863             : 
     864             :     ! Pointers
     865             :     TYPE(ListCont), POINTER    :: Lct
     866             : 
     867             :     !=================================================================
     868             :     ! HCO_GetPtr_2D BEGINS HERE
     869             :     !=================================================================
     870             : 
     871             :     ! Enter
     872           0 :     LOC = 'HCO_GetPtr_2D (hco_emislist_mod.F90)'
     873           0 :     Lct => NULL()
     874             : 
     875             :     ! Define time index to use
     876           0 :     IF ( PRESENT(TIDX) )THEN
     877           0 :        T = TIDX
     878             :     ELSE
     879             :        T = 1
     880             :     ENDIF
     881             : 
     882             :     ! Init
     883           0 :     IF ( PRESENT(FILLED) ) FILLED = .FALSE.
     884             : 
     885             :     ! Search for container in emissions linked list
     886           0 :     CALL ListCont_Find( HcoState%EmisList, TRIM(DctName), FND, Lct )
     887           0 :     IF ( PRESENT(FOUND) ) FOUND = FND
     888             : 
     889             :     ! Check if found. If optional argument FOUND is defined, don't
     890             :     ! return an error if container not found but only pass the FOUND
     891             :     ! argument to the caller routine. Otherwise, exit with error.
     892           0 :     IF ( .NOT. FND ) THEN
     893           0 :        IF ( PRESENT(FOUND) .OR. PRESENT(FILLED) ) THEN
     894           0 :           Ptr2D => NULL()
     895           0 :           RC    = HCO_SUCCESS
     896           0 :           RETURN
     897             :        ELSE
     898           0 :           MSG = 'Container not found: ' // TRIM(DctName)
     899           0 :           CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     900           0 :           RETURN
     901             :        ENDIF
     902             :     ENDIF
     903             : 
     904             :     ! Check spatial dimension
     905           0 :     IF ( (Lct%Dct%Dta%SpaceDim/=2) .AND. &
     906             :          (Lct%Dct%Dta%SpaceDim/=1)        ) THEN
     907           0 :        MSG = 'Container is not 2D: ' // TRIM(DctName)
     908           0 :        CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     909           0 :        RETURN
     910             :     ENDIF
     911             : 
     912             :     ! Check time dimension
     913           0 :     IF ( Lct%Dct%Dta%nt < T ) THEN
     914           0 :        MSG = 'not enough time slices: ' // TRIM(DctName)
     915           0 :        CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     916           0 :        RETURN
     917             :     ENDIF
     918             : 
     919           0 :     IF ( ASSOCIATED( Lct%Dct%Dta%V2 ) ) THEN
     920           0 :        Ptr2D => Lct%Dct%Dta%V2(T)%Val
     921           0 :        IF ( PRESENT( FILLED ) ) FILLED = .TRUE.
     922             :     ELSE
     923           0 :        IF ( PRESENT( FILLED ) ) THEN
     924           0 :           Ptr2D  => NULL()
     925             :        ELSE
     926           0 :           MSG = 'Container data not filled: ' // TRIM(DctName)
     927           0 :           CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
     928           0 :           RETURN
     929             :        ENDIF
     930             :     ENDIF
     931             : 
     932             :     ! Return w/ success
     933           0 :     RC = HCO_SUCCESS
     934             : 
     935             :   END SUBROUTINE HCO_GetPtr_2D
     936             : !EOC
     937             : END MODULE HCO_EMISLIST_MOD

Generated by: LCOV version 1.14