LCOV - code coverage report
Current view: | top level - hemco/HEMCO/src/Extensions - hcox_custom_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 152 | 0.0 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 0 | 8 | 0.0 %

              Line data    Source code
           1             : !------------------------------------------------------------------------------
           2             : !                   Harmonized Emissions Component (HEMCO)                    !
           3             : !------------------------------------------------------------------------------
           4             : !BOP
           5             : !
           6             : ! !MODULE: hcox_custom_mod.F90
           7             : !
           8             : ! !DESCRIPTION: Customizable HEMCO emission extension.
           9             : !\\
          10             : !\\
          11             : ! !INTERFACE:
          12             : !
          13             : MODULE HCOX_Custom_Mod
          14             : !
          15             : ! !USES:
          16             : !
          17             :   USE HCO_Error_MOD
          18             :   USE HCO_Diagn_MOD
          19             :   USE HCOX_State_MOD, ONLY : Ext_State
          20             :   USE HCO_State_MOD,  ONLY : HCO_State
          21             :
          22             :   IMPLICIT NONE
          23             :   PRIVATE
          24             : !
          25             : ! !PUBLIC MEMBER FUNCTIONS:
          26             : !
          27             :   PUBLIC :: HCOX_Custom_Run
          28             :   PUBLIC :: HCOX_Custom_Init
          29             :   PUBLIC :: HCOX_Custom_Final
          30             : !
          31             : ! !REVISION HISTORY:
          32             : !  13 Dec 2013 - C. Keller   - Initial version
          33             : !  See https://github.com/geoschem/hemco for complete history
          34             : !EOP
          35             : !------------------------------------------------------------------------------
          36             : !BOC
          37             : !
          38             : ! !MODULE VARIABLES:
          39             : !
          40             :   TYPE :: MyInst
          41             :    INTEGER                         :: Instance
          42             :    INTEGER                         :: ExtNr   = -1
          43             :    INTEGER                         :: nOcWind = -1
          44             :    INTEGER                         :: nIceSrc = -1
          45             :    INTEGER,      POINTER           :: OcWindIDs(:)
          46             :    INTEGER,      POINTER           :: IceSrcIDs(:)
          47             :    TYPE(MyInst), POINTER           :: NextInst => NULL()
          48             :   END TYPE MyInst
          49             :
          50             :   ! Pointer to instances
          51             :   TYPE(MyInst), POINTER            :: AllInst => NULL()
          52             :
          53             : CONTAINS
          54             : !EOC
          55             : !------------------------------------------------------------------------------
          56             : !                   Harmonized Emissions Component (HEMCO)                    !
          57             : !------------------------------------------------------------------------------
          58             : !BOP
          59             : !
          60             : ! !IROUTINE: HCOX_Custom_Run
          61             : !
          62             : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Run is the driver routine
          63             : ! for the customizable HEMCO extension.
          64             : !\\
          65             : !\\
          66             : ! !INTERFACE:
          67             : !
          68           0 :   SUBROUTINE HCOX_Custom_Run( ExtState, HcoState, RC )
          69             : !
          70             : ! !USES:
          71             : !
          72             :     USE HCO_FluxArr_Mod,  ONLY : HCO_EmisAdd
          73             :     USE HCO_GeoTools_Mod, ONLY : HCO_LANDTYPE
          74             : !
          75             : ! !INPUT PARAMETERS:
          76             : !
          77             :     TYPE(Ext_State), POINTER       :: ExtState    ! Module options
          78             : !
          79             : ! !INPUT/OUTPUT PARAMETERS:
          80             : !
          81             :     TYPE(HCO_State), POINTER       :: HcoState    ! Hemco state
          82             :     INTEGER,         INTENT(INOUT) :: RC          ! Success or failure
          83             : !
          84             : ! !REMARKS:
          85             : !
          86             : !
          87             : ! !REVISION HISTORY:
          88             : !  13 Dec 2013 - C. Keller   - Initial version
          89             : !  See https://github.com/geoschem/hemco for complete history
          90             : !EOP
          91             : !------------------------------------------------------------------------------
          92             : !BOC
          93             : !
          94             : ! !LOCAL VARIABLES:
          95             : !
          96             :     INTEGER               :: I, J, N, AS, LANDTYPE
          97             :     INTEGER               :: tmpID
          98             :     REAL*8                :: W10M
          99           0 :     REAL(hp), ALLOCATABLE :: FLUXICE(:,:)
         100           0 :     REAL(hp), ALLOCATABLE :: FLUXWIND(:,:)
         101             :     LOGICAL               :: ERR
         102             :     CHARACTER(LEN=255)    :: MSG, LOC
         103             :
         104             :     TYPE(MyInst), POINTER :: Inst
         105             : !
         106             : ! !DEFINED PARAMETERS:
         107             : !
         108             :     REAL*8,   PARAMETER :: SCALICE  = 1.0d-14
         109             :     REAL*8,   PARAMETER :: SCALWIND = 1.0d-14
         110             :
         111             :     !=================================================================
         112             :     ! HCOX_CUSTOM_RUN begins here!
         113             :     !=================================================================
         114           0 :     LOC = 'HCOX_CUSTOM_RUN (HCOX_CUSTOM_MOD.F90)'
         115             :
         116             :     ! Enter
         117           0 :     CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
         118           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         119           0 :         CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
         120           0 :         RETURN
         121             :     ENDIF
         122             :
         123             :     ! Set error flag
         124           0 :     ERR = .FALSE.
         125             :
         126             :     ! Sanity check: return if extension not turned on
         127           0 :     IF ( ExtState%Custom <= 0 ) RETURN
         128             :
         129             :     ! Get instance
         130           0 :     Inst => NULL()
         131           0 :     CALL InstGet ( ExtState%Custom, Inst, RC )
         132           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         133           0 :        WRITE(MSG,*) 'Cannot find custom instance Nr. ', ExtState%Custom
         134           0 :        CALL HCO_ERROR(MSG,RC)
         135           0 :        RETURN
         136             :     ENDIF
         137             :
         138             :     ! Initialize flux arrays
         139             :     ALLOCATE ( FLUXICE( HcoState%NX,HcoState%NY),        &
         140           0 :                FLUXWIND(HcoState%NX,HcoState%NY), STAT=AS )
         141           0 :     IF ( AS/= 0 ) THEN
         142           0 :        CALL HCO_ERROR( 'ALLOCATION ERROR', RC )
         143           0 :        RETURN
         144             :     ENDIF
         145           0 :     FLUXICE  = 0.0_hp
         146           0 :     FLUXWIND = 0.0_hp
         147             :
         148             : !$OMP PARALLEL DO                                            &
         149             : !$OMP DEFAULT( SHARED )                                      &
         150             : !$OMP PRIVATE( I, J, W10M, LANDTYPE                        ) &
         151             : !$OMP SCHEDULE( DYNAMIC )
         152             :     ! Loop over surface grid boxes
         153           0 :     DO J = 1, HcoState%NY
         154           0 :     DO I = 1, HcoState%NX
         155             :
         156             :        ! Get the land type for grid box (I,J)
         157           0 :        LANDTYPE = HCO_LANDTYPE( ExtState%FRLAND%Arr%Val(I,J),   &
         158           0 :                                 ExtState%FRLANDIC%Arr%Val(I,J), &
         159           0 :                                 ExtState%FROCEAN%Arr%Val(I,J),  &
         160           0 :                                 ExtState%FRSEAICE%Arr%Val(I,J), &
         161           0 :                                 ExtState%FRLAKE%Arr%Val(I,J)   )
         162             :
         163             :        ! Check surface type
         164             :        ! Ocean:
         165           0 :        IF ( LANDTYPE == 0 ) THEN
         166             :
         167             :           ! 10m wind speed [m/s]
         168           0 :           W10M = ExtState%U10M%Arr%Val(I,J)**2 + &
         169           0 :                  ExtState%V10M%Arr%Val(I,J)**2
         170           0 :           W10M = SQRT(W10M)
         171             :
         172             :           ! Set flux to wind speed
         173           0 :           FLUXWIND(I,J) = W10M * SCALWIND
         174             :
         175             :        ! Ice:
         176           0 :        ELSE IF ( LANDTYPE == 2 ) THEN
         177             :
         178             :           ! Set uniform flux
         179           0 :           FLUXICE(I,J) = SCALICE
         180             :        ENDIF
         181             :
         182             :     ENDDO !I
         183             :     ENDDO !J
         184             : !$OMP END PARALLEL DO
         185             :
         186             :     ! Check exit status
         187             :     IF ( ERR ) THEN
         188             :        RC = HCO_FAIL
         189             :        RETURN
         190             :     ENDIF
         191             :
         192             :     ! Add wind fluxes to emission arrays & diagnostics
         193           0 :     DO N = 1, Inst%nOcWind
         194             :
         195             :        ! Emissions array
         196           0 :        CALL HCO_EmisAdd( HcoState, FLUXWIND, Inst%OcWindIDs(N), &
         197           0 :                          RC,       ExtNr=Inst%ExtNr )
         198           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         199           0 :            CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
         200           0 :            RETURN
         201             :        ENDIF
         202             :     ENDDO !N
         203             :
         204             :     ! Add ice fluxes to emission arrays & diagnostics
         205           0 :     DO N = 1, Inst%nIceSrc
         206             :
         207             :        ! Emissions array
         208           0 :        CALL HCO_EmisAdd( HcoState, FLUXICE, Inst%IceSrcIDs(N), &
         209           0 :                          RC,       ExtNr=Inst%ExtNr )
         210           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         211           0 :            CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
         212           0 :            RETURN
         213             :        ENDIF
         214             :     ENDDO !N
         215             :
         216             :     ! Return w/ success
         217           0 :     Inst => NULL()
         218           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
         219             :
         220           0 :   END SUBROUTINE HCOX_Custom_Run
         221             : !EOC
         222             : !------------------------------------------------------------------------------
         223             : !                   Harmonized Emissions Component (HEMCO)                    !
         224             : !------------------------------------------------------------------------------
         225             : !BOP
         226             : !
         227             : ! !IROUTINE: HCOX_Custom_Init
         228             : !
         229             : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Init initializes the HEMCO
         230             : ! CUSTOM extension.
         231             : !\\
         232             : !\\
         233             : ! !INTERFACE:
         234             : !
         235           0 :   SUBROUTINE HCOX_Custom_Init( HcoState, ExtName, ExtState, RC )
         236             : !
         237             : ! !USES:
         238             : !
         239             :     USE HCO_ExtList_Mod,    ONLY : GetExtNr
         240             :     USE HCO_STATE_MOD,      ONLY : HCO_GetExtHcoID
         241             : !
         242             : ! !INPUT PARAMETERS:
         243             : !
         244             :     CHARACTER(LEN=*), INTENT(IN   ) :: ExtName    ! Extension name
         245             :     TYPE(Ext_State),  POINTER       :: ExtState   ! Module options
         246             : !
         247             : ! !INPUT/OUTPUT PARAMETERS:
         248             : !
         249             :     TYPE(HCO_State),  POINTER       :: HcoState   ! Hemco state
         250             :     INTEGER,          INTENT(INOUT) :: RC
         251             :
         252             : ! !REVISION HISTORY:
         253             : !  13 Dec 2013 - C. Keller   - Now a HEMCO extension
         254             : !  See https://github.com/geoschem/hemco for complete history
         255             : !EOP
         256             : !------------------------------------------------------------------------------
         257             : !BOC
         258             : !
         259             : ! !LOCAL VARIABLES:
         260             : !
         261             :     INTEGER                        :: ExtNr, N, nSpc, AS
         262           0 :     INTEGER,           ALLOCATABLE :: HcoIDs(:)
         263           0 :     CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
         264             :     CHARACTER(LEN=255)             :: MSG, LOC
         265             :     TYPE(MyInst), POINTER          :: Inst
         266             :
         267             :     !=================================================================
         268             :     ! HCOX_CUSTOM_INIT begins here!
         269             :     !=================================================================
         270           0 :     LOC = 'HCOX_CUSTOM_INIT (HCOX_CUSTOM_MOD.F90)'
         271             :
         272             :     ! Extension Nr.
         273           0 :     ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
         274           0 :     IF ( ExtNr <= 0 ) RETURN
         275             :
         276             :     ! Enter
         277           0 :     CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
         278           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         279           0 :         CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
         280           0 :         RETURN
         281             :     ENDIF
         282             :
         283           0 :     Inst => NULL()
         284           0 :     CALL InstCreate ( ExtNr, ExtState%Custom, Inst, RC )
         285           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         286           0 :        CALL HCO_ERROR (  'Cannot create custom instance', RC )
         287           0 :        RETURN
         288             :     ENDIF
         289             :
         290             :     ! Set species IDs
         291           0 :     CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, HcoIDs, SpcNames, nSpc, RC )
         292           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         293           0 :         CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
         294           0 :         RETURN
         295             :     ENDIF
         296             :
         297             :     ! Assume first half are 'wind species', second half are ice.
         298           0 :     IF ( MOD(nSpc,2) /= 0 ) THEN
         299           0 :        MSG = 'Cannot set species IDs for custom emission module!'
         300           0 :        CALL HCO_ERROR(MSG, RC )
         301           0 :        RETURN
         302             :     ENDIF
         303             :
         304             :     ! Pass # of sources
         305           0 :     Inst%nOcWind = nSpc / 2
         306           0 :     Inst%nIceSrc = nSpc / 2
         307             :
         308             :     ! Allocate vector w/ the species IDs
         309           0 :     ALLOCATE ( Inst%OcWindIDs(Inst%nOcWind) )
         310           0 :     ALLOCATE ( Inst%IceSrcIDs(Inst%nIceSrc) )
         311           0 :     Inst%OcWindIDs(:) = HcoIDs(1:Inst%nOcWind)
         312           0 :     N = Inst%nOcWind + 1
         313           0 :     Inst%IceSrcIDs(:) = HcoIDs(N:nSpc)
         314             :
         315             :     ! Verbose mode
         316           0 :     IF ( Hcostate%amIRoot ) THEN
         317             :
         318             :        ! Write the name of the extension regardless of the verbose setting
         319           0 :        msg = 'Using HEMCO extension: Custom (custom emissions module)'
         320           0 :        IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
         321           0 :           CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator
         322             :        ELSE
         323           0 :           CALL HCO_Msg( msg, verb=.TRUE.              ) ! w/o separator
         324             :        ENDIF
         325             :
         326             :        ! Write all other messages as debug printout only
         327           0 :        MSG = 'Use the following species (Name: HcoID):'
         328           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
         329           0 :        DO N = 1, nSpc
         330           0 :           WRITE(MSG,*) TRIM(SpcNames(N)), ':', HcoIDs(N)
         331           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
         332             :        ENDDO
         333             :     ENDIF
         334             :
         335             :     ! Activate met fields required by this extension
         336           0 :     ExtState%U10M%DoUse = .TRUE.
         337           0 :     ExtState%V10M%DoUse = .TRUE.
         338           0 :     ExtState%FRLAND%DoUse   = .TRUE.
         339           0 :     ExtState%FRLANDIC%DoUse = .TRUE.
         340           0 :     ExtState%FROCEAN%DoUse  = .TRUE.
         341           0 :     ExtState%FRSEAICE%DoUse = .TRUE.
         342           0 :     ExtState%FRLAKE%DoUse   = .TRUE.
         343             :
         344             :     ! Activate this extension
         345             :     !ExtState%Custom = .TRUE.
         346             :
         347             :     ! Leave w/ success
         348           0 :     IF ( ALLOCATED(HcoIDs  ) ) DEALLOCATE(HcoIDs  )
         349           0 :     IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
         350             :
         351           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
         352             :
         353           0 :   END SUBROUTINE HCOX_Custom_Init
         354             : !EOC
         355             : !------------------------------------------------------------------------------
         356             : !                   Harmonized Emissions Component (HEMCO)                    !
         357             : !------------------------------------------------------------------------------
         358             : !BOP
         359             : !
         360             : ! !IROUTINE: HCOX_Custom_Final
         361             : !
         362             : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Final finalizes the HEMCO
         363             : ! CUSTOM extension.
         364             : !\\
         365             : !\\
         366             : ! !INTERFACE:
         367             : !
         368           0 :   SUBROUTINE HCOX_Custom_Final ( ExtState )
         369             : !
         370             : ! !INPUT PARAMETERS:
         371             : !
         372             :     TYPE(Ext_State),  POINTER       :: ExtState   ! Module options
         373             : !
         374             : ! !REVISION HISTORY:
         375             : !  13 Dec 2013 - C. Keller   - Now a HEMCO extension
         376             : !  See https://github.com/geoschem/hemco for complete history
         377             : !EOP
         378             : !------------------------------------------------------------------------------
         379             : !BOC
         380             :
         381             :     !=================================================================
         382             :     ! HCOX_CUSTOM_FINAL begins here!
         383             :     !=================================================================
         384           0 :     CALL InstRemove ( ExtState%Custom )
         385             :
         386           0 :   END SUBROUTINE HCOX_Custom_Final
         387             : !EOC
         388             : !------------------------------------------------------------------------------
         389             : !                   Harmonized Emissions Component (HEMCO)                    !
         390             : !------------------------------------------------------------------------------
         391             : !BOP
         392             : !
         393             : ! !IROUTINE: InstGet
         394             : !
         395             : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
         396             : !\\
         397             : !\\
         398             : ! !INTERFACE:
         399             : !
         400           0 :   SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
         401             : !
         402             : ! !INPUT PARAMETERS:
         403             : !
         404             :     INTEGER                             :: Instance
         405             :     TYPE(MyInst),     POINTER           :: Inst
         406             :     INTEGER                             :: RC
         407             :     TYPE(MyInst),     POINTER, OPTIONAL :: PrevInst
         408             : !
         409             : ! !REVISION HISTORY:
         410             : !  18 Feb 2016 - C. Keller   - Initial version
         411             : !  See https://github.com/geoschem/hemco for complete history
         412             : !EOP
         413             : !------------------------------------------------------------------------------
         414             : !BOC
         415             :     TYPE(MyInst),     POINTER    :: PrvInst
         416             :
         417             :     !=================================================================
         418             :     ! InstGet begins here!
         419             :     !=================================================================
         420             :
         421             :     ! Get instance. Also archive previous instance.
         422           0 :     PrvInst => NULL()
         423           0 :     Inst    => AllInst
         424           0 :     DO WHILE ( ASSOCIATED(Inst) )
         425           0 :        IF ( Inst%Instance == Instance ) EXIT
         426           0 :        PrvInst => Inst
         427           0 :        Inst    => Inst%NextInst
         428             :     END DO
         429           0 :     IF ( .NOT. ASSOCIATED( Inst ) ) THEN
         430           0 :        RC = HCO_FAIL
         431           0 :        RETURN
         432             :     ENDIF
         433             :
         434             :     ! Pass output arguments
         435           0 :     IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
         436             :
         437             :     ! Cleanup & Return
         438           0 :     PrvInst => NULL()
         439           0 :     RC = HCO_SUCCESS
         440             :
         441             :   END SUBROUTINE InstGet
         442             : !EOC
         443             : !------------------------------------------------------------------------------
         444             : !                   Harmonized Emissions Component (HEMCO)                    !
         445             : !------------------------------------------------------------------------------
         446             : !BOP
         447             : !
         448             : ! !IROUTINE: InstCreate
         449             : !
         450             : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
         451             : !\\
         452             : !\\
         453             : ! !INTERFACE:
         454             : !
         455           0 :   SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
         456             : !
         457             : ! !INPUT PARAMETERS:
         458             : !
         459             :     INTEGER,       INTENT(IN)       :: ExtNr
         460             : !
         461             : ! !OUTPUT PARAMETERS:
         462             : !
         463             :     INTEGER,       INTENT(  OUT)    :: Instance
         464             :     TYPE(MyInst),  POINTER          :: Inst
         465             : !
         466             : ! !INPUT/OUTPUT PARAMETERS:
         467             : !
         468             :     INTEGER,       INTENT(INOUT)    :: RC
         469             : !
         470             : ! !REVISION HISTORY:
         471             : !  18 Feb 2016 - C. Keller   - Initial version
         472             : !  See https://github.com/geoschem/hemco for complete history
         473             : !EOP
         474             : !------------------------------------------------------------------------------
         475             : !BOC
         476             :     TYPE(MyInst), POINTER          :: TmpInst
         477             :     INTEGER                        :: nnInst
         478             :
         479             :     !=================================================================
         480             :     ! InstCreate begins here!
         481             :     !=================================================================
         482             :
         483             :     ! ----------------------------------------------------------------
         484             :     ! Generic instance initialization
         485             :     ! ----------------------------------------------------------------
         486             :
         487             :     ! Initialize
         488           0 :     Inst => NULL()
         489             :
         490             :     ! Get number of already existing instances
         491           0 :     TmpInst => AllInst
         492           0 :     nnInst = 0
         493           0 :     DO WHILE ( ASSOCIATED(TmpInst) )
         494           0 :        nnInst  =  nnInst + 1
         495           0 :        TmpInst => TmpInst%NextInst
         496             :     END DO
         497             :
         498             :     ! Create new instance
         499           0 :     ALLOCATE(Inst)
         500           0 :     Inst%Instance = nnInst + 1
         501           0 :     Inst%ExtNr    = ExtNr
         502             :
         503             :     ! Attach to instance list
         504           0 :     Inst%NextInst => AllInst
         505           0 :     AllInst       => Inst
         506             :
         507             :     ! Update output instance
         508           0 :     Instance = Inst%Instance
         509             :
         510             :     ! ----------------------------------------------------------------
         511             :     ! Type specific initialization statements follow below
         512             :     ! ----------------------------------------------------------------
         513             :
         514             :     ! Return w/ success
         515           0 :     RC = HCO_SUCCESS
         516             :
         517           0 :   END SUBROUTINE InstCreate
         518             : !EOC
         519             : !------------------------------------------------------------------------------
         520             : !                   Harmonized Emissions Component (HEMCO)                    !
         521             : !------------------------------------------------------------------------------
         522             : !BOP
         523             : !
         524             : ! !IROUTINE: InstRemove
         525             : !
         526             : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
         527             : !\\
         528             : !\\
         529             : ! !INTERFACE:
         530             : !
         531           0 :   SUBROUTINE InstRemove ( Instance )
         532             : !
         533             : ! !INPUT PARAMETERS:
         534             : !
         535             :     INTEGER                         :: Instance
         536             : !
         537             : ! !REVISION HISTORY:
         538             : !  18 Feb 2016 - C. Keller   - Initial version
         539             : !  See https://github.com/geoschem/hemco for complete history
         540             : !EOP
         541             : !------------------------------------------------------------------------------
         542             : !BOC
         543             :     INTEGER                     :: RC
         544             :     TYPE(MyInst), POINTER       :: PrevInst
         545             :     TYPE(MyInst), POINTER       :: Inst
         546             :
         547             :     !=================================================================
         548             :     ! InstRemove begins here!
         549             :     !=================================================================
         550             :
         551             :     ! Init
         552           0 :     PrevInst => NULL()
         553           0 :     Inst     => NULL()
         554             :
         555             :     ! Get instance. Also archive previous instance.
         556           0 :     CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
         557             :
         558             :     ! Instance-specific deallocation
         559           0 :     IF ( ASSOCIATED(Inst) ) THEN
         560             :
         561             :        !---------------------------------------------------------------------
         562             :        ! Deallocate fields of Inst before popping off from the list
         563             :        ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
         564             :        !---------------------------------------------------------------------
         565           0 :        IF ( ASSOCIATED( Inst%OcWindIDs ) ) THEN
         566           0 :           DEALLOCATE ( Inst%OcWindIDs )
         567             :        ENDIF
         568           0 :        Inst%OcWindIDs => NULL()
         569             :
         570           0 :        IF ( ASSOCIATED( Inst%IceSrcIDs ) ) THEN
         571           0 :           DEALLOCATE ( Inst%IceSrcIDs )
         572             :        ENDIF
         573           0 :        Inst%IceSrcIDs => NULL()
         574             :
         575             :        !---------------------------------------------------------------------
         576             :        ! Pop off instance from list
         577             :        !---------------------------------------------------------------------
         578           0 :        IF ( ASSOCIATED(PrevInst) ) THEN
         579           0 :           PrevInst%NextInst => Inst%NextInst
         580             :        ELSE
         581           0 :           AllInst => Inst%NextInst
         582             :        ENDIF
         583           0 :        DEALLOCATE(Inst)
         584             :        Inst => NULL()
         585             :     ENDIF
         586             :
         587             :     ! Free pointers before exiting
         588           0 :     PrevInst => NULL()
         589           0 :     Inst     => NULL()
         590             :
         591           0 :    END SUBROUTINE InstRemove
         592             : !EOC
         593           0 : END MODULE HCOX_Custom_Mod

Generated by: LCOV version 1.14