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

          Line data    Source code
       1             : !------------------------------------------------------------------------------
       2             : !                   Harmonized Emissions Component (HEMCO)                    !
       3             : !------------------------------------------------------------------------------
       4             : !BOP
       5             : !
       6             : ! !MODULE: hco_interp_mod.F90
       7             : !
       8             : ! !DESCRIPTION: Module HCO\_INTERP\_MOD contains routines to interpolate
       9             : ! input data onto the HEMCO grid. This module contains routine for
      10             : ! horizontal regridding between regular grids (MAP\_A2A), as well as
      11             : ! vertical interpolation amongst GEOS model levels (full <--> reduced).
      12             : !\\
      13             : !\\
      14             : ! Regridding is supported for concentration quantities (default) and
      15             : ! index-based values. For the latter, the values in the regridded grid
      16             : ! boxes correspond to the value of the original grid that contrbutes most
      17             : ! to the given box.
      18             : !\\
      19             : !\\
      20             : ! !INTERFACE:
      21             : !
      22             : MODULE HCO_Interp_Mod
      23             : !
      24             : ! !USES:
      25             : !
      26             :   USE HCO_Types_Mod
      27             :   USE HCO_Error_Mod
      28             :   USE HCO_State_Mod, ONLY : Hco_State
      29             : 
      30             :   IMPLICIT NONE
      31             :   PRIVATE
      32             : !
      33             : ! !PUBLIC MEMBER FUNCTIONS:
      34             : !
      35             :   PUBLIC  :: ModelLev_Check
      36             :   PUBLIC  :: ModelLev_Interpolate
      37             :   PUBLIC  :: REGRID_MAPA2A
      38             : !
      39             : ! !PUBLIC MEMBER FUNCTIONS:
      40             : !
      41             :   PRIVATE :: GEOS5_TO_GEOS4_LOWLEV
      42             :   PRIVATE :: COLLAPSE
      43             :   PRIVATE :: INFLATE
      44             : !
      45             : ! !REVISION HISTORY:
      46             : !  30 Dec 2014 - C. Keller - Initialization
      47             : !  See https://github.com/geoschem/hemco for complete history
      48             : !EOP
      49             : !------------------------------------------------------------------------------
      50             : !BOC
      51             : !
      52             : ! !PRIVATE VARIABLES:
      53             : !
      54             :   ! AP parameter of native GEOS-5 grid. Needed to remap GEOS-5 data from native
      55             :   ! onto the reduced vertical grid.
      56             :   REAL(hp), TARGET :: G5_EDGE_NATIVE(73) = (/                          &
      57             :               0.000000e+00_hp, 4.804826e-02_hp, 6.593752e+00_hp, 1.313480e+01_hp, &
      58             :               1.961311e+01_hp, 2.609201e+01_hp, 3.257081e+01_hp, 3.898201e+01_hp, &
      59             :               4.533901e+01_hp, 5.169611e+01_hp, 5.805321e+01_hp, 6.436264e+01_hp, &
      60             :               7.062198e+01_hp, 7.883422e+01_hp, 8.909992e+01_hp, 9.936521e+01_hp, &
      61             :               1.091817e+02_hp, 1.189586e+02_hp, 1.286959e+02_hp, 1.429100e+02_hp, &
      62             :               1.562600e+02_hp, 1.696090e+02_hp, 1.816190e+02_hp, 1.930970e+02_hp, &
      63             :               2.032590e+02_hp, 2.121500e+02_hp, 2.187760e+02_hp, 2.238980e+02_hp, &
      64             :               2.243630e+02_hp, 2.168650e+02_hp, 2.011920e+02_hp, 1.769300e+02_hp, &
      65             :               1.503930e+02_hp, 1.278370e+02_hp, 1.086630e+02_hp, 9.236572e+01_hp, &
      66             :               7.851231e+01_hp, 6.660341e+01_hp, 5.638791e+01_hp, 4.764391e+01_hp, &
      67             :               4.017541e+01_hp, 3.381001e+01_hp, 2.836781e+01_hp, 2.373041e+01_hp, &
      68             :               1.979160e+01_hp, 1.645710e+01_hp, 1.364340e+01_hp, 1.127690e+01_hp, &
      69             :               9.292942e+00_hp, 7.619842e+00_hp, 6.216801e+00_hp, 5.046801e+00_hp, &
      70             :               4.076571e+00_hp, 3.276431e+00_hp, 2.620211e+00_hp, 2.084970e+00_hp, &
      71             :               1.650790e+00_hp, 1.300510e+00_hp, 1.019440e+00_hp, 7.951341e-01_hp, &
      72             :               6.167791e-01_hp, 4.758061e-01_hp, 3.650411e-01_hp, 2.785261e-01_hp, &
      73             :               2.113490e-01_hp, 1.594950e-01_hp, 1.197030e-01_hp, 8.934502e-02_hp, &
      74             :               6.600001e-02_hp, 4.758501e-02_hp, 3.270000e-02_hp, 2.000000e-02_hp, &
      75             :               1.000000e-02_hp /)
      76             : 
      77             :   ! AP parameter of native GEOS-4 grid. Needed to remap GEOS-4 data from native
      78             :   ! onto the reduced vertical grid.
      79             :   REAL(hp), TARGET :: G4_EDGE_NATIVE(56) = (/       &
      80             :                     0.000000_hp,   0.000000_hp,  12.704939_hp, &
      81             :                    35.465965_hp,  66.098427_hp, 101.671654_hp, &
      82             :                   138.744400_hp, 173.403183_hp, 198.737839_hp, &
      83             :                   215.417526_hp, 223.884689_hp, 224.362869_hp, &
      84             :                   216.864929_hp, 201.192093_hp, 176.929993_hp, &
      85             :                   150.393005_hp, 127.837006_hp, 108.663429_hp, &
      86             :                    92.365662_hp,  78.512299_hp,  66.603378_hp, &
      87             :                    56.387939_hp,  47.643932_hp,  40.175419_hp, &
      88             :                    33.809956_hp,  28.367815_hp,  23.730362_hp, &
      89             :                    19.791553_hp,  16.457071_hp,  13.643393_hp, &
      90             :                    11.276889_hp,   9.292943_hp,   7.619839_hp, &
      91             :                     6.216800_hp,   5.046805_hp,   4.076567_hp, &
      92             :                     3.276433_hp,   2.620212_hp,   2.084972_hp, &
      93             :                     1.650792_hp,   1.300508_hp,   1.019442_hp, &
      94             :                     0.795134_hp,   0.616779_hp,   0.475806_hp, &
      95             :                     0.365041_hp,   0.278526_hp,   0.211349_hp, &
      96             :                     0.159495_hp,   0.119703_hp,   0.089345_hp, &
      97             :                     0.066000_hp,   0.047585_hp,   0.032700_hp, &
      98             :                     0.020000_hp,   0.010000_hp /)
      99             : 
     100             :   ! AP parameter of native 102-layer GISS grid
     101             :   REAL(hp), TARGET :: E102_EDGE_NATIVE(103) = (/                                            &
     102             :                 0.0000000,   2.7871507,   5.5743014,   8.3614521,  11.1486028, 13.9357536,  &
     103             :                16.7229043,  19.5100550,  22.2972057,  25.0843564,  27.8715071, 30.6586578,  &
     104             :                33.4458085,  36.2329593,  39.0201100,  41.8087123,  44.6089278, 47.4534183,  &
     105             :                50.4082336,  53.5662786,  57.0095710,  60.7533531,  64.7323011, 68.8549615,  &
     106             :                73.0567364,  77.2969797,  81.5364973,  85.7346430,  89.8565776, 93.8754457,  &
     107             :                97.7709243, 101.5277712, 105.1350991, 108.5878272, 111.8859556, 115.0302100, &
     108             :               118.0249453, 120.8854039, 123.6326345, 126.2811535, 128.8360417, 131.2987506, &
     109             :               133.6736353, 135.9708571, 138.2013035, 140.3700552, 142.4814670, 144.5457005, &
     110             :               146.5692881, 148.5464231, 150.4712991, 152.3497225, 154.1875000, 144.5468750, &
     111             :               135.1875000, 126.0781250, 117.1914062, 108.5859375, 100.3671875, 92.5898438,  &
     112             :                85.2265625,  78.2226562,  71.5546875,  65.2226562,  59.2226562, 53.5546875,  &
     113             :                48.2226562,  43.2226562,  38.5546875,  34.2226562,  30.2226562, 26.5507812,  &
     114             :                23.1875000,  20.0781250,  17.1896562,  14.5684375,  12.2865742, 10.3573086,  &
     115             :                 8.7353750,   7.3664922,   6.2100156,   5.2343633,   4.4119297, 3.7186797,   &
     116             :                 3.1341479,   2.6404328,   2.2207877,   1.8587369,   1.5477125, 1.2782115,   &
     117             :                 1.0427319,   0.8367716,   0.6514691,   0.4772511,   0.3168814, 0.1785988,   &
     118             :                 0.1000000,   0.0560000,   0.0320000,   0.0180000,   0.0100000, 0.0050000,   &
     119             :                 0.0020000 /)
     120             : 
     121             : CONTAINS
     122             : !EOC
     123             : !------------------------------------------------------------------------------
     124             : !                   Harmonized Emissions Component (HEMCO)                    !
     125             : !------------------------------------------------------------------------------
     126             : !BOP
     127             : !
     128             : ! !IROUTINE: Regrid_MAPA2A
     129             : !
     130             : ! !DESCRIPTION: Subroutine Regrid\_MAPA2A regrids input array NcArr onto
     131             : ! the simulation grid and stores the data in list container Lct. Horizontal
     132             : ! regridding is performed using MAP\_A2A algorithm. Vertical interpolation
     133             : ! between GEOS levels (full vs. reduced, GEOS-5 vs. GEOS-4), is also
     134             : ! supported.
     135             : !\\
     136             : !\\
     137             : ! This routine can remap concentrations and index-based quantities.
     138             : !\\
     139             : !\\
     140             : ! !INTERFACE:
     141             : !
     142           0 :   SUBROUTINE REGRID_MAPA2A( HcoState, NcArr, LonE, LatE, Lct, RC )
     143             : !
     144             : ! !USES:
     145             : !
     146             :     USE HCO_REGRID_A2A_Mod, ONLY : MAP_A2A
     147             :     USE HCO_FileData_Mod,   ONLY : FileData_ArrCheck
     148             :     USE HCO_UNIT_MOD,       ONLY : HCO_IsIndexData
     149             : !
     150             : ! !INPUT PARAMETERS:
     151             : !
     152             :     TYPE(HCO_State),  POINTER        :: HcoState          ! HEMCO state object
     153             :     REAL(sp),         POINTER        :: NcArr(:,:,:,:)    ! 4D input data
     154             :     REAL(hp),         POINTER        :: LonE(:)           ! Input grid longitude edges
     155             :     REAL(hp),         POINTER        :: LatE(:)           ! Input grid latitude edges
     156             : !
     157             : ! !INPUT/OUTPUT PARAMETERS:
     158             : !
     159             :     TYPE(ListCont),   POINTER        :: Lct               ! HEMCO list container
     160             :     INTEGER,          INTENT(INOUT)  :: RC                ! Success or failure?
     161             : !
     162             : ! !REVISION HISTORY:
     163             : !  03 Feb 2015 - C. Keller   - Initial version
     164             : !  See https://github.com/geoschem/hemco for complete history
     165             : !EOP
     166             : !------------------------------------------------------------------------------
     167             : !BOC
     168             : !
     169             : ! !LOCAL VARIABLES:
     170             : !
     171             :     INTEGER                 :: nLonEdge, nLatEdge
     172             :     INTEGER                 :: NX, NY, NZ, NLEV, NTIME, NCELLS
     173             :     INTEGER                 :: I, J, L, T, AS, I2
     174             :     INTEGER                 :: nIndex
     175           0 :     REAL(sp), ALLOCATABLE   :: LonEdgeI(:)
     176           0 :     REAL(sp), ALLOCATABLE   :: LatEdgeI(:)
     177           0 :     REAL(sp)                :: LonEdgeO(HcoState%NX+1)
     178           0 :     REAL(sp)                :: LatEdgeO(HcoState%NY+1)
     179             : 
     180           0 :     REAL(sp), POINTER       :: ORIG_2D(:,:)
     181           0 :     REAL(sp), POINTER       :: REGR_2D(:,:)
     182           0 :     REAL(sp), POINTER       :: REGR_4D(:,:,:,:)
     183             : 
     184           0 :     REAL(sp), ALLOCATABLE, TARGET :: FRACS(:,:,:,:)
     185           0 :     REAL(hp), ALLOCATABLE         :: REGFRACS(:,:,:,:)
     186           0 :     REAL(hp), ALLOCATABLE         :: MAXFRACS(:,:,:,:)
     187           0 :     REAL(hp), ALLOCATABLE         :: INDECES(:,:,:,:)
     188           0 :     REAL(hp), ALLOCATABLE         :: UNIQVALS(:)
     189             :     REAL(hp)                      :: IVAL
     190             :     LOGICAL                       :: IsIndex
     191             : 
     192             :     LOGICAL                 :: VERB
     193             :     CHARACTER(LEN=255)      :: MSG
     194             :     CHARACTER(LEN=255)      :: LOC = 'ModelLev_Interpolate (hco_interp_mod.F90)'
     195             : 
     196             :     !=================================================================
     197             :     ! REGRID_MAPA2A begins here
     198             :     !=================================================================
     199             : 
     200             :     ! Init
     201           0 :     ORIG_2D => NULL()
     202           0 :     REGR_2D => NULL()
     203           0 :     REGR_4D => NULL()
     204             : 
     205             :     ! Check for verbose mode
     206           0 :     verb = HCO_IsVerb(HcoState%Config%Err,  3 )
     207             : 
     208             :     ! get longitude / latitude sizes
     209           0 :     nLonEdge = SIZE(LonE,1)
     210           0 :     nLatEdge = SIZE(LatE,1)
     211             : 
     212             :     ! Write input grid edges to shadow variables so that map_a2a accepts them
     213             :     ! as argument.
     214             :     ! Also, for map_a2a, latitudes have to be sines...
     215           0 :     ALLOCATE(LonEdgeI(nlonEdge), LatEdgeI(nlatEdge), STAT=AS )
     216           0 :     IF ( AS /= 0 ) THEN
     217           0 :        CALL HCO_ERROR( 'alloc error LonEdgeI/LatEdgeI', RC, THISLOC=LOC )
     218           0 :        RETURN
     219             :     ENDIF
     220           0 :     LonEdgeI(:) = LonE
     221           0 :     LatEdgeI(:) = SIN( LatE * HcoState%Phys%PI_180 )
     222             : 
     223             :     ! Get output grid edges from HEMCO state
     224           0 :     LonEdgeO(:) = HcoState%Grid%XEDGE%Val(:,1)
     225           0 :     LatEdgeO(:) = HcoState%Grid%YSIN%Val(1,:)
     226             : 
     227             :     ! Get input array sizes
     228           0 :     NX     = size(ncArr,1)
     229           0 :     NY     = size(ncArr,2)
     230           0 :     NLEV   = size(ncArr,3)
     231           0 :     NTIME  = size(ncArr,4)
     232           0 :     NCELLS = NX * NY * NLEV * NTIME
     233             : 
     234             :     ! Are these index-based data? If so, need to remap the fraction (1 or 0)
     235             :     ! of every value independently. For every grid box, the value with the
     236             :     ! highest overlap (closest to 1) is taken.
     237           0 :     IsIndex = HCO_IsIndexData(Lct%Dct%Dta%OrigUnit)
     238             : 
     239           0 :     IF ( IsIndex ) THEN
     240             : 
     241             :        ! Allocate working arrays:
     242             :        ! - FRACS contains the fractions on the original grid. These are
     243             :        !   binary (1 or 0).
     244             :        ! - MAXFRACS stores the highest used fraction for each output grid
     245             :        !   box. Will be updated continously.
     246             :        ! - INDECES is the output array holding the index-based remapped
     247             :        !   values. Will be updated continuously.
     248             :        ! - UNIQVALS is a vector holding all unique values of the input
     249             :        !   array (NINDEX is the number of unique values).
     250             :        !
     251             :        ! ckeller, 9/24/15: Extend vertical axis of MAXFRACS, REGFRACS, and
     252             :        ! INDECES to HcoState%NZ+1 for fields that are on edges instead of
     253             :        ! mid-points.
     254           0 :        ALLOCATE( FRACS(NX,NY,NLEV,NTIME), STAT=AS )
     255           0 :        IF ( AS /= 0 ) THEN
     256           0 :           CALL HCO_ERROR( 'alloc error FRACS', RC, THISLOC=LOC )
     257           0 :           RETURN
     258             :        ENDIF
     259           0 :        ALLOCATE( MAXFRACS(HcoState%NX,HcoState%NY,HcoState%NZ+1,NTIME), STAT=AS )
     260           0 :        IF ( AS /= 0 ) THEN
     261           0 :           CALL HCO_ERROR( 'alloc error MAXFRACS', RC, THISLOC=LOC )
     262           0 :           RETURN
     263             :        ENDIF
     264           0 :        ALLOCATE( REGFRACS(HcoState%NX,HcoState%NY,HcoState%NZ+1,NTIME), STAT=AS )
     265           0 :        IF ( AS /= 0 ) THEN
     266           0 :           CALL HCO_ERROR( 'alloc error INDECES', RC, THISLOC=LOC )
     267           0 :           RETURN
     268             :        ENDIF
     269           0 :        ALLOCATE( INDECES(HcoState%NX,HcoState%NY,HcoState%NZ+1,NTIME), STAT=AS )
     270           0 :        IF ( AS /= 0 ) THEN
     271           0 :           CALL HCO_ERROR( 'alloc error INDECES', RC, THISLOC=LOC )
     272           0 :           RETURN
     273             :        ENDIF
     274           0 :        ALLOCATE( UNIQVALS(NCELLS), STAT=AS )
     275           0 :        IF ( AS /= 0 ) THEN
     276           0 :           CALL HCO_ERROR( 'alloc error INDECES', RC, THISLOC=LOC )
     277           0 :           RETURN
     278             :        ENDIF
     279           0 :        FRACS    = 0.0_sp
     280           0 :        REGFRACS = 0.0_hp
     281           0 :        MAXFRACS = 0.0_hp
     282           0 :        INDECES  = 0.0_hp
     283           0 :        UNIQVALS = 0.0_hp
     284             : 
     285             :        ! Get unique values. Loop over all input data values and add
     286             :        ! them to UNIQVALS vector if UNIQVALS doesn't hold that same value
     287             :        ! yet.
     288           0 :        NINDEX = 0
     289           0 :        DO T = 1, NTIME
     290           0 :        DO L = 1, NLEV
     291           0 :        DO J = 1, NY
     292           0 :        DO I = 1, NX
     293             : 
     294             :           ! Current value
     295           0 :           IVAL = NcArr(I,J,L,T)
     296             : 
     297             :           ! Check if value already exists in UNIQVALS
     298           0 :           IF ( NINDEX > 0 ) THEN
     299           0 :              IF ( ANY(UNIQVALS(1:NINDEX) == IVAL) ) CYCLE
     300             :           ENDIF
     301             : 
     302             :           ! Add to UNIQVALS
     303           0 :           NINDEX = NINDEX + 1
     304           0 :           UNIQVALS(NINDEX) = IVAL
     305             :        ENDDO
     306             :        ENDDO
     307             :        ENDDO
     308             :        ENDDO
     309             : 
     310             :        ! Verbose mode
     311           0 :        IF ( verb ) THEN
     312           0 :           MSG = 'Do index based regridding for field ' // TRIM(Lct%Dct%cName)
     313           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     314           0 :           WRITE(MSG,*) '   - Number of indeces: ', NINDEX
     315           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     316             :        ENDIF
     317             : 
     318             :     ELSE
     319           0 :        NINDEX = 1
     320             :     ENDIF
     321             : 
     322             :     ! Define array to put horizontally regridded data onto. If this
     323             :     ! is 3D data, we first regrid all vertical levels horizontally
     324             :     ! and then pass these data to the list container. In this second
     325             :     ! step, levels may be deflated/collapsed.
     326             : 
     327             :     ! 2D data is directly passed to the data container
     328           0 :     IF ( Lct%Dct%Dta%SpaceDim <= 2 ) THEN
     329             :        CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, &
     330           0 :                                HcoState%NX, HcoState%NY, NTIME, RC )
     331           0 :        IF ( RC /= 0 ) RETURN
     332             :     ENDIF
     333             : 
     334             :     ! 3D data and index data is first written into a temporary array,
     335             :     ! REGR_4D.
     336           0 :     IF ( Lct%Dct%Dta%SpaceDim == 3 .OR. IsIndex ) THEN
     337           0 :        ALLOCATE( REGR_4D(HcoState%NX,HcoState%NY,NLEV,NTIME), STAT=AS )
     338             :        IF ( AS /= 0 ) THEN
     339           0 :           CALL HCO_ERROR( 'alloc error REGR_4D', RC, THISLOC=LOC )
     340           0 :           RETURN
     341             :        ENDIF
     342           0 :        REGR_4D = 0.0_hp
     343             :     ENDIF
     344             : 
     345             :     ! Do regridding for every index value. If it's not index data, this loop
     346             :     ! is executed only once (NINDEX=1).
     347           0 :     DO I = 1, NINDEX
     348             : 
     349             :        ! For index based data, create fractions array for the given index.
     350           0 :        IF ( IsIndex ) THEN
     351           0 :           IVAL = UNIQVALS(I)
     352           0 :           WHERE( ncArr == IVAL )
     353             :              FRACS = 1.0_sp
     354             :           ELSEWHERE
     355             :              FRACS = 0.0_sp
     356             :           END WHERE
     357             :        ENDIF
     358             : 
     359             :        ! Regrid horizontally
     360           0 :        DO T = 1, NTIME
     361           0 :        DO L = 1, NLEV
     362             : 
     363             :           ! Point to 2D slices to be regridded:
     364             :           ! - Original 2D array
     365           0 :           IF ( IsIndex ) THEN
     366           0 :             ORIG_2D => FRACS(:,:,L,T)
     367             :           ELSE
     368           0 :             ORIG_2D => ncArr(:,:,L,T)
     369             :           ENDIF
     370             : 
     371             :           ! - Regridded 2D array
     372           0 :           IF ( Lct%Dct%Dta%SpaceDim <= 2 .AND. .NOT. IsIndex ) THEN
     373           0 :              REGR_2D => Lct%Dct%Dta%V2(T)%Val(:,:)
     374             :           ELSE
     375           0 :              REGR_2D => REGR_4D(:,:,L,T)
     376             :           ENDIF
     377             : 
     378             :           ! Do the regridding
     379             :           CALL MAP_A2A( NX,      NY, LonEdgeI,    LatEdgeI, ORIG_2D,  &
     380             :                         HcoState%NX, HcoState%NY, LonEdgeO, LatEdgeO, &
     381           0 :                         REGR_2D, 0, 0, HCO_MISSVAL )
     382           0 :           ORIG_2D => NULL()
     383           0 :           REGR_2D => NULL()
     384             : 
     385             :        ENDDO !L
     386             :        ENDDO !T
     387             : 
     388             :        ! Eventually inflate/collapse levels onto simulation levels.
     389           0 :        IF ( Lct%Dct%Dta%SpaceDim == 3 ) THEN
     390           0 :           CALL ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC )
     391           0 :           IF ( RC /= HCO_SUCCESS ) THEN
     392           0 :               CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
     393           0 :               RETURN
     394             :           ENDIF
     395             :        ENDIF
     396             : 
     397             :        ! For index based data, map fractions back to corresponding value.
     398             :        ! Array INDECES holds the index-based remapped values. Set INDECES
     399             :        ! to current index value in every grid box where the regridded
     400             :        ! fraction of this index is higher than any previous fraction
     401             :        ! (array MAXFRACS stores the highest used fraction in each grid box).
     402           0 :        IF ( IsIndex ) THEN
     403             : 
     404             :           ! Reset
     405           0 :           REGFRACS = 0.0_hp
     406             : 
     407             :           ! 3D data written to Lct needs to be mapped back onto REGR_4D.
     408           0 :           IF ( Lct%Dct%Dta%SpaceDim == 3 ) THEN
     409           0 :              DO T = 1, NTIME
     410           0 :                 NZ = SIZE(Lct%Dct%Dta%V3(T)%Val,3)
     411           0 :                 REGFRACS(:,:,1:NZ,T) = Lct%Dct%Dta%V3(T)%Val(:,:,:)
     412             :              ENDDO
     413             :           ELSE
     414           0 :              REGFRACS(:,:,1:NLEV,:) = REGR_4D(:,:,:,:)
     415             :           ENDIF
     416             : 
     417             :           ! REGR_4D are the remapped fractions.
     418           0 :           DO T  = 1, NTIME
     419           0 :           DO L  = 1, HcoState%NZ
     420           0 :           DO J  = 1, HcoState%NY
     421           0 :           DO I2 = 1, HcoState%NX
     422           0 :              IF ( REGFRACS(I2,J,L,T) > MAXFRACS(I2,J,L,T) ) THEN
     423           0 :                 MAXFRACS(I2,J,L,T) = REGR_4D(I2,J,L,T)
     424           0 :                 INDECES (I2,J,L,T) = IVAL
     425             :              ENDIF
     426             :           ENDDO
     427             :           ENDDO
     428             :           ENDDO
     429             :           ENDDO
     430             : 
     431             : !------------------------------------------------------------------------------
     432             : ! Prior to 9/29/16:
     433             : !          ! This code is preblematic in Gfortran.  Replace it with the
     434             : !          ! explicit DO loops above.  Leave this here for reference.
     435             : !          ! (sde, bmy, 9/21/16)
     436             : !          WHERE ( REGFRACS > MAXFRACS )
     437             : !             MAXFRACS = REGR_4D
     438             : !             INDECES  = IVAL
     439             : !          END WHERE
     440             : !------------------------------------------------------------------------------
     441             :        ENDIF
     442             : 
     443             :     ENDDO !I
     444             : 
     445             :     ! For index values, pass index data to data container.
     446           0 :     IF ( IsIndex ) THEN
     447           0 :        IF ( Lct%Dct%Dta%SpaceDim == 3 ) THEN
     448           0 :           DO T = 1, NTIME
     449           0 :              NZ = SIZE(Lct%Dct%Dta%V3(T)%Val,3)
     450           0 :              Lct%Dct%Dta%V3(T)%Val(:,:,:) = INDECES(:,:,1:NZ,T)
     451             :           ENDDO
     452             :        ELSE
     453           0 :           DO T = 1, NTIME
     454           0 :              Lct%Dct%Dta%V2(T)%Val(:,:)   = INDECES(:,:,1,T)
     455             :           ENDDO
     456             :        ENDIF
     457             :     ENDIF
     458             : 
     459             :     ! Cleanup
     460           0 :     DEALLOCATE(LonEdgeI, LatEdgeI)
     461           0 :     IF ( ASSOCIATED( REGR_4D  ) ) DEALLOCATE( REGR_4D  )
     462           0 :     IF ( ALLOCATED ( FRACS    ) ) DEALLOCATE( FRACS    )
     463           0 :     IF ( ALLOCATED ( REGFRACS ) ) DEALLOCATE( REGFRACS )
     464           0 :     IF ( ALLOCATED ( MAXFRACS ) ) DEALLOCATE( MAXFRACS )
     465           0 :     IF ( ALLOCATED ( INDECES  ) ) DEALLOCATE( INDECES  )
     466           0 :     IF ( ALLOCATED ( UNIQVALS ) ) DEALLOCATE( UNIQVALS )
     467             : 
     468             :     ! Return w/ success
     469           0 :     RC = HCO_SUCCESS
     470             : 
     471           0 :   END SUBROUTINE REGRID_MAPA2A
     472             : !EOC
     473             : !------------------------------------------------------------------------------
     474             : !                   Harmonized Emissions Component (HEMCO)                    !
     475             : !------------------------------------------------------------------------------
     476             : !BOP
     477             : !
     478             : ! !IROUTINE: ModelLev_Check
     479             : !
     480             : ! !DESCRIPTION: Subroutine ModelLev\_Check checks if the passed number of
     481             : ! vertical levels indicates that these are model levels or not.
     482             : !\\
     483             : !\\
     484             : ! !INTERFACE:
     485             : !
     486           0 :   SUBROUTINE ModelLev_Check( HcoState, nLev, IsModelLev, RC )
     487             : !
     488             : ! !USES:
     489             : !
     490             :     USE HCO_FileData_Mod,   ONLY : FileData_ArrCheck
     491             : !
     492             : ! !INPUT PARAMETERS:
     493             : !
     494             :     TYPE(HCO_State),  POINTER        :: HcoState          ! HEMCO state object
     495             :     INTEGER,          INTENT(IN   )  :: nlev              ! number of levels
     496             : !
     497             : ! !INPUT/OUTPUT PARAMETERS:
     498             : !
     499             :     LOGICAL,          INTENT(INOUT)  :: IsModelLev        ! Are these model levels?
     500             :     INTEGER,          INTENT(INOUT)  :: RC                ! Success or failure?
     501             : !
     502             : ! !REVISION HISTORY:
     503             : !  29 Sep 2015 - C. Keller   - Initial version
     504             : !  See https://github.com/geoschem/hemco for complete history
     505             : !EOP
     506             : !------------------------------------------------------------------------------
     507             : !BOC
     508             : !
     509             : ! !LOCAL VARIABLES:
     510             : !
     511             :     INTEGER                 :: nz
     512             : 
     513             :     !=================================================================
     514             :     ! ModelLev_Check begins here
     515             :     !=================================================================
     516             : 
     517             :     ! Assume success until otherwise
     518           0 :     RC = HCO_SUCCESS
     519             : 
     520             :     ! If IsModelLev is already TRUE, nothing to do
     521           0 :     IF ( IsModelLev ) RETURN
     522             : 
     523             :     ! Shadow number of vertical levels on grid
     524           0 :     nz = HcoState%NZ
     525             : 
     526             :     ! Assume model levels if input data levels correspond to # of grid
     527             :     ! levels or levels + 1 (edges)
     528           0 :     IF ( nlev == nz .OR. nlev == nz + 1 ) THEN
     529           0 :        IsModelLev = .TRUE.
     530           0 :        RETURN
     531             :     ENDIF
     532             : 
     533             :     ! Other supported levels that depend on compiler flags
     534             :     ! Full grid
     535             :     IF ( nz == 72 ) THEN
     536           0 :        IF ( nlev <= 73 ) THEN
     537           0 :           IsModelLev = .TRUE.
     538             :        ENDIF
     539             : 
     540             :     ! Reduced grid
     541             :     ELSEIF ( nz == 47 ) THEN
     542             :        IF ( nlev == 72 .OR. &
     543           0 :             nlev == 73 .OR. &
     544             :             nlev <= 47       ) THEN
     545           0 :           IsModelLev = .TRUE.
     546             :        ENDIF
     547             : 
     548             :     ! Full GISS 102-layer grid
     549             :     ELSEIF ( nz == 102 ) THEN
     550           0 :        IF ( nlev <= 103 ) THEN
     551           0 :           IsModelLev = .TRUE.
     552             :        ENDIF
     553             : 
     554             :     ! Full GISS 40-layer grid
     555             :     ELSEIF ( nz == 40 ) THEN
     556           0 :        IF ( nlev <= 41 ) THEN
     557           0 :           IsModelLev = .TRUE.
     558             :        ENDIF
     559             : 
     560             :     ! Reduced GISS 74-layer grid
     561             :     ELSEIF ( nz == 74 ) THEN
     562             :        IF ( nlev == 102 .OR. &
     563           0 :             nlev == 103 .OR. &
     564             :             nlev <= 74       ) THEN
     565           0 :                     IsModelLev = .TRUE.
     566             :        ENDIF
     567             :     ENDIF
     568             : 
     569             :   END SUBROUTINE ModelLev_Check
     570             : !EOC
     571             : !------------------------------------------------------------------------------
     572             : !                   Harmonized Emissions Component (HEMCO)                    !
     573             : !------------------------------------------------------------------------------
     574             : !BOP
     575             : !
     576             : ! !IROUTINE: ModelLev_Interpolate
     577             : !
     578             : ! !DESCRIPTION: Subroutine ModelLev\_Interpolate puts 3D data from an
     579             : ! arbitrary number of model levels onto the vertical levels of the simulation
     580             : ! grid. Since the input data is already on model levels, this is only to
     581             : ! inflate/collapse fields between native/reduced vertical levels, e.g. from
     582             : ! 72 native GEOS-5 levels onto the reduced 47 levels. The vertical
     583             : ! interpolation scheme depends on compiler switches. If none of the compiler
     584             : ! switches listed below is used, no vertical interpolation is performed,
     585             : ! e.g. the vertical levels of the input grid are retained.
     586             : !\\
     587             : !\\
     588             : ! The input data (REGR\_4D) is expected to be already regridded horizontally.
     589             : ! The 4th dimension of REGR\_4D denotes time.
     590             : !\\
     591             : !\\
     592             : ! The 3rd dimension of REGR\_3D holds the vertical levels. It is assumed that
     593             : ! these are model levels, starting at the surface (level 1). If the input
     594             : ! data holds 72 input levels, this is interpreted as native data and will
     595             : ! be collapsed onto the reduced grid. If the input data holds X <=47 levels,
     596             : ! these levels are interpreted as levels 1-X of the reduced grid. In other
     597             : ! words, input data with 33 levels will be interpreted as 33 levels on the
     598             : ! reduced grid, and the data is accordingly mapped onto the simulation grid.
     599             : ! If data becomes inflated or collapsed, the output data will always extent
     600             : ! over all vertical levels of the simulation grid. If necessary, the unused
     601             : ! upper levels will be filled with zeros. If no data interpolation is needed,
     602             : ! the vertical extent of the output data is limited to the number of used
     603             : ! levels. For instance, if the input data has 5 vertical levels, the output
     604             : ! array will only extent over those 5 (bottom) levels.
     605             : !\\
     606             : !\\
     607             : ! Currently, this routine can remap the following combinations:
     608             : !\begin{itemize}
     609             : ! \item Native  GEOS-5 onto reduced GEOS-5 (72 --> 47 levels)
     610             : ! \item Reduced GEOS-5 onto native  GEOS-5 (47 --> 72 levels)
     611             : ! \item Native  GEOS-4 onto reduced GEOS-4 (55 --> 30 levels)
     612             : ! \item Reduced GEOS-4 onto native  GEOS-4 (30 --> 55 levels)
     613             : ! \item Native  GEOS-5 onto native  GEOS-4 (72 --> 55 levels)
     614             : ! \item Reduced GEOS-5 onto native  GEOS-4 (47 --> 55 levels)
     615             : ! \item Native  GEOS-5 onto reduced GEOS-4 (72 --> 30 levels)
     616             : ! \item Reduced GEOS-5 onto reduced GEOS-4 (47 --> 30 levels)
     617             : !\end{itemize}
     618             : ! Interpolation from GEOS-5 onto GEOS-4 levels is currently not supported.
     619             : !\\
     620             : !\\
     621             : ! !INTERFACE:
     622             : !
     623           0 :   SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC )
     624             : !
     625             : ! !USES:
     626             : !
     627             :     USE HCO_FileData_Mod,   ONLY : FileData_ArrCheck
     628             : !
     629             : ! !INPUT PARAMETERS:
     630             : !
     631             :     TYPE(HCO_State),  POINTER        :: HcoState          ! HEMCO state object
     632             :     REAL(sp),         POINTER        :: REGR_4D(:,:,:,:)  ! 4D input data
     633             : !
     634             : ! !INPUT/OUTPUT PARAMETERS:
     635             : !
     636             :     TYPE(ListCont),   POINTER        :: Lct               ! HEMCO list container
     637             :     INTEGER,          INTENT(INOUT)  :: RC                ! Success or failure?
     638             : !
     639             : ! !REVISION HISTORY:
     640             : !  30 Dec 2014 - C. Keller   - Initial version
     641             : !  See https://github.com/geoschem/hemco for complete history
     642             : !EOP
     643             : !------------------------------------------------------------------------------
     644             : !BOC
     645             : !
     646             : ! !LOCAL VARIABLES:
     647             : !
     648             :     INTEGER                 :: nx, ny, nz, nt
     649             :     INTEGER                 :: minlev, nlev, nout
     650             :     INTEGER                 :: L, T, NL
     651             :     INTEGER                 :: OS
     652             :     INTEGER                 :: G5T4
     653             :     LOGICAL                 :: verb, infl, clps
     654             :     LOGICAL                 :: DONE
     655             :     CHARACTER(LEN=255)      :: MSG, LOC
     656             : 
     657             :     !=================================================================
     658             :     ! ModelLev_Interpolate begins here
     659             :     !=================================================================
     660           0 :     LOC = 'ModelLev_Interpolate (HCO_INTERP_MOD.F90)'
     661             : 
     662             :     ! Enter
     663           0 :     CALL HCO_ENTER (HcoState%Config%Err, LOC, RC )
     664           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     665           0 :         CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
     666           0 :         RETURN
     667             :     ENDIF
     668             : 
     669             :     ! Check for verbose mode
     670           0 :     verb = HCO_IsVerb(HcoState%Config%Err,  3 )
     671           0 :     IF ( verb ) THEN
     672           0 :        MSG = 'Vertically interpolate model levels: '//TRIM(Lct%Dct%cName)
     673           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
     674             :     ENDIF
     675             : 
     676             :     ! Get HEMCO grid dimensions
     677           0 :     nx = HcoState%NX
     678           0 :     ny = HcoState%NY
     679           0 :     nz = HcoState%NZ
     680             : 
     681             :     ! Variable G5T4 is the # of GEOS-5 levels that need to be mapped
     682             :     ! onto GEOS-4 levels.
     683           0 :     G5T4 = 0
     684             : 
     685             :     ! Input data must be on horizontal HEMCO grid
     686           0 :     IF ( SIZE(REGR_4D,1) /= nx ) THEN
     687           0 :        WRITE(MSG,*) 'x dimension mismatch ', TRIM(Lct%Dct%cName), &
     688           0 :           ': ', nx, SIZE(REGR_4D,1)
     689           0 :        CALL HCO_ERROR( MSG, RC )
     690           0 :        RETURN
     691             :     ENDIF
     692           0 :     IF ( SIZE(REGR_4D,2) /= ny ) THEN
     693           0 :        WRITE(MSG,*) 'y dimension mismatch ', TRIM(Lct%Dct%cName), &
     694           0 :           ': ', ny, SIZE(REGR_4D,2)
     695           0 :        CALL HCO_ERROR( MSG, RC )
     696           0 :        RETURN
     697             :     ENDIF
     698             : 
     699             :     ! Get vertical and time dimension of input data
     700           0 :     nlev = SIZE(REGR_4D,3)
     701           0 :     nt   = SIZE(REGR_4D,4)
     702             : 
     703             :     ! Vertical interpolation done?
     704           0 :     DONE = .FALSE.
     705             : 
     706             :     !===================================================================
     707             :     ! If no vertical interpolation is needed, then (1) save the 4D
     708             :     ! input data array to to the HEMCO list container object and
     709             :     ! (2) exit this subroutine.
     710             :     !===================================================================
     711           0 :     IF ( ( nlev == nz ) .OR. ( nlev == nz+1 ) ) THEN
     712             : 
     713           0 :        CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nlev, nt, RC )
     714           0 :        IF ( RC /= HCO_SUCCESS ) THEN
     715           0 :            CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
     716           0 :            RETURN
     717             :        ENDIF
     718             : 
     719           0 :        DO T = 1, nt
     720           0 :           Lct%Dct%Dta%V3(T)%Val(:,:,:) = REGR_4D(:,:,:,T)
     721             :        ENDDO
     722             : 
     723             :        ! Verbose
     724           0 :        IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN
     725           0 :           MSG = '# of input levels = # of output levels - passed as is.'
     726           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     727             :        ENDIF
     728             : 
     729             :        ! Done!
     730             :        DONE = .TRUE.
     731             :     ENDIF
     732             : 
     733             :     !===================================================================
     734             :     ! Do vertical regridding:
     735             :     !===================================================================
     736             :     IF ( .NOT. DONE ) THEN
     737             : 
     738             :        !----------------------------------------------------------------
     739             :        ! Native levels
     740             :        !----------------------------------------------------------------
     741           0 :        IF ( nz == 72 ) THEN
     742             : 
     743             :           ! Determine number of output levels. If the input data has
     744             :           ! 47 or less levels, it is assumed to represent reduced
     745             :           ! GEOS-5 levels and data is mapped accordingly. If input data
     746             :           ! has more than 47 levels, it cannot be on the reduced grid
     747             :           ! and mapping is done 1:1
     748           0 :           IF ( nlev > 36 .AND. nlev <= 48 ) THEN
     749           0 :              IF ( nlev == 48 ) THEN
     750           0 :                 nz   = nz + 1
     751           0 :                 nout = nz
     752           0 :                 NL   = 37
     753             :              ELSE
     754           0 :                 nout = nz
     755           0 :                 NL   = 36
     756             :              ENDIF
     757             :           ELSE
     758           0 :              nout = nlev
     759           0 :              NL   = nout
     760             :           ENDIF
     761             : 
     762             :           ! Make sure output array is allocated
     763           0 :           CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nout, nt, RC )
     764             : 
     765             :           ! Do for every time slice
     766           0 :           DO T = 1, nt
     767             : 
     768             :              ! Levels that are passed level-by-level.
     769           0 :              DO L = 1, NL
     770           0 :                 Lct%Dct%Dta%V3(T)%Val(:,:,L) = REGR_4D(:,:,L,T)
     771             :              ENDDO !L
     772             : 
     773             :              ! If needed, inflate from reduced GEOS-5 grid onto native GEOS-5
     774           0 :              IF ( ( NL == 36 .AND. nz == 72 ) .OR. &
     775           0 :                   ( NL == 37 .AND. nz == 73 )       ) THEN
     776             :                 ! Distribute over 2 levels (e.g. level 38 into 39-40):
     777           0 :                 CALL INFLATE( Lct, REGR_4D, NL+1 , NL+1, 2, T )
     778           0 :                 CALL INFLATE( Lct, REGR_4D, NL+2 , NL+3, 2, T )
     779           0 :                 CALL INFLATE( Lct, REGR_4D, NL+3 , NL+5, 2, T )
     780           0 :                 CALL INFLATE( Lct, REGR_4D, NL+4 , NL+7, 2, T )
     781             :                 ! Distribute over 4 levels:
     782           0 :                 CALL INFLATE( Lct, REGR_4D, NL+5 , NL+9, 4, T )
     783           0 :                 CALL INFLATE( Lct, REGR_4D, NL+6 , NL+13, 4, T )
     784           0 :                 CALL INFLATE( Lct, REGR_4D, NL+7 , NL+17, 4, T )
     785           0 :                 CALL INFLATE( Lct, REGR_4D, NL+8 , NL+21, 4, T )
     786           0 :                 CALL INFLATE( Lct, REGR_4D, NL+9 , NL+25, 4, T )
     787           0 :                 CALL INFLATE( Lct, REGR_4D, NL+10, NL+29, 4, T )
     788           0 :                 CALL INFLATE( Lct, REGR_4D, NL+11, NL+33, 4, T )
     789             :              ENDIF
     790             : 
     791             :           ENDDO ! T
     792             : 
     793             :           ! Verbose
     794           0 :           IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN
     795           0 :              WRITE(MSG,*) 'Mapped ', nlev, ' levels onto native GEOS-5 levels.'
     796           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
     797             :           ENDIF
     798             : 
     799             :           ! Done!
     800             :           DONE = .TRUE.
     801             : 
     802             :        !----------------------------------------------------------------
     803             :        ! Reduced levels
     804             :        !----------------------------------------------------------------
     805           0 :        ELSEIF ( nz == 47 ) THEN
     806             : 
     807             :           ! Determine number of output levels. If input data is on the
     808             :           ! native grid, we collapse them onto the reduced GEOS-5 grid.
     809             :           ! In all other cases, we assume the input data is already on
     810             :           ! the reduced levels and mappings occurs 1:1.
     811           0 :           IF ( nlev == 72 ) THEN
     812           0 :              nout = nz
     813           0 :              NL   = 36
     814           0 :           ELSEIF ( nlev == 73 ) THEN
     815           0 :              nz   = nz + 1
     816           0 :              nout = nz
     817           0 :              NL   = 37
     818           0 :           ELSEIF ( nlev > 47 ) THEN
     819             :              MSG = 'Can only remap from native onto reduced GEOS-5 if '// &
     820           0 :                    'input data has exactly 72 or 73 levels: '//TRIM(Lct%Dct%cName)
     821           0 :              CALL HCO_ERROR( MSG, RC )
     822           0 :              RETURN
     823             :           ELSE
     824           0 :              nout = nlev
     825           0 :              NL   = nout
     826             :           ENDIF
     827             : 
     828             :           ! Make sure output array is allocated
     829           0 :           CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nout, nt, RC )
     830             : 
     831             :           ! Do for every time slice
     832           0 :           DO T = 1, nt
     833             : 
     834             :              ! Levels that are passed level-by-level.
     835           0 :              DO L = 1, NL
     836           0 :                 Lct%Dct%Dta%V3(T)%Val(:,:,L) = REGR_4D(:,:,L,T)
     837             :              ENDDO !L
     838             : 
     839             :              ! If needed, collapse from native GEOS-5 onto reduced GEOS-5
     840           0 :              IF ( nlev == 72 .OR. nlev == 73 ) THEN
     841             : 
     842             :                 ! Add one level offset if these are edges
     843           0 :                 IF ( nlev == 73 ) THEN
     844             :                    OS = 1
     845             :                 ELSE
     846           0 :                    OS = 0
     847             :                 ENDIF
     848             : 
     849             :                 ! Collapse two levels (e.g. levels 39-40 into level 38):
     850           0 :                 CALL COLLAPSE( Lct, REGR_4D, 37+OS, 37+OS, 2, T, 5 )
     851           0 :                 CALL COLLAPSE( Lct, REGR_4D, 38+OS, 39+OS, 2, T, 5 )
     852           0 :                 CALL COLLAPSE( Lct, REGR_4D, 39+OS, 41+OS, 2, T, 5 )
     853           0 :                 CALL COLLAPSE( Lct, REGR_4D, 40+OS, 43+OS, 2, T, 5 )
     854             :                 ! Collapse four levels:
     855           0 :                 CALL COLLAPSE( Lct, REGR_4D, 41+OS, 45+OS, 4, T, 5 )
     856           0 :                 CALL COLLAPSE( Lct, REGR_4D, 42+OS, 49+OS, 4, T, 5 )
     857           0 :                 CALL COLLAPSE( Lct, REGR_4D, 43+OS, 53+OS, 4, T, 5 )
     858           0 :                 CALL COLLAPSE( Lct, REGR_4D, 44+OS, 57+OS, 4, T, 5 )
     859           0 :                 CALL COLLAPSE( Lct, REGR_4D, 45+OS, 61+OS, 4, T, 5 )
     860           0 :                 CALL COLLAPSE( Lct, REGR_4D, 46+OS, 65+OS, 4, T, 5 )
     861           0 :                 CALL COLLAPSE( Lct, REGR_4D, 47+OS, 69+OS, 4, T, 5 )
     862             : 
     863             :              ENDIF
     864             :           ENDDO ! T
     865             : 
     866             :           ! Verbose
     867           0 :           IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN
     868           0 :              WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GEOS-5 levels.'
     869           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
     870             :           ENDIF
     871             : 
     872             :           ! Done!
     873             :           DONE = .TRUE.
     874             : 
     875             :        !----------------------------------------------------------------
     876             :        ! Reduced GISS levels
     877             :        !----------------------------------------------------------------
     878           0 :        ELSEIF ( nz == 74 ) THEN
     879             : 
     880             :           ! Determine number of output levels. If input data is on the
     881             :           ! native grid, we collapse them onto the reduced GISS grid.
     882             :           ! In all other cases, we assume the input data is already on
     883             :           ! the reduced levels and mappings occurs 1:1.
     884           0 :           IF ( nlev == 102 ) THEN
     885           0 :              nout = nz
     886           0 :              NL   = 60
     887           0 :           ELSEIF ( nlev == 103 ) THEN
     888           0 :              nz   = nz + 1
     889           0 :              nout = nz
     890           0 :              NL   = 61
     891             :           ELSE
     892           0 :              nout = nlev
     893           0 :              NL   = nout
     894             :           ENDIF
     895             : 
     896             :           ! Make sure output array is allocated
     897           0 :           CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nout, nt, RC )
     898             : 
     899             :           ! Do for every time slice
     900           0 :           DO T = 1, nt
     901             : 
     902             :              ! Levels that are passed level-by-level.
     903           0 :              DO L = 1, NL
     904           0 :                 Lct%Dct%Dta%V3(T)%Val(:,:,L) = REGR_4D(:,:,L,T)
     905             :              ENDDO !L
     906             : 
     907             :              ! If needed, collapse from native GEOS-5 onto reduced GEOS-5
     908           0 :              IF ( nlev == 102 .OR. nlev == 103 ) THEN
     909             : 
     910             :                 ! Add one level offset if these are edges
     911           0 :                 IF ( nlev == 103 ) THEN
     912             :                    OS = 1
     913             :                 ELSE
     914           0 :                    OS = 0
     915             :                 ENDIF
     916             : 
     917             :                 ! Collapse two levels (e.g. levels 61-62 into level 61):
     918           0 :                 CALL COLLAPSE( Lct, REGR_4D, 61+OS, 61+OS, 2, T, 22 )
     919           0 :                 CALL COLLAPSE( Lct, REGR_4D, 62+OS, 63+OS, 2, T, 22 )
     920           0 :                 CALL COLLAPSE( Lct, REGR_4D, 63+OS, 65+OS, 2, T, 22 )
     921           0 :                 CALL COLLAPSE( Lct, REGR_4D, 64+OS, 67+OS, 2, T, 22 )
     922           0 :                 CALL COLLAPSE( Lct, REGR_4D, 65+OS, 69+OS, 2, T, 22 )
     923           0 :                 CALL COLLAPSE( Lct, REGR_4D, 66+OS, 71+OS, 2, T, 22 )
     924           0 :                 CALL COLLAPSE( Lct, REGR_4D, 67+OS, 73+OS, 2, T, 22 )
     925             :                 ! Collapse four levels:
     926           0 :                 CALL COLLAPSE( Lct, REGR_4D, 68+OS, 75+OS, 4, T, 22 )
     927           0 :                 CALL COLLAPSE( Lct, REGR_4D, 69+OS, 79+OS, 4, T, 22 )
     928           0 :                 CALL COLLAPSE( Lct, REGR_4D, 70+OS, 83+OS, 4, T, 22 )
     929           0 :                 CALL COLLAPSE( Lct, REGR_4D, 71+OS, 87+OS, 4, T, 22 )
     930           0 :                 CALL COLLAPSE( Lct, REGR_4D, 72+OS, 91+OS, 4, T, 22 )
     931           0 :                 CALL COLLAPSE( Lct, REGR_4D, 73+OS, 95+OS, 4, T, 22 )
     932           0 :                 CALL COLLAPSE( Lct, REGR_4D, 74+OS, 99+OS, 4, T, 22 )
     933             : 
     934             :              ENDIF
     935             :           ENDDO ! T
     936             : 
     937             :           ! Verbose
     938           0 :           IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN
     939           0 :              WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GISS levels.'
     940           0 :              CALL HCO_MSG(HcoState%Config%Err,MSG)
     941             :           ENDIF
     942             : 
     943             :           ! Done!
     944             :           DONE = .TRUE.
     945             : 
     946             :        ENDIF
     947             : 
     948             :     ENDIF ! Vertical regridding required
     949             : 
     950             :     !===================================================================
     951             :     ! For all other cases, do not do any vertical regridding
     952             :     !===================================================================
     953             :     IF ( .NOT. DONE ) THEN
     954           0 :        CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nlev, nt, RC )
     955           0 :        IF ( RC /= HCO_SUCCESS ) THEN
     956           0 :            CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
     957           0 :            RETURN
     958             :        ENDIF
     959             : 
     960           0 :        DO T = 1, nt
     961           0 :           Lct%Dct%Dta%V3(T)%Val(:,:,:) = REGR_4D(:,:,:,T)
     962             :        ENDDO
     963             : 
     964             :        ! Verbose
     965           0 :        IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN
     966           0 :           WRITE(MSG,*) 'Could not find vertical interpolation key - ', &
     967           0 :                        'kept the original ', nlev, ' levels.'
     968           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     969             :        ENDIF
     970             : 
     971             :        ! Done!
     972             :        DONE = .TRUE.
     973             :     ENDIF
     974             : 
     975             :     !===================================================================
     976             :     ! Error check / verbose mode
     977             :     !===================================================================
     978             :     IF ( DONE ) THEN
     979           0 :       IF ( HCO_IsVerb(HcoState%Config%Err, 2) ) THEN
     980           0 :           WRITE(MSG,*) 'Did vertical regridding for ',TRIM(Lct%Dct%cName),':'
     981           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     982           0 :           WRITE(MSG,*) 'Number of original levels: ', nlev
     983           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     984           0 :           WRITE(MSG,*) 'Number of output levels: ', SIZE(Lct%Dct%Dta%V3(1)%Val,3)
     985           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     986             :        ENDIF
     987             :     ELSE
     988             :        WRITE(MSG,*) 'Vertical regridding failed: ',TRIM(Lct%Dct%cName)
     989             :        CALL HCO_ERROR( MSG, RC )
     990             :        RETURN
     991             :     ENDIF
     992             : 
     993             :     ! Return w/ success
     994           0 :     CALL HCO_LEAVE ( HcoState%Config%Err, RC )
     995             : 
     996             :   END SUBROUTINE ModelLev_Interpolate
     997             : !EOC
     998             : !------------------------------------------------------------------------------
     999             : !                   Harmonized Emissions Component (HEMCO)                    !
    1000             : !------------------------------------------------------------------------------
    1001             : !BOP
    1002             : !
    1003             : ! !IROUTINE: GEOS5_TO_GEOS4_LOWLEV
    1004             : !
    1005             : ! !DESCRIPTION: Helper routine to map the lowest 28 GEOS-5 levels onto the
    1006             : ! lowest 11 GEOS-4 levels. The individual level weights were calculated
    1007             : ! offline and are hard-coded here.
    1008             : ! These are the edge pressure values on the lowest 28 GEOS-5 levels:
    1009             : ! 1013.25, 998.05, 982.76, 967.47, 952.19, 936.91
    1010             : !  921.62, 906.34, 891.05, 875.77, 860.49, 845.21,
    1011             : !  829.92, 809.55, 784.08, 758.62, 733.15, 707.69,
    1012             : !  682.23, 644.05, 605.87, 567.70, 529.54, 491.40,
    1013             : !  453.26, 415.15, 377.07, 339.00, 288.92
    1014             : !
    1015             : ! And these are the edge pressure values on the lowest 12 GEOS-4 levels:
    1016             : ! 1013.25, 998.16, 968.49, 914.79, 841.15, 752.89,
    1017             : !  655.96, 556.85, 472.64, 401.14, 340.43, 288.92
    1018             : !
    1019             : ! The value at every given GEOS-4 level is determined from the GEOS-5 values
    1020             : ! by multiplying the (GEOS-5) input data by the normalized level weights. For
    1021             : ! instance, the first GEOS-5 level is the only level contributing to the 1st
    1022             : ! GEOS-4 level. For the 2nd GEOS-4 level, contributions from GEOS-5 levels
    1023             : ! 1-3 are used. Of GEOS-5 level 1, only 0.7% lies in level 2 of GEOS-4 (99.3%
    1024             : ! is in GEOS-4 level 1), whereas 100% of GEOS-5 level 2 and 93.3% of GEOS-5
    1025             : ! level 3 contribute to GEOS-4 level 2. The corresponding normalized weights
    1026             : ! become 0.00378,0.515, and 0.481, respectively.
    1027             : !\\
    1028             : !\\
    1029             : ! The weights don't always add up to exactly 1.00 due to rounding errors.
    1030             : !\\
    1031             : !\\
    1032             : ! !INTERFACE:
    1033             : !
    1034             :   SUBROUTINE GEOS5_TO_GEOS4_LOWLEV( HcoState, Lct, REGR_4D, NZ, T, RC )
    1035             : !
    1036             : ! !INPUT PARAMETERS:
    1037             : !
    1038             :     TYPE(HCO_State),  POINTER        :: HcoState          ! HEMCO state object
    1039             :     REAL(sp),         POINTER        :: REGR_4D(:,:,:,:)  ! 4D input data
    1040             :     INTEGER,          INTENT(IN)     :: T                 ! Time index
    1041             :     INTEGER,          INTENT(IN)     :: NZ                ! # of vertical levels to remap. Must be 28 or 29
    1042             : !
    1043             : ! !INPUT/OUTPUT PARAMETERS:
    1044             : !
    1045             :     TYPE(ListCont),   POINTER        :: Lct               ! HEMCO list container
    1046             :     INTEGER,          INTENT(INOUT)  :: RC                ! Return code
    1047             : !
    1048             : ! !REVISION HISTORY:
    1049             : !  07 Jan 2015 - C. Keller   - Initial version.
    1050             : !  See https://github.com/geoschem/hemco for complete history
    1051             : !EOP
    1052             : !------------------------------------------------------------------------------
    1053             : !BOC
    1054             :     REAL(hp)           :: WGHT
    1055             :     CHARACTER(LEN=255) :: MSG
    1056             :     CHARACTER(LEN=255) :: LOC = 'GEOS5_TO_GEOS4_LOWLEV (hco_interp_mod.F90)'
    1057             : 
    1058             :     !=================================================================
    1059             :     ! GEOS5_TO_GEOS4_LOWLEV begins here
    1060             :     !=================================================================
    1061             : 
    1062             :     ! Check number of levels to be used
    1063             :     IF ( NZ /= 28 .AND. NZ /= 29 ) THEN
    1064             :        MSG = 'Cannot map GEOS-5 onto GEOS-4 data, number of levels must be 28 or 29: '//TRIM(Lct%Dct%cName)
    1065             :        CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
    1066             :        RETURN
    1067             :     ENDIF
    1068             : 
    1069             :     ! Error check: make sure array REGR_4D has at least NZ levels
    1070             :     IF ( SIZE(REGR_4D,3) < NZ ) THEN
    1071             :        WRITE(MSG,*) 'Cannot map GEOS-5 onto GEOS-4 data, original data has not enough levels: ', &
    1072             :           TRIM(Lct%Dct%cName), ' --> ', SIZE(REGR_4D,3), ' smaller than ', NZ
    1073             :        CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
    1074             :        RETURN
    1075             :     ENDIF
    1076             : 
    1077             :     ! Map 28 GEOS-5 levels onto 11 GEOS-4 levels (grid midpoints):
    1078             :     IF ( NZ == 28 ) THEN
    1079             : 
    1080             :        ! Reset
    1081             :        Lct%Dct%Dta%V3(T)%Val(:,:,1:11) = 0.0_sp
    1082             : 
    1083             :        ! Level 1:
    1084             :        Lct%Dct%Dta%V3(T)%Val(:,:, 1) = REGR_4D(:,:,1,T)
    1085             : 
    1086             :        ! Level 2:
    1087             :        Lct%Dct%Dta%V3(T)%Val(:,:, 2) = 3.78e-3_sp * REGR_4D(:,:, 1,T) &
    1088             :                                      + 0.515_sp   * REGR_4D(:,:, 2,T) &
    1089             :                                      + 0.481_sp   * REGR_4D(:,:, 3,T)
    1090             : 
    1091             :        ! Level 3:
    1092             :        Lct%Dct%Dta%V3(T)%Val(:,:, 3) = 1.88e-2_sp * REGR_4D(:,:, 3,T) &
    1093             :                                      + 0.285_sp   * REGR_4D(:,:, 4,T) &
    1094             :                                      + 0.285_sp   * REGR_4D(:,:, 5,T) &
    1095             :                                      + 0.285_sp   * REGR_4D(:,:, 6,T) &
    1096             :                                      + 0.127_sp   * REGR_4D(:,:, 7,T)
    1097             : 
    1098             :        ! Level 4:
    1099             :        Lct%Dct%Dta%V3(T)%Val(:,:, 4) = 0.115_sp   * REGR_4D(:,:, 7,T) &
    1100             :                                      + 0.208_sp   * REGR_4D(:,:, 8,T) &
    1101             :                                      + 0.208_sp   * REGR_4D(:,:, 9,T) &
    1102             :                                      + 0.208_sp   * REGR_4D(:,:,10,T) &
    1103             :                                      + 0.208_sp   * REGR_4D(:,:,11,T) &
    1104             :                                      + 5.51e-2_sp * REGR_4D(:,:,12,T)
    1105             : 
    1106             :        ! Level 5:
    1107             :        Lct%Dct%Dta%V3(T)%Val(:,:, 5) = 0.189_sp   * REGR_4D(:,:,12,T) &
    1108             :                                      + 0.253_sp   * REGR_4D(:,:,13,T) &
    1109             :                                      + 0.253_sp   * REGR_4D(:,:,14,T) &
    1110             :                                      + 0.253_sp   * REGR_4D(:,:,15,T) &
    1111             :                                      + 5.68e-2_sp * REGR_4D(:,:,16,T)
    1112             : 
    1113             :        ! Level 6:
    1114             :        Lct%Dct%Dta%V3(T)%Val(:,:, 6) = 0.224_sp   * REGR_4D(:,:,16,T) &
    1115             :                                      + 0.289_sp   * REGR_4D(:,:,17,T) &
    1116             :                                      + 0.289_sp   * REGR_4D(:,:,18,T) &
    1117             :                                      + 0.199_sp   * REGR_4D(:,:,19,T)
    1118             : 
    1119             :        ! Level 7:
    1120             :        Lct%Dct%Dta%V3(T)%Val(:,:, 7) = 0.120_sp   * REGR_4D(:,:,19,T) &
    1121             :                                      + 0.385_sp   * REGR_4D(:,:,20,T) &
    1122             :                                      + 0.385_sp   * REGR_4D(:,:,21,T) &
    1123             :                                      + 0.110_sp   * REGR_4D(:,:,22,T)
    1124             : 
    1125             :        ! Level 8:
    1126             :        Lct%Dct%Dta%V3(T)%Val(:,:, 8) = 0.324_sp   * REGR_4D(:,:,22,T) &
    1127             :                                      + 0.453_sp   * REGR_4D(:,:,23,T) &
    1128             :                                      + 0.223_sp   * REGR_4D(:,:,24,T)
    1129             : 
    1130             :        ! Level 9:
    1131             :        Lct%Dct%Dta%V3(T)%Val(:,:, 9) = 0.271_sp   * REGR_4D(:,:,24,T) &
    1132             :                                      + 0.533_sp   * REGR_4D(:,:,25,T) &
    1133             :                                      + 0.196_sp   * REGR_4D(:,:,26,T)
    1134             : 
    1135             :        ! Level 10:
    1136             :        Lct%Dct%Dta%V3(T)%Val(:,:,10) = 0.396_sp   * REGR_4D(:,:,26,T) &
    1137             :                                      + 0.604_sp   * REGR_4D(:,:,27,T)
    1138             : 
    1139             :        ! Level 11:
    1140             :        Lct%Dct%Dta%V3(T)%Val(:,:,11) = 3.63e-2_sp * REGR_4D(:,:,27,T) &
    1141             :                                      + 0.964_sp   * REGR_4D(:,:,28,T)
    1142             : 
    1143             :     ! Map 29 GEOS-5 levels onto 12 GEOS-4 levels (grid edges):
    1144             :     ELSEIF ( NZ == 29 ) THEN
    1145             : 
    1146             :        ! Reset
    1147             :        Lct%Dct%Dta%V3(T)%Val(:,:,1:12) = 0.0_sp
    1148             : 
    1149             :        ! Level 1
    1150             :        Lct%Dct%Dta%V3(T)%Val(:,:, 1) = REGR_4D(:,:,1,T)
    1151             : 
    1152             :        ! Level 2:
    1153             :        Lct%Dct%Dta%V3(T)%Val(:,:, 2) = 5.01e-3_sp * REGR_4D(:,:, 1,T) &
    1154             :                                      + 0.680_sp   * REGR_4D(:,:, 2,T) &
    1155             :                                      + 0.314_sp   * REGR_4D(:,:, 3,T)
    1156             : 
    1157             :        ! Level 3:
    1158             :        Lct%Dct%Dta%V3(T)%Val(:,:, 3) = 0.197_sp   * REGR_4D(:,:, 3,T) &
    1159             :                                      + 0.366_sp   * REGR_4D(:,:, 4,T) &
    1160             :                                      + 0.366_sp   * REGR_4D(:,:, 5,T) &
    1161             :                                      + 6.98e-2_sp * REGR_4D(:,:, 6,T)
    1162             : 
    1163             :        ! Level 4:
    1164             :        Lct%Dct%Dta%V3(T)%Val(:,:, 4) = 0.194_sp   * REGR_4D(:,:, 6,T) &
    1165             :                                      + 0.240_sp   * REGR_4D(:,:, 7,T) &
    1166             :                                      + 0.240_sp   * REGR_4D(:,:, 8,T) &
    1167             :                                      + 0.240_sp   * REGR_4D(:,:, 9,T) &
    1168             :                                      + 8.55e-2_sp * REGR_4D(:,:,10,T)
    1169             : 
    1170             :        ! Level 5:
    1171             :        Lct%Dct%Dta%V3(T)%Val(:,:, 5) = 0.139_sp   * REGR_4D(:,:,10,T) &
    1172             :                                      + 0.216_sp   * REGR_4D(:,:,11,T) &
    1173             :                                      + 0.216_sp   * REGR_4D(:,:,12,T) &
    1174             :                                      + 0.216_sp   * REGR_4D(:,:,13,T) &
    1175             :                                      + 0.214_sp   * REGR_4D(:,:,14,T)
    1176             : 
    1177             :        ! Level 6:
    1178             :        Lct%Dct%Dta%V3(T)%Val(:,:, 6) = 2.20e-2_sp * REGR_4D(:,:,14,T) &
    1179             :                                      + 0.275_sp   * REGR_4D(:,:,15,T) &
    1180             :                                      + 0.275_sp   * REGR_4D(:,:,16,T) &
    1181             :                                      + 0.275_sp   * REGR_4D(:,:,17,T) &
    1182             :                                      + 0.173_sp   * REGR_4D(:,:,18,T)
    1183             : 
    1184             :        ! Level 7:
    1185             :        Lct%Dct%Dta%V3(T)%Val(:,:, 7) = 0.130_sp   * REGR_4D(:,:,18,T) &
    1186             :                                      + 0.345_sp   * REGR_4D(:,:,19,T) &
    1187             :                                      + 0.345_sp   * REGR_4D(:,:,20,T) &
    1188             :                                      + 0.170_sp   * REGR_4D(:,:,21,T)
    1189             : 
    1190             :        ! Level 8:
    1191             :        Lct%Dct%Dta%V3(T)%Val(:,:, 8) = 0.214_sp   * REGR_4D(:,:,21,T) &
    1192             :                                      + 0.416_sp   * REGR_4D(:,:,22,T) &
    1193             :                                      + 0.370_sp   * REGR_4D(:,:,23,T)
    1194             : 
    1195             :        ! Level 9:
    1196             :        Lct%Dct%Dta%V3(T)%Val(:,:, 9) = 5.49e-2_sp * REGR_4D(:,:,23,T) &
    1197             :                                      + 0.490_sp   * REGR_4D(:,:,24,T) &
    1198             :                                      + 0.455_sp   * REGR_4D(:,:,25,T)
    1199             : 
    1200             :        ! Level 10:
    1201             :        Lct%Dct%Dta%V3(T)%Val(:,:,10) = 4.06e-2_sp * REGR_4D(:,:,25,T) &
    1202             :                                      + 0.576_sp   * REGR_4D(:,:,26,T) &
    1203             :                                      + 0.383_sp   * REGR_4D(:,:,27,T)
    1204             : 
    1205             :        ! Level 11:
    1206             :        Lct%Dct%Dta%V3(T)%Val(:,:,11) = 0.254_sp   * REGR_4D(:,:,27,T) &
    1207             :                                      + 0.746_sp   * REGR_4D(:,:,28,T)
    1208             : 
    1209             :        ! Level 12:
    1210             :        Lct%Dct%Dta%V3(T)%Val(:,:,12) = 1.60e-2_sp * REGR_4D(:,:,28,T) &
    1211             :                                      + 0.984_sp   * REGR_4D(:,:,29,T)
    1212             : 
    1213             :     ENDIF
    1214             : 
    1215             :     ! Return with success
    1216             :     RC = HCO_SUCCESS
    1217             : 
    1218             :   END SUBROUTINE GEOS5_TO_GEOS4_LOWLEV
    1219             : !EOC
    1220             : !------------------------------------------------------------------------------
    1221             : !                   Harmonized Emissions Component (HEMCO)                    !
    1222             : !------------------------------------------------------------------------------
    1223             : !BOP
    1224             : !
    1225             : ! !IROUTINE: COLLAPSE
    1226             : !
    1227             : ! !DESCRIPTION: Helper routine to collapse input levels onto the output grid.
    1228             : ! The input data is weighted by the grid box thicknesses defined on top of
    1229             : ! this module. The input parameter T determines the time slice to be considered,
    1230             : ! and MET denotes the met field type of the input data (4 = GEOS-4 levels, GEOS-5
    1231             : ! otherwise).
    1232             : !\\
    1233             : !\\
    1234             : ! !INTERFACE:
    1235             : !
    1236           0 :   SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET )
    1237             : !
    1238             : ! !INPUT PARAMETERS:
    1239             : !
    1240             :     REAL(sp),         POINTER        :: REGR_4D(:,:,:,:)  ! 4D input data
    1241             :     INTEGER,          INTENT(IN)     :: OutLev
    1242             :     INTEGER,          INTENT(IN)     :: InLev1
    1243             :     INTEGER,          INTENT(IN)     :: NLEV
    1244             :     INTEGER,          INTENT(IN)     :: T
    1245             :     INTEGER,          INTENT(IN)     :: MET               ! 4=GEOS-4, 22=GISS E2.2, else GEOS-5
    1246             : !
    1247             : ! !INPUT/OUTPUT PARAMETERS:
    1248             : !
    1249             :     TYPE(ListCont),   POINTER        :: Lct               ! HEMCO list container
    1250             : !
    1251             : ! !REVISION HISTORY:
    1252             : !  30 Dec 2014 - C. Keller   - Initial version
    1253             : !  See https://github.com/geoschem/hemco for complete history
    1254             : !EOP
    1255             : !------------------------------------------------------------------------------
    1256             : !BOC
    1257             :     INTEGER               :: I, NZ, ILEV, TOPLEV
    1258             :     REAL(hp)              :: THICK
    1259           0 :     REAL(hp), POINTER     :: EDG(:)
    1260           0 :     REAL(hp), ALLOCATABLE :: WGT(:)
    1261             : 
    1262             :     !=================================================================
    1263             :     ! COLLAPSE begins here
    1264             :     !=================================================================
    1265             : 
    1266             :     ! Init
    1267           0 :     EDG => NULL()
    1268             : 
    1269             :     ! Reset
    1270           0 :     Lct%Dct%Dta%V3(T)%Val(:,:,OutLev) = 0.0_hp
    1271             : 
    1272             :     ! Don't do anything if there are not enough levels in REGR_4D
    1273           0 :     NZ = SIZE(REGR_4D,3)
    1274           0 :     IF ( NZ < InLev1 ) RETURN
    1275             : 
    1276             :     ! Get maximum level to be used for pressure thickness calculations.
    1277           0 :     TOPLEV = InLev1 + ( NLEV-1 )
    1278             : 
    1279             :     ! Get pointer to grid edges on the native input grid
    1280           0 :     IF ( Met == 4 ) THEN
    1281           0 :        EDG => G4_EDGE_NATIVE(InLev1:TOPLEV)
    1282           0 :     ELSE IF ( Met == 22 ) THEN
    1283           0 :        EDG => E102_EDGE_NATIVE(InLev1:TOPLEV)
    1284             :     ELSE
    1285           0 :        EDG => G5_EDGE_NATIVE(InLev1:TOPLEV)
    1286             :     ENDIF
    1287             : 
    1288             :     ! Thickness of output level
    1289           0 :     THICK = EDG(1) - EDG(NLEV)
    1290             : 
    1291             :     ! Get level weights
    1292           0 :     ALLOCATE(WGT(NLEV))
    1293           0 :     WGT = 0.0
    1294           0 :     DO I = 1, NLEV-1
    1295           0 :        WGT(I) = ( EDG(I) - EDG(I+1) ) / THICK
    1296             :     ENDDO
    1297             : 
    1298             :     ! Pass levels to output data, one after each other
    1299           0 :     Lct%Dct%Dta%V3(T)%Val(:,:,OutLev) = REGR_4D(:,:,InLev1,T) * WGT(1)
    1300           0 :     DO I = 1, NLEV-1
    1301           0 :        ILEV = InLev1 + I
    1302           0 :        IF ( NZ < ILEV ) EXIT
    1303           0 :        Lct%Dct%Dta%V3(T)%Val(:,:,OutLev) = Lct%Dct%Dta%V3(T)%Val(:,:,OutLev) &
    1304           0 :                                          + ( REGR_4D(:,:,ILEV,T) * WGT(I+1) )
    1305             :     ENDDO
    1306             : 
    1307             :     ! Cleanup
    1308           0 :     DEALLOCATE(WGT)
    1309           0 :     EDG => NULL()
    1310             : 
    1311           0 :   END SUBROUTINE COLLAPSE
    1312             : !EOC
    1313             : !------------------------------------------------------------------------------
    1314             : !                   Harmonized Emissions Component (HEMCO)                    !
    1315             : !------------------------------------------------------------------------------
    1316             : !BOP
    1317             : !
    1318             : ! !IROUTINE: INFLATE
    1319             : !
    1320             : ! !DESCRIPTION: Helper routine to inflate input levels onto the output grid.
    1321             : ! The values on the input data are evenly distributed amongst all output
    1322             : ! levels.
    1323             : !\\
    1324             : !\\
    1325             : ! !INTERFACE:
    1326             : !
    1327           0 :   SUBROUTINE INFLATE ( Lct, REGR_4D, InLev, OutLev1, NLEV, T )
    1328             : !
    1329             : ! !INPUT PARAMETERS:
    1330             : !
    1331             :     REAL(sp),         POINTER        :: REGR_4D(:,:,:,:)  ! 4D input data
    1332             :     INTEGER,          INTENT(IN)     :: InLev
    1333             :     INTEGER,          INTENT(IN)     :: OutLev1
    1334             :     INTEGER,          INTENT(IN)     :: NLEV
    1335             :     INTEGER,          INTENT(IN)     :: T
    1336             : !
    1337             : ! !INPUT/OUTPUT PARAMETERS:
    1338             : !
    1339             :     TYPE(ListCont),   POINTER        :: Lct               ! HEMCO list container
    1340             : !
    1341             : ! !REVISION HISTORY:
    1342             : !  30 Dec 2014 - C. Keller   - Initial version
    1343             : !  See https://github.com/geoschem/hemco for complete history
    1344             : !EOP
    1345             : !------------------------------------------------------------------------------
    1346             : !BOC
    1347             :     INTEGER :: I, DZ, NZ, ILEV
    1348             : 
    1349             :     !=================================================================
    1350             :     ! INFLATE begins here
    1351             :     !=================================================================
    1352             : 
    1353             :     ! Get input data array
    1354           0 :     NZ = SIZE( REGR_4D, 3 )
    1355             : 
    1356             :     ! Get size of data array in the HEMCO state (bmy, 22 Mar 2022)
    1357           0 :     DZ = SIZE( Lct%Dct%Dta%V3(T)%Val, 3 )
    1358             : 
    1359             :     ! Do for every output level
    1360           0 :     DO I = 1, NLEV
    1361             : 
    1362             :        ! Current output level
    1363           0 :        ILEV = OutLev1 + I - 1
    1364             : 
    1365             :        ! Avoid out-of-bounds errors if ILEV is greater than the
    1366             :        ! number of levels in Lct%Dct%Dta%V3(T)%Val (bmy, 22 Mar 2022)
    1367           0 :        IF ( ILEV > DZ ) EXIT
    1368             : 
    1369             :        ! If input level is beyond vert. extent of input data, set output
    1370             :        ! data to zero.
    1371           0 :        IF ( InLev > NZ ) THEN
    1372           0 :           Lct%Dct%Dta%V3(T)%Val(:,:,ILEV) = 0.0_hp
    1373             : 
    1374             :        ! Otherwise, evenly distribute input data
    1375             :        ELSE
    1376           0 :           Lct%Dct%Dta%V3(T)%Val(:,:,ILEV) = REGR_4D(:,:,InLev,T)
    1377             :        ENDIF
    1378             :     ENDDO
    1379             : 
    1380           0 :   END SUBROUTINE INFLATE
    1381             : !EOC
    1382             : END MODULE HCO_Interp_Mod

Generated by: LCOV version 1.14