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