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
|