LCOV - code coverage report
Current view: | top level - hemco/HEMCO/src/Extensions - hcox_dustginoux_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 255 | 0.0 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 0 | 10 | 0.0 %

              Line data    Source code
           1             : !------------------------------------------------------------------------------
           2             : !                   Harmonized Emissions Component (HEMCO)                    !
           3             : !------------------------------------------------------------------------------
           4             : !BOP
           5             : !
           6             : ! !MODULE: hcox_dustginoux_mod.F90
           7             : !
           8             : ! !DESCRIPTION: Paul GINOUX dust source function.  This subroutine updates
           9             : !  the surface mixing ratio of dust aerosols for NDSTBIN size bins.  The
          10             : !  uplifting of dust depends in space on the source function, and in time
          11             : !  and space on the soil moisture and surface wind speed (10 meters).  Dust
          12             : !  is uplifted if the wind speed is greater than a threshold velocity which
          13             : !  is calculated with the formula of Marticorena et al.  (JGR, v.102,
          14             : !  pp 23277-23287, 1997).  To run this subroutine you need the source
          15             : !  function which can be obtained by contacting Paul Ginoux at
          16             : !  ginoux@rondo.gsfc.nasa.gov/  If you are not using GEOS DAS met fields,
          17             : !  you will most likely need to adapt the adjusting parameter.
          18             : !\\
          19             : !\\
          20             : ! This is a HEMCO extension module that uses many of the HEMCO core
          21             : ! utilities.
          22             : !\\
          23             : !\\
          24             : ! References:
          25             : !
          26             : ! \begin{enumerate}
          27             : ! \item Ginoux, P., M. Chin, I. Tegen, J. Prospero, B. Hoben, O. Dubovik,
          28             : !        and S.-J. Lin, "Sources and distributions of dust aerosols simulated
          29             : !        with the GOCART model", J. Geophys. Res., 2001
          30             : ! \item Chin, M., P. Ginoux, S. Kinne, B. Holben, B. Duncan, R. Martin,
          31             : !        J. Logan, A. Higurashi, and T. Nakajima, "Tropospheric aerosol
          32             : !        optical thickness from the GOCART model and comparisons with
          33             : !        satellite and sunphotometers measurements", J. Atmos Sci., 2001.
          34             : ! \end{enumerate}
          35             : !
          36             : ! !AUTHOR:
          37             : !  Paul Ginoux (ginoux@rondo.gsfc.nasa.gov)
          38             : !
          39             : ! !INTERFACE:
          40             : !
          41             : MODULE HCOX_DustGinoux_Mod
          42             : !
          43             : ! !USES:
          44             : !
          45             :   USE HCO_Error_Mod
          46             :   USE HCO_Diagn_Mod
          47             :   USE HCO_State_Mod,  ONLY : HCO_State
          48             :   USE HCOX_State_Mod, ONLY : Ext_State
          49             :
          50             :   IMPLICIT NONE
          51             :   PRIVATE
          52             : !
          53             : ! !PUBLIC MEMBER FUNCTIONS:
          54             : !
          55             :   PUBLIC :: HcoX_DustGinoux_Run
          56             :   PUBLIC :: HcoX_DustGinoux_Init
          57             :   PUBLIC :: HcoX_DustGinoux_Final
          58             :   PUBLIC :: HcoX_DustGinoux_GetChDust
          59             : !
          60             : ! !REVISION HISTORY:
          61             : !  08 Apr 2004 - T. D. Fairlie - Initial version
          62             : !  See https://github.com/geoschem/hemco for complete history
          63             : !EOP
          64             : !------------------------------------------------------------------------------
          65             : !BOC
          66             : !
          67             : ! !PRIVATE TYPES:
          68             : !
          69             :   TYPE :: MyInst
          70             :
          71             :    ! Quantities related to dust bins
          72             :    INTEGER              :: Instance
          73             :    INTEGER              :: NBINS
          74             :    INTEGER              :: ExtNr    = -1     ! Extension number  for DustGinoux
          75             :    INTEGER              :: ExtNrAlk = -1     ! Extension number  for DustAlk
          76             :    INTEGER, ALLOCATABLE :: HcoIDs    (:)     ! HEMCO species IDs for DustGinoux
          77             :    INTEGER, ALLOCATABLE :: HcoIDsAlk (:)     ! HEMCO species IDs for DustAlk
          78             :    INTEGER,  POINTER    :: IPOINT    (:)     ! 1=sand, 2=silt, 3=clay
          79             :    REAL,     POINTER    :: FRAC_S    (:)     !
          80             :    REAL,     POINTER    :: DUSTDEN   (:)     ! dust density     [kg/m3]
          81             :    REAL,     POINTER    :: DUSTREFF  (:)     ! effective radius [um]
          82             :    REAL(hp), POINTER    :: FLUX(:,:,:)
          83             :    REAL(hp), POINTER    :: FLUX_ALK(:,:,:)
          84             :
          85             :    ! Source functions (get from HEMCO core)
          86             :    REAL(hp), POINTER    :: SRCE_SAND(:,:) => NULL()
          87             :    REAL(hp), POINTER    :: SRCE_SILT(:,:) => NULL()
          88             :    REAL(hp), POINTER    :: SRCE_CLAY(:,:) => NULL()
          89             :
          90             :    ! Transfer coefficient (grid-dependent)
          91             :    REAL(dp)             :: CH_DUST
          92             :
          93             :    TYPE(MyInst), POINTER :: NextInst => NULL()
          94             :   END TYPE MyInst
          95             :
          96             :   ! Pointer to instances
          97             :   TYPE(MyInst), POINTER  :: AllInst => NULL()
          98             :
          99             : CONTAINS
         100             : !EOC
         101             : !------------------------------------------------------------------------------
         102             : !                   Harmonized Emissions Component (HEMCO)                    !
         103             : !------------------------------------------------------------------------------
         104             : !BOP
         105             : !
         106             : ! !IROUTINE: HCOX_DustGinoux_Run
         107             : !
         108             : ! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Run is the driver routine
         109             : ! for the Paul Ginoux dust source function HEMCO extension.
         110             : !\\
         111             : !\\
         112             : ! !INTERFACE:
         113             : !
         114           0 :   SUBROUTINE HcoX_DustGinoux_Run( ExtState, HcoState, RC )
         115             : !
         116             : ! !USES:
         117             : !
         118             :     USE HCO_Calc_Mod,     ONLY : HCO_EvalFld
         119             :     USE HCO_EmisList_Mod, ONLY : HCO_GetPtr
         120             :     USE HCO_FluxArr_Mod,  ONLY : HCO_EmisAdd
         121             :     USE HCO_Clock_Mod,    ONLY : HcoClock_First
         122             : !
         123             : ! !INPUT PARAMETERS:
         124             : !
         125             :     TYPE(Ext_State), POINTER        :: ExtState    ! Options for this ext
         126             : !
         127             : ! !INPUT/OUTPUT PARAMETERS:
         128             : !
         129             :     TYPE(HCO_State), POINTER        :: HcoState    ! HEMCO state object
         130             :     INTEGER,         INTENT(INOUT)  :: RC          ! Success or failure?
         131             : !
         132             : ! !REMARKS:
         133             : !    SRCE_FUNK Source function                               (-)
         134             : !              for 1: Sand, 2: Silt, 3: Clay
         135             : !                                                                             .
         136             : !    DUSTDEN   Dust density                                  (kg/m3)
         137             : !    DUSTREFF  Effective radius                              (um)
         138             : !    AD        Air mass for each grid box                    (kg)
         139             : !    NTDT      Time step                                     (s)
         140             : !    W10m      Velocity at the anemometer level (10meters)   (m/s)
         141             : !    GWET      Surface wetness                               (-)
         142             : !                                                                             .
         143             : !  Dust properties used in GOCART
         144             : !                                                                             .
         145             : !  Size classes: 01-1, 1-1.8, 1.8-3, 3-6 (um)
         146             : !  Radius: 0.7, 1.5, 2.5, 4  (um)
         147             : !  Density: 2500, 2650, 2650, 2650 (kg/m3)
         148             : !
         149             : ! !REVISION HISTORY:
         150             : !  08 Apr 2004 - T. D. Fairlie - Initial version
         151             : !  See https://github.com/geoschem/hemco for complete history
         152             : !EOP
         153             : !------------------------------------------------------------------------------
         154             : !BOC
         155             : !
         156             : ! !DEFINED PARAMETER:
         157             : !
         158             :     REAL*8, PARAMETER :: RHOA     = 1.25d-3
         159             :
         160             : !
         161             : ! !LOCAL VARIABLES:
         162             : !
         163             :     ! SAVED scalars
         164             : !    LOGICAL, SAVE     :: FIRST = .TRUE.
         165             :
         166             :     ! Scalars
         167             :     INTEGER           :: I, J, N, M, tmpID
         168             :     LOGICAL           :: ERR
         169             :     REAL*8            :: W10M,   DEN,    DIAM,   U_TS0, U_TS
         170             :     REAL*8            :: SRCE_P, REYNOL, ALPHA,  BETA
         171             :     REAL*8            :: GAMMA,  CW,     DTSRCE, A_M2,  G
         172             :     REAL              :: DSRC
         173             :     CHARACTER(LEN=63) :: MSG, LOC
         174             :
         175             :     ! Arrays
         176           0 :     REAL*8            :: DUST_EMI_TOTAL(HcoState%NX, HcoState%NY)
         177             :
         178             :     ! Pointers
         179             :     TYPE(MyInst), POINTER :: Inst
         180           0 :     REAL(hp),     POINTER :: Arr2D(:,:)
         181             :
         182             :     !=======================================================================
         183             :     ! HCOX_DUSTGINOUX_RUN begins here!
         184             :     !=======================================================================
         185           0 :     LOC = 'HCOX_DUSTGINOUX_RUN (HCOX_DUSTGINOUX_MOD.F90)'
         186             :
         187             :     ! Return if extension is disabled
         188           0 :     IF ( ExtState%DustGinoux <= 0 ) RETURN
         189             :
         190             :     ! Enter
         191           0 :     CALL HCO_ENTER(HcoState%Config%Err, LOC, RC)
         192           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         193           0 :         CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
         194           0 :         RETURN
         195             :     ENDIF
         196             :
         197             :     ! Get instance
         198           0 :     Inst   => NULL()
         199           0 :     CALL InstGet ( ExtState%DustGinoux, Inst, RC )
         200           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         201           0 :        WRITE(MSG,*) 'Cannot find DustGinoux instance Nr. ', ExtState%DustGinoux
         202           0 :        CALL HCO_ERROR(MSG,RC)
         203           0 :        RETURN
         204             :     ENDIF
         205             :
         206             :     ! Set gravity at earth surface (cm/s^2)
         207           0 :     G       = HcoState%Phys%g0 * 1.0d2
         208             :
         209             :     ! Emission timestep [s]
         210           0 :     DTSRCE  = HcoState%TS_EMIS
         211             :
         212             :     ! Initialize total dust emissions array [kg/m2/s]
         213           0 :     DUST_EMI_TOTAL = 0.0d0
         214             :
         215             :     ! Error check
         216           0 :     ERR     = .FALSE.
         217             :
         218             :     ! Init
         219           0 :     Arr2D    => NULL()
         220             :
         221             :     !=================================================================
         222             :     ! Point to DUST source functions
         223             :     !=================================================================
         224             :     !IF ( HcoClock_First(HcoState%Clock,.TRUE.) ) THEN
         225             :
         226             :        ! Sand
         227           0 :        CALL HCO_EvalFld( HcoState, 'GINOUX_SAND', Inst%SRCE_SAND, RC )
         228           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         229           0 :            CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
         230           0 :            RETURN
         231             :        ENDIF
         232             :
         233             :        ! Silt
         234           0 :        CALL HCO_EvalFld( HcoState, 'GINOUX_SILT', Inst%SRCE_SILT, RC )
         235           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         236           0 :            CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
         237           0 :            RETURN
         238             :        ENDIF
         239             :
         240             :        ! Clay
         241           0 :        CALL HCO_EvalFld( HcoState, 'GINOUX_CLAY', Inst%SRCE_CLAY, RC )
         242           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         243           0 :            CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
         244           0 :            RETURN
         245             :        ENDIF
         246             :     !ENDIF
         247             :
         248             :     !=================================================================
         249             :     ! Compute dust emisisons
         250             :     !=================================================================
         251             : !$OMP PARALLEL DO                                             &
         252             : !$OMP DEFAULT( SHARED )                                       &
         253             : !$OMP PRIVATE( I,      J,     M,      N,      DEN,   DIAM   ) &
         254             : !$OMP PRIVATE( REYNOL, ALPHA, BETA,   GAMMA,  U_TS0, U_TS   ) &
         255             : !$OMP PRIVATE( CW,     W10M,  SRCE_P, RC                    ) &
         256             : !$OMP SCHEDULE( DYNAMIC )
         257           0 :     DO N = 1, Inst%NBINS
         258             :
         259             :        !====================================================================
         260             :        ! Threshold velocity as a function of the dust density and the
         261             :        ! diameter from Bagnold (1941), valid for particles larger
         262             :        ! than 10 um.
         263             :        !
         264             :        ! u_ts0 = 6.5*sqrt(dustden(n)*g0*2.*dustreff(n))
         265             :        !
         266             :        ! Threshold velocity from Marticorena and Bergametti
         267             :        ! Convert units to fit dimensional parameters
         268             :        !====================================================================
         269           0 :        DEN    = Inst%DUSTDEN(N) * 1.d-3                   ! [g/cm3]
         270           0 :        DIAM   = 2d0 * Inst%DUSTREFF(N) * 1.d2             ! [cm in diameter]
         271           0 :        REYNOL = 1331.d0 * DIAM**(1.56d0) + 0.38d0         ! [Reynolds number]
         272           0 :        ALPHA  = DEN * G * DIAM / RHOA
         273           0 :        BETA   = 1d0 + ( 6.d-3 / ( DEN * G * DIAM**(2.5d0) ) )
         274           0 :        GAMMA  = ( 1.928d0 * REYNOL**(0.092d0) ) - 1.d0
         275             :
         276             :        !====================================================================
         277             :        ! I think the 129.d-5 is to put U_TS in m/sec instead of cm/sec
         278             :        ! This is a threshold friction velocity!       from M&B
         279             :        ! i.e. Ginoux uses the Gillette and Passi formulation
         280             :        ! but has substituted Bagnold's Ut with M&B's U*t.
         281             :        ! This appears to be a problem.  (tdf, 4/2/04)
         282             :        !====================================================================
         283             :
         284             :        ! [m/s]
         285           0 :        U_TS0  = 129.d-5 * SQRT( ALPHA ) * SQRT( BETA ) / SQRT( GAMMA )
         286             :
         287             :        ! Index used to select the source function (1=sand, 2=silt, 3=clay)
         288           0 :        M = Inst%IPOINT(N)
         289             :
         290             :        ! Loop over grid boxes
         291           0 :        DO J = 1, HcoState%NY
         292           0 :        DO I = 1, HcoState%NX
         293             :
         294             :           ! Fraction of emerged surfaces
         295             :           ! (subtract lakes, coastal ocean,...)
         296           0 :           CW = 1.d0
         297             :
         298             :           ! Case of surface dry enough to erode
         299           0 :           IF ( ExtState%GWETTOP%Arr%Val(I,J) < 0.2d0 ) THEN
         300             :
         301             :              U_TS = U_TS0 *( 1.2d0 + 0.2d0 * &
         302           0 :                     LOG10( MAX(1.d-3,ExtState%GWETTOP%Arr%Val(I,J))))
         303           0 :              U_TS = MAX( 0.d0, U_TS )
         304             :
         305             :           ELSE
         306             :
         307             :              ! Case of wet surface, no erosion
         308             :              U_TS = 100.d0
         309             :
         310             :           ENDIF
         311             :
         312             :           ! 10m wind speed squared [m2/s2]
         313           0 :           W10M = ExtState%U10M%Arr%Val(I,J)**2 &
         314           0 :                + ExtState%V10M%Arr%Val(I,J)**2
         315             :
         316             :           ! Get source function
         317           0 :           SELECT CASE( M )
         318             :              CASE( 1 )
         319           0 :                 SRCE_P = Inst%SRCE_SAND(I,J)
         320             :              CASE( 2 )
         321           0 :                 SRCE_P = Inst%SRCE_SILT(I,J)
         322             :              CASE( 3 )
         323           0 :                 SRCE_P = Inst%SRCE_CLAY(I,J)
         324             :           END SELECT
         325             :
         326             :           ! Units are m2
         327           0 :           SRCE_P = Inst%FRAC_S(N) * SRCE_P !* A_M2
         328             :
         329             :           ! Dust source increment [kg/m2/s]
         330           0 :           Inst%FLUX(I,J,N) = CW           * Inst%CH_DUST * SRCE_P * W10M &
         331           0 :                            * ( SQRT(W10M) - U_TS )
         332             :
         333             :           ! Not less than zero
         334           0 :           IF ( Inst%FLUX(I,J,N) < 0.d0 ) Inst%FLUX(I,J,N) = 0.d0
         335             :
         336             :           ! Increment total dust emissions [kg/m2/s] (L. Zhang, 6/26/15)
         337           0 :           DUST_EMI_TOTAL(I,J) = DUST_EMI_TOTAL(I,J) + Inst%FLUX(I,J,N)
         338             :
         339             :           ! Include DUST Alkalinity SOURCE, assuming an alkalinity
         340             :           ! of 4% by weight [kg].                  !tdf 05/10/08
         341             :           !tdf 3% Ca + equ 1% Mg = 4% alkalinity
         342           0 :           IF ( Inst%ExtNrAlk > 0 ) THEN
         343           0 :              Inst%FLUX_ALK(I,J,N) = 0.04 * Inst%FLUX(I,J,N)
         344             :           ENDIF
         345             :
         346             :        ENDDO
         347             :        ENDDO
         348             :     ENDDO
         349             : !$OMP END PARALLEL DO
         350             :
         351             :     ! Error check
         352             :     IF ( ERR ) THEN
         353             :        RC = HCO_FAIL
         354             :        RETURN
         355             :     ENDIF
         356             :
         357             :     ! Redistribute dust emissions across bins (L. Zhang, 6/26/15)
         358             : !$OMP PARALLEL DO                                           &
         359             : !$OMP DEFAULT( SHARED )                                     &
         360             : !$OMP PRIVATE( I, J, N )                                    &
         361             : !$OMP SCHEDULE( DYNAMIC )
         362           0 :      DO N=1,Inst%NBINS
         363           0 :      DO J=1,HcoState%NY
         364           0 :      DO I=1,HcoState%NX
         365           0 :         SELECT CASE( N )
         366             :            CASE( 1 )
         367           0 :               Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.0766d0
         368             :            CASE( 2 )
         369           0 :               Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.1924d0
         370             :            CASE( 3 )
         371           0 :               Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.3491d0
         372             :            CASE( 4 )
         373           0 :               Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.3819d0
         374             :         END SELECT
         375             :      ENDDO
         376             :      ENDDO
         377             :      ENDDO
         378             : !$OMP END PARALLEL DO
         379             :
         380             :     !=======================================================================
         381             :     ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS
         382             :     !=======================================================================
         383           0 :     DO N = 1, Inst%NBINS
         384           0 :        IF ( Inst%HcoIDs(N) > 0 ) THEN
         385             :
         386             :           ! Add flux to emission array
         387             :           CALL HCO_EmisAdd( HcoState,       Inst%FLUX(:,:,N), &
         388           0 :                             Inst%HcoIDs(N), RC,       ExtNr=Inst%ExtNr   )
         389           0 :           IF ( RC /= HCO_SUCCESS ) THEN
         390           0 :              WRITE(MSG,*) 'HCO_EmisAdd error: dust bin ', N
         391           0 :              CALL HCO_ERROR(MSG, RC )
         392           0 :              RETURN
         393             :           ENDIF
         394             :
         395             :        ENDIF
         396             :
         397             :        ! This block is only relevant if the DustAlk extension
         398             :        ! has been turned on.  Skip othewrise. (bmy, 7/7/17)
         399           0 :        IF ( Inst%ExtNrAlk > 0 ) THEN
         400           0 :           IF ( Inst%HcoIDsAlk(N) > 0 ) THEN
         401             :
         402             :              ! Add flux to emission array
         403             :              CALL HCO_EmisAdd( HcoState,          Inst%FLUX_Alk(:,:,N), &
         404           0 :                                Inst%HcoIDsAlk(N), RC, ExtNr=Inst%ExtNrAlk)
         405           0 :              IF ( RC /= HCO_SUCCESS ) THEN
         406           0 :                 WRITE(MSG,*) 'HCO_EmisAdd error: dust alkalinity bin ', N
         407           0 :                 CALL HCO_ERROR(MSG, RC )
         408           0 :                 RETURN
         409             :              ENDIF
         410             :           ENDIF
         411             :        ENDIF
         412             :
         413             :     ENDDO
         414             :
         415             :     !=======================================================================
         416             :     ! Cleanup & quit
         417             :     !=======================================================================
         418             :
         419             :     ! Nullify pointers
         420           0 :     Inst    => NULL()
         421             :
         422             :     ! Leave w/ success
         423           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
         424             :
         425           0 :   END SUBROUTINE HcoX_DustGinoux_Run
         426             : !EOC
         427             : !------------------------------------------------------------------------------
         428             : !                   Harmonized Emissions Component (HEMCO)                    !
         429             : !------------------------------------------------------------------------------
         430             : !BOP
         431             : !
         432             : ! !IROUTINE: HCOX_DustGinoux_Init
         433             : !
         434             : ! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Init initializes the HEMCO
         435             : ! DUSTGINOUX extension.
         436             : !\\
         437             : !\\
         438             : ! !INTERFACE:
         439             : !
         440           0 :   SUBROUTINE HcoX_DustGinoux_Init( HcoState, ExtName, ExtState, RC )
         441             : !
         442             : ! !USES:
         443             : !
         444             :     USE HCO_ExtList_Mod, ONLY : GetExtNr, GetExtOpt
         445             :     USE HCO_State_Mod,   ONLY : HCO_GetExtHcoID
         446             : !
         447             : ! !INPUT PARAMETERS:
         448             : !
         449             :     TYPE(HCO_State),  POINTER        :: HcoState   ! HEMCO State object
         450             :     CHARACTER(LEN=*), INTENT(IN   )  :: ExtName    ! Extension name
         451             :     TYPE(Ext_State),  POINTER        :: ExtState   ! Extension options
         452             : !
         453             : ! !INPUT/OUTPUT PARAMETERS:
         454             : !
         455             :     INTEGER,          INTENT(INOUT)  :: RC         ! Success or failure?
         456             : !
         457             : ! !REVISION HISTORY:
         458             : !  11 Dec 2013 - C. Keller   - Now a HEMCO extension
         459             : !  See https://github.com/geoschem/hemco for complete history
         460             : !EOP
         461             : !------------------------------------------------------------------------------
         462             : !BOC
         463             : !
         464             : ! !LOCAL VARIABLES:
         465             : !
         466             :     ! Scalars
         467             :     INTEGER                        :: N, AS, nSpc, nSpcAlk, ExtNr
         468             :     CHARACTER(LEN=255)             :: MSG, LOC
         469             :     REAL(dp)                       :: Mp, Rp, TmpScal
         470             :     LOGICAL                        :: FOUND
         471             :
         472             :     ! Arrays
         473           0 :     CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
         474           0 :     CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesAlk(:)
         475             :
         476             :     ! Pointers
         477             :     TYPE(MyInst), POINTER          :: Inst
         478             :
         479             :     !=======================================================================
         480             :     ! HCOX_DUSTGINOUX_INIT begins here!
         481             :     !=======================================================================
         482           0 :     LOC = 'HCOX_DUSTGINOUX_INIT (HCOX_DUSTGINOUX_MOD.F90)'
         483             :
         484             :     ! Extension Nr.
         485           0 :     ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
         486           0 :     IF ( ExtNr <= 0 ) RETURN
         487             :
         488             :     ! Create Instance
         489           0 :     Inst => NULL()
         490           0 :     CALL InstCreate ( ExtNr, ExtState%DustGinoux, Inst, RC )
         491           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         492           0 :        CALL HCO_ERROR ( 'Cannot create DustGinoux instance', RC )
         493           0 :        RETURN
         494             :     ENDIF
         495             :     ! Also fill Inst%ExtNr
         496           0 :     Inst%ExtNr = ExtNr
         497             :
         498             :     ! Check for dust alkalinity option
         499           0 :     Inst%ExtNrAlk = GetExtNr( HcoState%Config%ExtList, 'DustAlk' )
         500             :
         501             :     ! Enter
         502           0 :     CALL HCO_ENTER(HcoState%Config%Err, LOC, RC)
         503           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         504           0 :         CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
         505           0 :         RETURN
         506             :     ENDIF
         507             :
         508             :     ! Get the expected number of dust species
         509           0 :     Inst%NBINS = HcoState%nDust
         510             :
         511             :     ! Get the actual number of dust species defined for DustGinoux extension
         512             :     CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, Inst%HcoIDs, &
         513           0 :                           SpcNames, nSpc, RC )
         514           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         515           0 :         CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
         516           0 :         RETURN
         517             :     ENDIF
         518             :
         519             :     ! Get the dust alkalinity species defined for DustAlk option
         520           0 :     IF ( Inst%ExtNrAlk > 0 ) THEN
         521             :        CALL HCO_GetExtHcoID( HcoState,    Inst%ExtNrAlk, Inst%HcoIDsAlk, &
         522           0 :                              SpcNamesAlk, nSpcAlk,  RC)
         523           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         524           0 :            CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
         525           0 :            RETURN
         526             :        ENDIF
         527             :     ENDIF
         528             :
         529             :     ! Make sure the # of dust species is as expected
         530           0 :     IF ( nSpc /= Inst%NBINS ) THEN
         531           0 :        WRITE( MSG, 100 ) Inst%NBINS, nSpc
         532             :  100   FORMAT( 'Expected ', i3, ' DustGinoux species but only found ', i3, &
         533             :                ' in the HEMCO configuration file!  Exiting...' )
         534           0 :        CALL HCO_ERROR(MSG, RC )
         535           0 :        RETURN
         536             :     ENDIF
         537             :
         538             :     ! Set scale factor: first try to read from configuration file. If
         539             :     ! not specified, call wrapper function which sets teh scale factor
         540             :     ! based upon compiler switches.
         541             :     CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'Mass tuning factor', &
         542           0 :                      OptValDp=TmpScal, Found=FOUND, RC=RC )
         543           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         544           0 :         CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
         545           0 :         RETURN
         546             :     ENDIF
         547             :
         548             :     ! Set parameter FLX_MSS_FDG_FCT to specified tuning factor. Get from
         549             :     ! wrapper routine if not defined in configuration file
         550           0 :     IF ( FOUND ) THEN
         551           0 :        Inst%CH_DUST = TmpScal
         552             :     ELSE
         553             :        ! Get global mass flux tuning factor
         554           0 :        Inst%CH_DUST = HcoX_DustGinoux_GetCHDust( Inst, HcoState )
         555           0 :        IF ( Inst%CH_DUST < 0.0_dp ) THEN
         556           0 :           RC = HCO_FAIL
         557           0 :           RETURN
         558             :        ENDIF
         559             :     ENDIF
         560             :
         561             :     ! Verbose mode
         562           0 :     IF ( HcoState%amIRoot ) THEN
         563             :
         564             :        ! Write the name of the extension regardless of the verbose setting
         565           0 :        msg = 'Using HEMCO extension: DustGinoux (dust mobilization)'
         566           0 :        IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
         567           0 :           CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator
         568             :        ELSE
         569           0 :           CALL HCO_Msg( msg, verb=.TRUE.              ) ! w/o separator
         570             :        ENDIF
         571             :
         572             :        ! Write all other messages as debug printout only
         573           0 :        IF ( Inst%ExtNrAlk > 0 ) THEN
         574           0 :           MSG = 'Use dust alkalinity option'
         575           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
         576             :        ENDIF
         577             :
         578           0 :        MSG = 'Use the following species (Name: HcoID):'
         579           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
         580           0 :        DO N = 1, nSpc
         581           0 :           WRITE(MSG,*) TRIM(SpcNames(N)), ':', Inst%HcoIDs(N)
         582           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
         583             :        ENDDO
         584           0 :        IF ( Inst%ExtNrAlk > 0 ) THEN
         585           0 :           DO N = 1, nSpcAlk
         586           0 :              WRITE(MSG,*) TRIM(SpcNamesAlk(N)), ':', Inst%HcoIDsAlk(N)
         587           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
         588             :           ENDDO
         589             :        ENDIF
         590             :
         591           0 :        WRITE(MSG,*) 'Global mass flux tuning factor: ', Inst%CH_DUST
         592           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2='-')
         593             :     ENDIF
         594             :
         595             :     ! Allocate vectors holding bin-specific informations
         596           0 :     ALLOCATE ( Inst%IPOINT  (Inst%NBINS) )
         597           0 :     ALLOCATE ( Inst%FRAC_S  (Inst%NBINS) )
         598           0 :     ALLOCATE ( Inst%DUSTDEN (Inst%NBINS) )
         599           0 :     ALLOCATE ( Inst%DUSTREFF(Inst%NBINS) )
         600           0 :     ALLOCATE ( Inst%FLUX    (HcoState%NX,HcoState%NY,Inst%NBINS) )
         601           0 :     ALLOCATE ( Inst%FLUX_ALK(HcoState%NX,HcoState%NY,Inst%NBINS) )
         602             :
         603             :     ! Allocate arrays
         604             :     ALLOCATE ( Inst%SRCE_SAND ( HcoState%NX, HcoState%NY ), &
         605             :                Inst%SRCE_SILT ( HcoState%NX, HcoState%NY ), &
         606             :                Inst%SRCE_CLAY ( HcoState%NX, HcoState%NY ), &
         607           0 :                STAT = AS )
         608           0 :     IF ( AS /= 0 ) THEN
         609           0 :        CALL HCO_ERROR('Allocation error', RC )
         610           0 :        RETURN
         611             :     ENDIF
         612             :
         613             :     ! Init
         614           0 :     Inst%FLUX      = 0.0_hp
         615           0 :     Inst%FLUX_ALK  = 0.0_hp
         616           0 :     Inst%SRCE_SAND = 0.0_hp
         617           0 :     Inst%SRCE_SILT = 0.0_hp
         618           0 :     Inst%SRCE_CLAY = 0.0_hp
         619             :
         620             :
         621             :     !=======================================================================
         622             :     ! Setup for simulations that use 4 dust bins (w/ or w/o TOMAS)
         623             :     !=======================================================================
         624             :
         625             :     ! Fill bin-specific information
         626           0 :     IF ( Inst%NBINS == 4 ) THEN
         627             :
         628           0 :        Inst%IPOINT  (1:Inst%NBINS) = (/ 3,       2,       2,       2       /)
         629           0 :        Inst%FRAC_S  (1:Inst%NBINS) = (/ 0.095d0, 0.3d0,   0.3d0,   0.3d0   /)
         630           0 :        Inst%DUSTDEN (1:Inst%NBINS) = (/ 2500.d0, 2650.d0, 2650.d0, 2650.d0 /)
         631           0 :        Inst%DUSTREFF(1:Inst%NBINS) = (/ 0.73d-6, 1.4d-6,  2.4d-6,  4.5d-6  /)
         632             :
         633             :     ELSE
         634             :
         635             : #if !defined( TOMAS )
         636           0 :        MSG = 'Cannot have > 4 GINOUX dust bins unless you are using TOMAS!'
         637           0 :        CALL HCO_ERROR(MSG, RC )
         638           0 :        RETURN
         639             : #endif
         640             :
         641             :     ENDIF
         642             :
         643             : #if defined( TOMAS )
         644             :
         645             :     !=======================================================================
         646             :     ! Setup for TOMAS simulations using more than 4 dust bins
         647             :     !
         648             :     ! from Ginoux:
         649             :     ! The U.S. Department of Agriculture (USDA) defines particles
         650             :     ! with a radius between 1 um and 25 um as silt, and below 1 um
         651             :     ! as clay [Hillel, 1982]. Mineralogical silt particles are mainly
         652             :     ! composed of quartz, but they are often coated with strongly
         653             :     ! adherent clay such that their physicochemical properties are
         654             :     ! similar to clay [Hillel, 1982].
         655             :     !
         656             :     ! SRCE_FUNC Source function
         657             :     ! for 1: Sand, 2: Silt, 3: Clay
         658             :     !=======================================================================
         659             :     IF ( Inst%NBINS == HcoState%MicroPhys%nBins ) THEN
         660             :
         661             :        !--------------------------------------------------------------------
         662             :        ! Define the IPOINT array based on particle size
         663             :        !--------------------------------------------------------------------
         664             :
         665             :        ! Loop over # of TOMAS bins
         666             :        DO N = 1, HcoState%MicroPhys%nBins
         667             :
         668             :           ! Compute particle mass and radius
         669             :           Mp = 1.4 * HcoState%MicroPhys%BinBound(N)
         670             :           Rp = ( ( Mp /2500. ) * (3./(4.*HcoState%Phys%PI)))**(0.333)
         671             :
         672             :           ! Pick the source function based on particle size
         673             :           IF ( Rp < 1.d-6 ) THEN
         674             :              Inst%IPOINT(N) = 3
         675             :           ELSE
         676             :              Inst%IPOINT(N) = 2
         677             :           END IF
         678             :        END DO
         679             :
         680             :        !--------------------------------------------------------------------
         681             :        ! Set up dust density (DUSTDEN) array
         682             :        !--------------------------------------------------------------------
         683             :        DO N = 1, HcoState%MicroPhys%nBins
         684             :           IF ( HcoState%MicroPhys%BinBound(N) < 4.0D-15 ) THEN
         685             :              Inst%DUSTDEN(N)  = 2500.d0
         686             :           ELSE
         687             :              Inst%DUSTDEN(N)  = 2650.d0
         688             :           ENDIF
         689             :        ENDDO
         690             :
         691             :        !--------------------------------------------------------------------
         692             :        ! Set up dust density (DUSTDEN) array
         693             :        !--------------------------------------------------------------------
         694             :        DO N = 1, HcoState%MicroPhys%nBins
         695             :           Inst%DUSTREFF(N) = 0.5d0                                    &
         696             :                       * ( SQRT( HcoState%MicroPhys%BinBound(N) *      &
         697             :                                 HcoState%MicroPhys%BinBound(N+1) )    &
         698             :                       /   Inst%DUSTDEN(N) * 6.d0/HcoState%Phys%PI )**( 0.333d0 )
         699             :        ENDDO
         700             :
         701             :        !--------------------------------------------------------------------
         702             :        ! Set up the FRAC_S array
         703             :        !--------------------------------------------------------------------
         704             :
         705             :        ! Initialize
         706             :        Inst%FRAC_S( 1:HcoState%MicroPhys%nBins )           = 0d0
         707             :
         708             : # if  defined( TOMAS12 ) || defined( TOMAS15 )
         709             :
         710             :        !---------------------------------------------------
         711             :        ! TOMAS simulations with 12 or 15 size bins
         712             :        !---------------------------------------------------
         713             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 1  )  = 7.33E-10
         714             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 2  )  = 2.032E-08
         715             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 3  )  = 3.849E-07
         716             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 4  )  = 5.01E-06
         717             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 5  )  = 4.45E-05
         718             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 6  )  = 2.714E-04
         719             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 7  )  = 1.133E-03
         720             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 8  )  = 3.27E-03
         721             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 9  )  = 6.81E-03
         722             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 10 )  = 1.276E-02
         723             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 11 )  = 2.155E-01
         724             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 12 )  = 6.085E-01
         725             :
         726             : # else
         727             :
         728             :        !---------------------------------------------------
         729             :        ! TOMAS simulations with 30 or 40 size bins
         730             :        !---------------------------------------------------
         731             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  1 )  = 1.05d-10
         732             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  2 )  = 6.28d-10
         733             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  3 )  = 3.42d-09
         734             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  4 )  = 1.69d-08
         735             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  5 )  = 7.59d-08
         736             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  6 )  = 3.09d-07
         737             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  7 )  = 1.15d-06
         738             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  8 )  = 3.86d-06
         739             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins +  9 )  = 1.18d-05
         740             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 10 )  = 3.27d-05
         741             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 11 )  = 8.24d-05
         742             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 12 )  = 1.89d-04
         743             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 13 )  = 3.92d-04
         744             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 14 )  = 7.41d-04
         745             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 15 )  = 1.27d-03
         746             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 16 )  = 2.00d-03
         747             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 17 )  = 2.89d-03
         748             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 18 )  = 3.92d-03
         749             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 19 )  = 5.26d-03
         750             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 20 )  = 7.50d-03
         751             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 21 )  = 1.20d-02
         752             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 22 )  = 2.08d-02
         753             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 23 )  = 3.62d-02
         754             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 24 )  = 5.91d-02
         755             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 25 )  = 8.74d-02
         756             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 26 )  = 1.15d-01
         757             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 27 )  = 1.34d-01
         758             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 28 )  = 1.37d-01
         759             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 29 )  = 1.24d-01
         760             :        Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 30 )  = 9.85d-02
         761             :
         762             : # endif
         763             :
         764             :     ELSE
         765             :
         766             :        ! Stop w/ error message
         767             :        CALL HCO_ERROR( 'Wrong number of TOMAS dust bins!', RC )
         768             :
         769             :     ENDIF
         770             :
         771             : #endif
         772             :
         773             :     !=====================================================================
         774             :     ! Activate fields in ExtState used by Ginoux dust
         775             :     !=====================================================================
         776             :
         777             :     ! Activate met. fields required by this module
         778           0 :     ExtState%U10M%DoUse    = .TRUE.
         779           0 :     ExtState%V10M%DoUse    = .TRUE.
         780           0 :     ExtState%GWETTOP%DoUse = .TRUE.
         781             :
         782             :     !=======================================================================
         783             :     ! Leave w/ success
         784             :     !=======================================================================
         785           0 :     IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
         786             :
         787             :     ! Nullify pointers
         788           0 :     Inst    => NULL()
         789             :
         790           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
         791             :
         792           0 :   END SUBROUTINE HcoX_DustGinoux_Init
         793             : !EOC
         794             : !------------------------------------------------------------------------------
         795             : !                   Harmonized Emissions Component (HEMCO)                    !
         796             : !------------------------------------------------------------------------------
         797             : !BOP
         798             : !
         799             : ! !IROUTINE: HCOX_DustGinoux_Final
         800             : !
         801             : ! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Final finalizes the HEMCO
         802             : ! DUSTGINOUX extension.
         803             : !\\
         804             : !\\
         805             : ! !INTERFACE:
         806             : !
         807           0 :   SUBROUTINE HcoX_DustGinoux_Final( ExtState )
         808             : !
         809             : ! !INPUT PARAMETERS:
         810             : !
         811             :     TYPE(Ext_State),  POINTER       :: ExtState   ! Module options
         812             : !
         813             : ! !REVISION HISTORY:
         814             : !  11 Dec 2013 - C. Keller - Now a HEMCO extension
         815             : !  See https://github.com/geoschem/hemco for complete history
         816             : !EOP
         817             : !------------------------------------------------------------------------------
         818             : !BOC
         819             :
         820             :     !=======================================================================
         821             :     ! HCOX_DUSTGINOUX_FINAL begins here!
         822             :     !=======================================================================
         823             :
         824           0 :     CALL InstRemove ( ExtState%DustGinoux )
         825             :
         826             :
         827             :
         828           0 :   END SUBROUTINE HcoX_DustGinoux_Final
         829             : !EOC
         830             : !------------------------------------------------------------------------------
         831             : !                   Harmonized Emissions Component (HEMCO)                    !
         832             : !------------------------------------------------------------------------------
         833             : !BOP
         834             : !
         835             : ! !IROUTINE: HCOX_DustGinoux_GetChDust
         836             : !
         837             : ! !DESCRIPTION: Function HCOX\_DustGinoux\_GetChDust returns the CH\_DUST
         838             : ! parameter for the current simulation type.
         839             : !\\
         840             : !\\
         841             : ! !INTERFACE:
         842             : !
         843           0 :   FUNCTION HCOX_DustGinoux_GetChDust( Inst, HcoState ) RESULT( CH_DUST )
         844             : !
         845             : ! !INPUT PARAMETERS:
         846             : !
         847             :     TYPE(MyInst),    POINTER        :: Inst      ! Instance
         848             :     TYPE(HCO_State), POINTER        :: HcoState  ! Hemco state
         849             : !
         850             : ! !RETURN VALUE:
         851             : !
         852             :     REAL*8 :: CH_DUST
         853             : !
         854             : ! !REMARKS:
         855             : !  The logic in the #ifdefs may need to be cleaned up later on.  We have
         856             : !  just replicated the existing code in pre-HEMCO versions of dust_mod.F.
         857             : !
         858             : ! !REVISION HISTORY:
         859             : !  11 Dec 2013 - C. Keller   - Initial version
         860             : !  See https://github.com/geoschem/hemco for complete history
         861             : !EOP
         862             : !------------------------------------------------------------------------------
         863             : !BOC
         864             : !
         865             : ! !LOCAL VARIABLES:
         866             : !
         867             :     ! Transfer coeff for type natural source  (kg*s2/m5)
         868             :     ! Emission reduction factor for China-nested grid domain (win, 4/27/08)
         869             :
         870           0 :     IF ( TRIM(HcoState%Config%GridRes)  == '4.0x5.0'  ) THEN
         871             :
         872             :        !-----------------------------------------------------------------------
         873             :        ! All 4x5 simulations (including TOMAS)
         874             :        !-----------------------------------------------------------------------
         875           0 :        Inst%CH_DUST  = 9.375d-10
         876             :
         877             :     ELSE
         878             :
         879             :        !-----------------------------------------------------------------------
         880             :        ! All other resolutions
         881             :        !-----------------------------------------------------------------------
         882             :
         883             :        ! Start w/ same value as for 4x5
         884           0 :        Inst%CH_DUST  = 9.375d-10
         885             :
         886             : #if defined( TOMAS )
         887             :        ! KLUDGE: For TOMAS simulations at grids higher than 4x5 (e.g. 2x25),
         888             :        ! then multiplyCH_DUST by 0.75.  (Sal Farina)
         889             :        Inst%CH_DUST  = Inst%CH_DUST * 0.75d0
         890             : #endif
         891             :
         892             :     ENDIF
         893             :
         894           0 :   END FUNCTION HCOX_DustGinoux_GetChDust
         895             : !EOC
         896             : !------------------------------------------------------------------------------
         897             : !                   Harmonized Emissions Component (HEMCO)                    !
         898             : !------------------------------------------------------------------------------
         899             : !BOP
         900             : !
         901             : ! !IROUTINE: InstGet
         902             : !
         903             : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
         904             : !\\
         905             : !\\
         906             : ! !INTERFACE:
         907             : !
         908           0 :   SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
         909             : !
         910             : ! !INPUT PARAMETERS:
         911             : !
         912             :     INTEGER                             :: Instance
         913             :     TYPE(MyInst),     POINTER           :: Inst
         914             :     INTEGER                             :: RC
         915             :     TYPE(MyInst),     POINTER, OPTIONAL :: PrevInst
         916             : !
         917             : ! !REVISION HISTORY:
         918             : !  18 Feb 2016 - C. Keller   - Initial version
         919             : !  See https://github.com/geoschem/hemco for complete history
         920             : !EOP
         921             : !------------------------------------------------------------------------------
         922             : !BOC
         923             :     TYPE(MyInst),     POINTER    :: PrvInst
         924             :
         925             :     !=================================================================
         926             :     ! InstGet begins here!
         927             :     !=================================================================
         928             :
         929             :     ! Get instance. Also archive previous instance.
         930           0 :     PrvInst => NULL()
         931           0 :     Inst    => AllInst
         932           0 :     DO WHILE ( ASSOCIATED(Inst) )
         933           0 :        IF ( Inst%Instance == Instance ) EXIT
         934           0 :        PrvInst => Inst
         935           0 :        Inst    => Inst%NextInst
         936             :     END DO
         937           0 :     IF ( .NOT. ASSOCIATED( Inst ) ) THEN
         938           0 :        RC = HCO_FAIL
         939           0 :        RETURN
         940             :     ENDIF
         941             :
         942             :     ! Pass output arguments
         943           0 :     IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
         944             :
         945             :     ! Cleanup & Return
         946           0 :     PrvInst => NULL()
         947           0 :     RC = HCO_SUCCESS
         948             :
         949             :   END SUBROUTINE InstGet
         950             : !EOC
         951             : !------------------------------------------------------------------------------
         952             : !                   Harmonized Emissions Component (HEMCO)                    !
         953             : !------------------------------------------------------------------------------
         954             : !BOP
         955             : !
         956             : ! !IROUTINE: InstCreate
         957             : !
         958             : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
         959             : !\\
         960             : !\\
         961             : ! !INTERFACE:
         962             : !
         963           0 :   SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
         964             : !
         965             : ! !INPUT PARAMETERS:
         966             : !
         967             :     INTEGER,       INTENT(IN)       :: ExtNr
         968             : !
         969             : ! !OUTPUT PARAMETERS:
         970             : !
         971             :     INTEGER,       INTENT(  OUT)    :: Instance
         972             :     TYPE(MyInst),  POINTER          :: Inst
         973             : !
         974             : ! !INPUT/OUTPUT PARAMETERS:
         975             : !
         976             :     INTEGER,       INTENT(INOUT)    :: RC
         977             : !
         978             : ! !REVISION HISTORY:
         979             : !  18 Feb 2016 - C. Keller   - Initial version
         980             : !  See https://github.com/geoschem/hemco for complete history
         981             : !EOP
         982             : !------------------------------------------------------------------------------
         983             : !BOC
         984             :     TYPE(MyInst), POINTER          :: TmpInst
         985             :     INTEGER                        :: nnInst
         986             :
         987             :     !=================================================================
         988             :     ! InstCreate begins here!
         989             :     !=================================================================
         990             :
         991             :     ! ----------------------------------------------------------------
         992             :     ! Generic instance initialization
         993             :     ! ----------------------------------------------------------------
         994             :
         995             :     ! Initialize
         996           0 :     Inst => NULL()
         997             :
         998             :     ! Get number of already existing instances
         999           0 :     TmpInst => AllInst
        1000           0 :     nnInst = 0
        1001           0 :     DO WHILE ( ASSOCIATED(TmpInst) )
        1002           0 :        nnInst  =  nnInst + 1
        1003           0 :        TmpInst => TmpInst%NextInst
        1004             :     END DO
        1005             :
        1006             :     ! Create new instance
        1007           0 :     ALLOCATE(Inst)
        1008           0 :     Inst%Instance = nnInst + 1
        1009           0 :     Inst%ExtNr    = ExtNr
        1010             :
        1011             :     ! Attach to instance list
        1012           0 :     Inst%NextInst => AllInst
        1013           0 :     AllInst       => Inst
        1014             :
        1015             :     ! Update output instance
        1016           0 :     Instance = Inst%Instance
        1017             :
        1018             :     ! ----------------------------------------------------------------
        1019             :     ! Type specific initialization statements follow below
        1020             :     ! ----------------------------------------------------------------
        1021             :
        1022             :     ! Return w/ success
        1023           0 :     RC = HCO_SUCCESS
        1024             :
        1025           0 :   END SUBROUTINE InstCreate
        1026             : !EOC
        1027             : !------------------------------------------------------------------------------
        1028             : !                   Harmonized Emissions Component (HEMCO)                    !
        1029             : !------------------------------------------------------------------------------
        1030             : !BOP
        1031             : !BOP
        1032             : !
        1033             : ! !IROUTINE: InstRemove
        1034             : !
        1035             : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
        1036             : !\\
        1037             : !\\
        1038             : ! !INTERFACE:
        1039             : !
        1040           0 :   SUBROUTINE InstRemove ( Instance )
        1041             : !
        1042             : ! !INPUT PARAMETERS:
        1043             : !
        1044             :     INTEGER                         :: Instance
        1045             : !
        1046             : ! !REVISION HISTORY:
        1047             : !  18 Feb 2016 - C. Keller   - Initial version
        1048             : !  See https://github.com/geoschem/hemco for complete history
        1049             : !EOP
        1050             : !------------------------------------------------------------------------------
        1051             : !BOC
        1052             :     INTEGER                     :: RC
        1053             :     TYPE(MyInst), POINTER       :: PrevInst
        1054             :     TYPE(MyInst), POINTER       :: Inst
        1055             :
        1056             :     !=================================================================
        1057             :     ! InstRemove begins here!
        1058             :     !=================================================================
        1059             :
        1060             :     ! Init
        1061           0 :     PrevInst => NULL()
        1062           0 :     Inst     => NULL()
        1063             :
        1064             :     ! Get instance. Also archive previous instance.
        1065           0 :     CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
        1066             :
        1067             :     ! Instance-specific deallocation
        1068           0 :     IF ( ASSOCIATED(Inst) ) THEN
        1069             :
        1070             :        !---------------------------------------------------------------------
        1071             :        ! Deallocate fields of Inst before popping Inst off the list
        1072             :        ! in order to avoid memory leaks (Bob Yantosca, 17 Aug 2020)
        1073             :        !---------------------------------------------------------------------
        1074           0 :        IF ( ASSOCIATED( Inst%SRCE_SAND ) ) THEN
        1075           0 :           DEALLOCATE( Inst%SRCE_SAND )
        1076             :        ENDIF
        1077           0 :        Inst%SRCE_SAND => NULL()
        1078             :
        1079           0 :        IF ( ASSOCIATED( Inst%SRCE_SILT ) ) THEN
        1080           0 :           DEALLOCATE( Inst%SRCE_SILT )
        1081             :        ENDIF
        1082           0 :        Inst%SRCE_SILT => NULL()
        1083             :
        1084           0 :        IF ( ASSOCIATED( Inst%SRCE_CLAY ) ) THEN
        1085           0 :           DEALLOCATE( Inst%SRCE_CLAY )
        1086             :        ENDIF
        1087           0 :        Inst%SRCE_CLAY  => NULL()
        1088             :
        1089           0 :        IF ( ASSOCIATED( Inst%IPOINT ) ) THEN
        1090           0 :           DEALLOCATE( Inst%IPOINT )
        1091             :        ENDIF
        1092           0 :        Inst%IPOINT => NULL()
        1093             :
        1094           0 :        IF ( ASSOCIATED( Inst%FRAC_S ) ) THEN
        1095           0 :           DEALLOCATE( Inst%FRAC_S )
        1096             :        ENDIf
        1097           0 :        Inst%FRAC_S => NULL()
        1098             :
        1099           0 :        IF ( ASSOCIATED( Inst%DUSTDEN ) ) THEN
        1100           0 :           DEALLOCATE( Inst%DUSTDEN   )
        1101             :        ENDIF
        1102           0 :        Inst%DUSTDEN => NULL()
        1103             :
        1104           0 :        IF ( ASSOCIATED( Inst%DUSTREFF ) ) THEN
        1105           0 :           DEALLOCATE( Inst%DUSTREFF )
        1106             :        ENDIF
        1107           0 :        Inst%DUSTREFF => NULL()
        1108             :
        1109           0 :        IF ( ASSOCIATED( Inst%FLUX ) ) THEN
        1110           0 :           DEALLOCATE( Inst%FLUX )
        1111             :        ENDIF
        1112           0 :        Inst%FLUX => NULL()
        1113             :
        1114           0 :        IF ( ASSOCIATED( Inst%FLUX_ALK  ) ) THEN
        1115           0 :           DEALLOCATE( Inst%FLUX_ALK )
        1116             :        ENDIF
        1117           0 :        Inst%FLUX_ALK   => NULL()
        1118             :
        1119           0 :        IF ( ALLOCATED ( Inst%HcoIDs ) ) THEN
        1120           0 :           DEALLOCATE( Inst%HcoIDs  )
        1121             :        ENDIF
        1122             :
        1123           0 :        IF ( ALLOCATED ( Inst%HcoIDsALK ) ) THEN
        1124           0 :           DEALLOCATE( Inst%HcoIDsALK )
        1125             :        ENDIF
        1126             :
        1127             :        !---------------------------------------------------------------------
        1128             :        ! Pop off instance from list
        1129             :        !---------------------------------------------------------------------
        1130           0 :        IF ( ASSOCIATED(PrevInst) ) THEN
        1131           0 :           PrevInst%NextInst => Inst%NextInst
        1132             :        ELSE
        1133           0 :           AllInst => Inst%NextInst
        1134             :        ENDIF
        1135           0 :        DEALLOCATE(Inst)
        1136             :     ENDIF
        1137             :
        1138             :     ! Free pointers before exiting
        1139           0 :     PrevInst => NULL()
        1140           0 :     Inst     => NULL()
        1141             :
        1142           0 :    END SUBROUTINE InstRemove
        1143             : !EOC
        1144           0 : END MODULE HCOX_DustGinoux_Mod

Generated by: LCOV version 1.14