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