Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hemcox_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 0 : MSG = 'Use Ginoux dust emissions (extension module)'
564 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
565 :
566 0 : IF ( Inst%ExtNrAlk > 0 ) THEN
567 0 : MSG = 'Use dust alkalinity option'
568 0 : CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
569 : ENDIF
570 :
571 0 : MSG = 'Use the following species (Name: HcoID):'
572 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
573 0 : DO N = 1, nSpc
574 0 : WRITE(MSG,*) TRIM(SpcNames(N)), ':', Inst%HcoIDs(N)
575 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
576 : ENDDO
577 0 : IF ( Inst%ExtNrAlk > 0 ) THEN
578 0 : DO N = 1, nSpcAlk
579 0 : WRITE(MSG,*) TRIM(SpcNamesAlk(N)), ':', Inst%HcoIDsAlk(N)
580 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
581 : ENDDO
582 : ENDIF
583 :
584 0 : WRITE(MSG,*) 'Global mass flux tuning factor: ', Inst%CH_DUST
585 0 : CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2='-')
586 : ENDIF
587 :
588 : ! Allocate vectors holding bin-specific informations
589 0 : ALLOCATE ( Inst%IPOINT (Inst%NBINS) )
590 0 : ALLOCATE ( Inst%FRAC_S (Inst%NBINS) )
591 0 : ALLOCATE ( Inst%DUSTDEN (Inst%NBINS) )
592 0 : ALLOCATE ( Inst%DUSTREFF(Inst%NBINS) )
593 0 : ALLOCATE ( Inst%FLUX (HcoState%NX,HcoState%NY,Inst%NBINS) )
594 0 : ALLOCATE ( Inst%FLUX_ALK(HcoState%NX,HcoState%NY,Inst%NBINS) )
595 :
596 : ! Allocate arrays
597 : ALLOCATE ( Inst%SRCE_SAND ( HcoState%NX, HcoState%NY ), &
598 : Inst%SRCE_SILT ( HcoState%NX, HcoState%NY ), &
599 : Inst%SRCE_CLAY ( HcoState%NX, HcoState%NY ), &
600 0 : STAT = AS )
601 0 : IF ( AS /= 0 ) THEN
602 0 : CALL HCO_ERROR('Allocation error', RC )
603 0 : RETURN
604 : ENDIF
605 :
606 : ! Init
607 0 : Inst%FLUX = 0.0_hp
608 0 : Inst%FLUX_ALK = 0.0_hp
609 0 : Inst%SRCE_SAND = 0.0_hp
610 0 : Inst%SRCE_SILT = 0.0_hp
611 0 : Inst%SRCE_CLAY = 0.0_hp
612 :
613 :
614 : !=======================================================================
615 : ! Setup for simulations that use 4 dust bins (w/ or w/o TOMAS)
616 : !=======================================================================
617 :
618 : ! Fill bin-specific information
619 0 : IF ( Inst%NBINS == 4 ) THEN
620 :
621 0 : Inst%IPOINT (1:Inst%NBINS) = (/ 3, 2, 2, 2 /)
622 0 : Inst%FRAC_S (1:Inst%NBINS) = (/ 0.095d0, 0.3d0, 0.3d0, 0.3d0 /)
623 0 : Inst%DUSTDEN (1:Inst%NBINS) = (/ 2500.d0, 2650.d0, 2650.d0, 2650.d0 /)
624 0 : Inst%DUSTREFF(1:Inst%NBINS) = (/ 0.73d-6, 1.4d-6, 2.4d-6, 4.5d-6 /)
625 :
626 : ELSE
627 :
628 : #if !defined( TOMAS )
629 0 : MSG = 'Cannot have > 4 GINOUX dust bins unless you are using TOMAS!'
630 0 : CALL HCO_ERROR(MSG, RC )
631 0 : RETURN
632 : #endif
633 :
634 : ENDIF
635 :
636 : #if defined( TOMAS )
637 :
638 : !=======================================================================
639 : ! Setup for TOMAS simulations using more than 4 dust bins
640 : !
641 : ! from Ginoux:
642 : ! The U.S. Department of Agriculture (USDA) defines particles
643 : ! with a radius between 1 um and 25 um as silt, and below 1 um
644 : ! as clay [Hillel, 1982]. Mineralogical silt particles are mainly
645 : ! composed of quartz, but they are often coated with strongly
646 : ! adherent clay such that their physicochemical properties are
647 : ! similar to clay [Hillel, 1982].
648 : !
649 : ! SRCE_FUNC Source function
650 : ! for 1: Sand, 2: Silt, 3: Clay
651 : !=======================================================================
652 : IF ( Inst%NBINS == HcoState%MicroPhys%nBins ) THEN
653 :
654 : !--------------------------------------------------------------------
655 : ! Define the IPOINT array based on particle size
656 : !--------------------------------------------------------------------
657 :
658 : ! Loop over # of TOMAS bins
659 : DO N = 1, HcoState%MicroPhys%nBins
660 :
661 : ! Compute particle mass and radius
662 : Mp = 1.4 * HcoState%MicroPhys%BinBound(N)
663 : Rp = ( ( Mp /2500. ) * (3./(4.*HcoState%Phys%PI)))**(0.333)
664 :
665 : ! Pick the source function based on particle size
666 : IF ( Rp < 1.d-6 ) THEN
667 : Inst%IPOINT(N) = 3
668 : ELSE
669 : Inst%IPOINT(N) = 2
670 : END IF
671 : END DO
672 :
673 : !--------------------------------------------------------------------
674 : ! Set up dust density (DUSTDEN) array
675 : !--------------------------------------------------------------------
676 : DO N = 1, HcoState%MicroPhys%nBins
677 : IF ( HcoState%MicroPhys%BinBound(N) < 4.0D-15 ) THEN
678 : Inst%DUSTDEN(N) = 2500.d0
679 : ELSE
680 : Inst%DUSTDEN(N) = 2650.d0
681 : ENDIF
682 : ENDDO
683 :
684 : !--------------------------------------------------------------------
685 : ! Set up dust density (DUSTDEN) array
686 : !--------------------------------------------------------------------
687 : DO N = 1, HcoState%MicroPhys%nBins
688 : Inst%DUSTREFF(N) = 0.5d0 &
689 : * ( SQRT( HcoState%MicroPhys%BinBound(N) * &
690 : HcoState%MicroPhys%BinBound(N+1) ) &
691 : / Inst%DUSTDEN(N) * 6.d0/HcoState%Phys%PI )**( 0.333d0 )
692 : ENDDO
693 :
694 : !--------------------------------------------------------------------
695 : ! Set up the FRAC_S array
696 : !--------------------------------------------------------------------
697 :
698 : ! Initialize
699 : Inst%FRAC_S( 1:HcoState%MicroPhys%nBins ) = 0d0
700 :
701 : # if defined( TOMAS12 ) || defined( TOMAS15 )
702 :
703 : !---------------------------------------------------
704 : ! TOMAS simulations with 12 or 15 size bins
705 : !---------------------------------------------------
706 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 1 ) = 7.33E-10
707 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 2 ) = 2.032E-08
708 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 3 ) = 3.849E-07
709 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 4 ) = 5.01E-06
710 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 5 ) = 4.45E-05
711 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 6 ) = 2.714E-04
712 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 7 ) = 1.133E-03
713 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 8 ) = 3.27E-03
714 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 9 ) = 6.81E-03
715 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 10 ) = 1.276E-02
716 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 11 ) = 2.155E-01
717 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 12 ) = 6.085E-01
718 :
719 : # else
720 :
721 : !---------------------------------------------------
722 : ! TOMAS simulations with 30 or 40 size bins
723 : !---------------------------------------------------
724 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 1 ) = 1.05d-10
725 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 2 ) = 6.28d-10
726 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 3 ) = 3.42d-09
727 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 4 ) = 1.69d-08
728 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 5 ) = 7.59d-08
729 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 6 ) = 3.09d-07
730 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 7 ) = 1.15d-06
731 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 8 ) = 3.86d-06
732 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 9 ) = 1.18d-05
733 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 10 ) = 3.27d-05
734 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 11 ) = 8.24d-05
735 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 12 ) = 1.89d-04
736 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 13 ) = 3.92d-04
737 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 14 ) = 7.41d-04
738 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 15 ) = 1.27d-03
739 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 16 ) = 2.00d-03
740 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 17 ) = 2.89d-03
741 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 18 ) = 3.92d-03
742 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 19 ) = 5.26d-03
743 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 20 ) = 7.50d-03
744 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 21 ) = 1.20d-02
745 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 22 ) = 2.08d-02
746 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 23 ) = 3.62d-02
747 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 24 ) = 5.91d-02
748 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 25 ) = 8.74d-02
749 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 26 ) = 1.15d-01
750 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 27 ) = 1.34d-01
751 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 28 ) = 1.37d-01
752 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 29 ) = 1.24d-01
753 : Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 30 ) = 9.85d-02
754 :
755 : # endif
756 :
757 : ELSE
758 :
759 : ! Stop w/ error message
760 : CALL HCO_ERROR( 'Wrong number of TOMAS dust bins!', RC )
761 :
762 : ENDIF
763 :
764 : #endif
765 :
766 : !=====================================================================
767 : ! Activate fields in ExtState used by Ginoux dust
768 : !=====================================================================
769 :
770 : ! Activate met. fields required by this module
771 0 : ExtState%U10M%DoUse = .TRUE.
772 0 : ExtState%V10M%DoUse = .TRUE.
773 0 : ExtState%GWETTOP%DoUse = .TRUE.
774 :
775 : !=======================================================================
776 : ! Leave w/ success
777 : !=======================================================================
778 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
779 :
780 : ! Nullify pointers
781 0 : Inst => NULL()
782 :
783 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
784 :
785 0 : END SUBROUTINE HcoX_DustGinoux_Init
786 : !EOC
787 : !------------------------------------------------------------------------------
788 : ! Harmonized Emissions Component (HEMCO) !
789 : !------------------------------------------------------------------------------
790 : !BOP
791 : !
792 : ! !IROUTINE: HCOX_DustGinoux_Final
793 : !
794 : ! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Final finalizes the HEMCO
795 : ! DUSTGINOUX extension.
796 : !\\
797 : !\\
798 : ! !INTERFACE:
799 : !
800 0 : SUBROUTINE HcoX_DustGinoux_Final( ExtState )
801 : !
802 : ! !INPUT PARAMETERS:
803 : !
804 : TYPE(Ext_State), POINTER :: ExtState ! Module options
805 : !
806 : ! !REVISION HISTORY:
807 : ! 11 Dec 2013 - C. Keller - Now a HEMCO extension
808 : ! See https://github.com/geoschem/hemco for complete history
809 : !EOP
810 : !------------------------------------------------------------------------------
811 : !BOC
812 :
813 : !=======================================================================
814 : ! HCOX_DUSTGINOUX_FINAL begins here!
815 : !=======================================================================
816 :
817 0 : CALL InstRemove ( ExtState%DustGinoux )
818 :
819 :
820 :
821 0 : END SUBROUTINE HcoX_DustGinoux_Final
822 : !EOC
823 : !------------------------------------------------------------------------------
824 : ! Harmonized Emissions Component (HEMCO) !
825 : !------------------------------------------------------------------------------
826 : !BOP
827 : !
828 : ! !IROUTINE: HCOX_DustGinoux_GetChDust
829 : !
830 : ! !DESCRIPTION: Function HCOX\_DustGinoux\_GetChDust returns the CH\_DUST
831 : ! parameter for the current simulation type.
832 : !\\
833 : !\\
834 : ! !INTERFACE:
835 : !
836 0 : FUNCTION HCOX_DustGinoux_GetChDust( Inst, HcoState ) RESULT( CH_DUST )
837 : !
838 : ! !INPUT PARAMETERS:
839 : !
840 : TYPE(MyInst), POINTER :: Inst ! Instance
841 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
842 : !
843 : ! !RETURN VALUE:
844 : !
845 : REAL*8 :: CH_DUST
846 : !
847 : ! !REMARKS:
848 : ! The logic in the #ifdefs may need to be cleaned up later on. We have
849 : ! just replicated the existing code in pre-HEMCO versions of dust_mod.F.
850 : !
851 : ! !REVISION HISTORY:
852 : ! 11 Dec 2013 - C. Keller - Initial version
853 : ! See https://github.com/geoschem/hemco for complete history
854 : !EOP
855 : !------------------------------------------------------------------------------
856 : !BOC
857 : !
858 : ! !LOCAL VARIABLES:
859 : !
860 : ! Transfer coeff for type natural source (kg*s2/m5)
861 : ! Emission reduction factor for China-nested grid domain (win, 4/27/08)
862 :
863 0 : IF ( TRIM(HcoState%Config%GridRes) == '4.0x5.0' ) THEN
864 :
865 : !-----------------------------------------------------------------------
866 : ! All 4x5 simulations (including TOMAS)
867 : !-----------------------------------------------------------------------
868 0 : Inst%CH_DUST = 9.375d-10
869 :
870 : ELSE
871 :
872 : !-----------------------------------------------------------------------
873 : ! All other resolutions
874 : !-----------------------------------------------------------------------
875 :
876 : ! Start w/ same value as for 4x5
877 0 : Inst%CH_DUST = 9.375d-10
878 :
879 : #if defined( TOMAS )
880 : ! KLUDGE: For TOMAS simulations at grids higher than 4x5 (e.g. 2x25),
881 : ! then multiplyCH_DUST by 0.75. (Sal Farina)
882 : Inst%CH_DUST = Inst%CH_DUST * 0.75d0
883 : #endif
884 :
885 : ENDIF
886 :
887 0 : END FUNCTION HCOX_DustGinoux_GetChDust
888 : !EOC
889 : !------------------------------------------------------------------------------
890 : ! Harmonized Emissions Component (HEMCO) !
891 : !------------------------------------------------------------------------------
892 : !BOP
893 : !
894 : ! !IROUTINE: InstGet
895 : !
896 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
897 : !\\
898 : !\\
899 : ! !INTERFACE:
900 : !
901 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
902 : !
903 : ! !INPUT PARAMETERS:
904 : !
905 : INTEGER :: Instance
906 : TYPE(MyInst), POINTER :: Inst
907 : INTEGER :: RC
908 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
909 : !
910 : ! !REVISION HISTORY:
911 : ! 18 Feb 2016 - C. Keller - Initial version
912 : ! See https://github.com/geoschem/hemco for complete history
913 : !EOP
914 : !------------------------------------------------------------------------------
915 : !BOC
916 : TYPE(MyInst), POINTER :: PrvInst
917 :
918 : !=================================================================
919 : ! InstGet begins here!
920 : !=================================================================
921 :
922 : ! Get instance. Also archive previous instance.
923 0 : PrvInst => NULL()
924 0 : Inst => AllInst
925 0 : DO WHILE ( ASSOCIATED(Inst) )
926 0 : IF ( Inst%Instance == Instance ) EXIT
927 0 : PrvInst => Inst
928 0 : Inst => Inst%NextInst
929 : END DO
930 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
931 0 : RC = HCO_FAIL
932 0 : RETURN
933 : ENDIF
934 :
935 : ! Pass output arguments
936 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
937 :
938 : ! Cleanup & Return
939 0 : PrvInst => NULL()
940 0 : RC = HCO_SUCCESS
941 :
942 : END SUBROUTINE InstGet
943 : !EOC
944 : !------------------------------------------------------------------------------
945 : ! Harmonized Emissions Component (HEMCO) !
946 : !------------------------------------------------------------------------------
947 : !BOP
948 : !
949 : ! !IROUTINE: InstCreate
950 : !
951 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
952 : !\\
953 : !\\
954 : ! !INTERFACE:
955 : !
956 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
957 : !
958 : ! !INPUT PARAMETERS:
959 : !
960 : INTEGER, INTENT(IN) :: ExtNr
961 : !
962 : ! !OUTPUT PARAMETERS:
963 : !
964 : INTEGER, INTENT( OUT) :: Instance
965 : TYPE(MyInst), POINTER :: Inst
966 : !
967 : ! !INPUT/OUTPUT PARAMETERS:
968 : !
969 : INTEGER, INTENT(INOUT) :: RC
970 : !
971 : ! !REVISION HISTORY:
972 : ! 18 Feb 2016 - C. Keller - Initial version
973 : ! See https://github.com/geoschem/hemco for complete history
974 : !EOP
975 : !------------------------------------------------------------------------------
976 : !BOC
977 : TYPE(MyInst), POINTER :: TmpInst
978 : INTEGER :: nnInst
979 :
980 : !=================================================================
981 : ! InstCreate begins here!
982 : !=================================================================
983 :
984 : ! ----------------------------------------------------------------
985 : ! Generic instance initialization
986 : ! ----------------------------------------------------------------
987 :
988 : ! Initialize
989 0 : Inst => NULL()
990 :
991 : ! Get number of already existing instances
992 0 : TmpInst => AllInst
993 0 : nnInst = 0
994 0 : DO WHILE ( ASSOCIATED(TmpInst) )
995 0 : nnInst = nnInst + 1
996 0 : TmpInst => TmpInst%NextInst
997 : END DO
998 :
999 : ! Create new instance
1000 0 : ALLOCATE(Inst)
1001 0 : Inst%Instance = nnInst + 1
1002 0 : Inst%ExtNr = ExtNr
1003 :
1004 : ! Attach to instance list
1005 0 : Inst%NextInst => AllInst
1006 0 : AllInst => Inst
1007 :
1008 : ! Update output instance
1009 0 : Instance = Inst%Instance
1010 :
1011 : ! ----------------------------------------------------------------
1012 : ! Type specific initialization statements follow below
1013 : ! ----------------------------------------------------------------
1014 :
1015 : ! Return w/ success
1016 0 : RC = HCO_SUCCESS
1017 :
1018 0 : END SUBROUTINE InstCreate
1019 : !EOC
1020 : !------------------------------------------------------------------------------
1021 : ! Harmonized Emissions Component (HEMCO) !
1022 : !------------------------------------------------------------------------------
1023 : !BOP
1024 : !BOP
1025 : !
1026 : ! !IROUTINE: InstRemove
1027 : !
1028 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
1029 : !\\
1030 : !\\
1031 : ! !INTERFACE:
1032 : !
1033 0 : SUBROUTINE InstRemove ( Instance )
1034 : !
1035 : ! !INPUT PARAMETERS:
1036 : !
1037 : INTEGER :: Instance
1038 : !
1039 : ! !REVISION HISTORY:
1040 : ! 18 Feb 2016 - C. Keller - Initial version
1041 : ! See https://github.com/geoschem/hemco for complete history
1042 : !EOP
1043 : !------------------------------------------------------------------------------
1044 : !BOC
1045 : INTEGER :: RC
1046 : TYPE(MyInst), POINTER :: PrevInst
1047 : TYPE(MyInst), POINTER :: Inst
1048 :
1049 : !=================================================================
1050 : ! InstRemove begins here!
1051 : !=================================================================
1052 :
1053 : ! Init
1054 0 : PrevInst => NULL()
1055 0 : Inst => NULL()
1056 :
1057 : ! Get instance. Also archive previous instance.
1058 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
1059 :
1060 : ! Instance-specific deallocation
1061 0 : IF ( ASSOCIATED(Inst) ) THEN
1062 :
1063 : !---------------------------------------------------------------------
1064 : ! Deallocate fields of Inst before popping Inst off the list
1065 : ! in order to avoid memory leaks (Bob Yantosca, 17 Aug 2020)
1066 : !---------------------------------------------------------------------
1067 0 : IF ( ASSOCIATED( Inst%SRCE_SAND ) ) THEN
1068 0 : DEALLOCATE( Inst%SRCE_SAND )
1069 : ENDIF
1070 0 : Inst%SRCE_SAND => NULL()
1071 :
1072 0 : IF ( ASSOCIATED( Inst%SRCE_SILT ) ) THEN
1073 0 : DEALLOCATE( Inst%SRCE_SILT )
1074 : ENDIF
1075 0 : Inst%SRCE_SILT => NULL()
1076 :
1077 0 : IF ( ASSOCIATED( Inst%SRCE_CLAY ) ) THEN
1078 0 : DEALLOCATE( Inst%SRCE_CLAY )
1079 : ENDIF
1080 0 : Inst%SRCE_CLAY => NULL()
1081 :
1082 0 : IF ( ASSOCIATED( Inst%IPOINT ) ) THEN
1083 0 : DEALLOCATE( Inst%IPOINT )
1084 : ENDIF
1085 0 : Inst%IPOINT => NULL()
1086 :
1087 0 : IF ( ASSOCIATED( Inst%FRAC_S ) ) THEN
1088 0 : DEALLOCATE( Inst%FRAC_S )
1089 : ENDIf
1090 0 : Inst%FRAC_S => NULL()
1091 :
1092 0 : IF ( ASSOCIATED( Inst%DUSTDEN ) ) THEN
1093 0 : DEALLOCATE( Inst%DUSTDEN )
1094 : ENDIF
1095 0 : Inst%DUSTDEN => NULL()
1096 :
1097 0 : IF ( ASSOCIATED( Inst%DUSTREFF ) ) THEN
1098 0 : DEALLOCATE( Inst%DUSTREFF )
1099 : ENDIF
1100 0 : Inst%DUSTREFF => NULL()
1101 :
1102 0 : IF ( ASSOCIATED( Inst%FLUX ) ) THEN
1103 0 : DEALLOCATE( Inst%FLUX )
1104 : ENDIF
1105 0 : Inst%FLUX => NULL()
1106 :
1107 0 : IF ( ASSOCIATED( Inst%FLUX_ALK ) ) THEN
1108 0 : DEALLOCATE( Inst%FLUX_ALK )
1109 : ENDIF
1110 0 : Inst%FLUX_ALK => NULL()
1111 :
1112 0 : IF ( ALLOCATED ( Inst%HcoIDs ) ) THEN
1113 0 : DEALLOCATE( Inst%HcoIDs )
1114 : ENDIF
1115 :
1116 0 : IF ( ALLOCATED ( Inst%HcoIDsALK ) ) THEN
1117 0 : DEALLOCATE( Inst%HcoIDsALK )
1118 : ENDIF
1119 :
1120 : !---------------------------------------------------------------------
1121 : ! Pop off instance from list
1122 : !---------------------------------------------------------------------
1123 0 : IF ( ASSOCIATED(PrevInst) ) THEN
1124 0 : PrevInst%NextInst => Inst%NextInst
1125 : ELSE
1126 0 : AllInst => Inst%NextInst
1127 : ENDIF
1128 0 : DEALLOCATE(Inst)
1129 : ENDIF
1130 :
1131 : ! Free pointers before exiting
1132 0 : PrevInst => NULL()
1133 0 : Inst => NULL()
1134 :
1135 0 : END SUBROUTINE InstRemove
1136 : !EOC
1137 0 : END MODULE HCOX_DustGinoux_Mod
|
