1712 lines
63 KiB
Fortran
1712 lines
63 KiB
Fortran
! $Id: dust_mod.f,v 1.1 2012/03/01 22:00:27 daven Exp $
|
|
MODULE DUST_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module DUST_MOD contains routines for computing dust aerosol emissions,
|
|
! chemistry, and optical depths. (rjp, tdf, bmy, 4/14/04, 1/23/07)
|
|
!
|
|
! Module Variables:
|
|
! ============================================================================
|
|
! (1 ) FRAC_S (REAL*8 ) : Fraction of each size classes (GINOUX only)
|
|
! (2 ) DUSTREFF (REAL*8 ) : Dust particle radii [m]
|
|
! (3 ) DUSTDEN (REAL*8 ) : Soil density [kg/m3]
|
|
! (4 ) IDDEP (INTEGER) : Dust ID flags for drydep
|
|
! (5 ) DRYDST1 (INTEGER) : Index for DST1 in drydep array
|
|
! (6 ) DRYDST2 (INTEGER) : Index for DST2 in drydep array
|
|
! (7 ) DRYDST3 (INTEGER) : Index for DST3 in drydep array
|
|
! (8 ) DRYDST4 (INTEGER) : Index for DST4 in drydep array
|
|
!
|
|
! Module Routines:
|
|
! ============================================================================
|
|
! (1 ) CHEMDUST : Driver routine for dust chemistry
|
|
! (2 ) DRY_SETTLING : Routine which performs dust settling
|
|
! (3 ) DRY_DEPOSITION : Routine which performs dust dry deposition
|
|
! (4 ) EMISSDUST : Driver routine for dust emission
|
|
! (5 ) SRC_DUST_DEAD : Dust emissions according to DEAD source function
|
|
! (6 ) SRC_DUST_GINOUX : Dust emissions according to GINOUX source function
|
|
! (7 ) RDUST_ONLINE : Computes dust optical depths (online dust)
|
|
! (8 ) RDUST_OFFLINE : Computes dust optical depths (monthly mean dust)
|
|
! (9 ) GET_SCALE_GROUP : Return index of emission group
|
|
! (10) INIT_DUST : Allocates & initializes all module variables
|
|
! (11) CLEANUP_DUST : Deallocates all module variables
|
|
!
|
|
! GEOS-CHEM modules referenced by "dust_mod.f"
|
|
! ============================================================================
|
|
! (1 ) dao_mod.f : Module containing arrays for DAO met fields
|
|
! (2 ) diag_mod.f : Module containing GEOS-CHEM diagnostic arrays
|
|
! (3 ) directory_mod.f : Module containing GEOS-CHEM data & met field dirs
|
|
! (4 ) drydep_mod.f : Module containing GEOS-CHEM drydep routines
|
|
! (5 ) dust_dead_mod.f : Module containing Zender's DEAD dust routines
|
|
! (6 ) error_mod.f : Module containing I/O error and NaN check routines
|
|
! (7 ) file_mod.f : Contains file unit numbers and error checks
|
|
! (8 ) grid_mod.f : Module containing horizontal grid information
|
|
! (9 ) logical_mod.f : Module containing GEOS-CHEM logical switches
|
|
! (10) pressure_mod.f : Module containing routines to compute P(I,J,L)
|
|
! (11) time_mod.f : Module containing routines for computing time/date
|
|
! (12) tracer_mod.f : Module containing GEOS-CHEM tracer array STT etc.
|
|
! (13) tracerid_mod.f : Module containing pointers to tracers & emissions
|
|
!
|
|
! NOTES:
|
|
! (1 ) Bug fix in SRC_DUST_DEAD (bmy, 4/14/04)
|
|
! (2 ) Now references "logical_mod.f", "directory_mod.f", and "tracer_mod.f"
|
|
! Added comments. (bmy, 7/2/04)
|
|
! (3 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (4 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
|
|
! (5 ) Bug fix in snow height computation (bmy, 11/18/05)
|
|
! (6 ) Now only do drydep if LDRYD=T (bmy, 5/23/06)
|
|
! (7 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (8 ) Updated output print statement in SRC_DUST_DEAD (bmy, 1/23/07)
|
|
! (9 ) Modifications for GEOS-5 (bmy, 1/24/07)
|
|
! (10) Modified to archive only hydrophilic aerosol/aqueous dust surface area
|
|
! (excluding BCPO and OCPO) for aqueous chemistry calculations
|
|
! Dust surfaces are considered aqueous only when RH > 35% (tmf, 3/6/09)
|
|
! (11) Updated for dust emission adjoint (xxu, dkh, 01/13/12, adj32_011)
|
|
!******************************************************************************
|
|
!
|
|
IMPLICIT NONE
|
|
|
|
!=================================================================
|
|
! MODULE PRIVATE DECLARATIONS -- keep certain internal variables
|
|
! and routines from being seen outside "dust_mod.f"
|
|
!=================================================================
|
|
|
|
! PRIVATE module variables
|
|
PRIVATE :: DRYDST1, DRYDST2, DRYDST3, DRYDST4
|
|
! Make some public for use with adjoint (dkh, 01/10/12, adj32_011)
|
|
!PRIVATE :: DUSTDEN, DUSTREFF, FRAC_S, IDDEP
|
|
PRIVATE :: FRAC_S
|
|
|
|
! PRIVATE module routines
|
|
PRIVATE :: DRY_SETTLING
|
|
PRIVATE :: DRY_DEPOSITION
|
|
PRIVATE :: SRC_DUST_DEAD
|
|
PRIVATE :: SRC_DUST_GINOUX
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
INTEGER :: DRYDST1, DRYDST2, DRYDST3, DRYDST4
|
|
INTEGER, ALLOCATABLE :: IDDEP(:)
|
|
REAL*8, ALLOCATABLE :: FRAC_S(:)
|
|
REAL*8, ALLOCATABLE :: DUSTREFF(:)
|
|
REAL*8, ALLOCATABLE :: DUSTDEN(:)
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
SUBROUTINE CHEMDUST
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CHEMDUST is the interface between the GEOS-CHEM main program and
|
|
! the dust chemistry routines that mostly calculates dust dry deposition.
|
|
! (tdf, bmy, 3/30/04, 5/23/06)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now references STT from "tracer_mod.f" and LDUST from "logical_mod.f"
|
|
! (bmy, 7/20/04)
|
|
! (5 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (6 ) Now only do dry deposition if LDRYD = T (bmy, 5/23/06)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE LOGICAL_MOD, ONLY : LDRYD, LDUST
|
|
USE DRYDEP_MOD, ONLY : DEPNAME, NUMDEP
|
|
USE TRACER_MOD, ONLY : STT
|
|
USE TRACERID_MOD, ONLY : IDTDST1, IDTDST2, IDTDST3, IDTDST4
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: N
|
|
|
|
!=================================================================
|
|
! CHEMDUST begins here!
|
|
!=================================================================
|
|
|
|
! Execute on first call only
|
|
IF ( FIRST ) THEN
|
|
|
|
! Stop w/ error if dust tracer flags are undefined
|
|
IF ( IDTDST1 + IDTDST2 + IDTDST3 + IDTDST4 == 0 ) THEN
|
|
IF ( LDUST ) THEN
|
|
CALL ERROR_STOP(
|
|
& 'LDUST=T but dust tracers are undefined!',
|
|
& 'EMISSDUST ("dust_mod.f")' )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! Allocate arrays (if necessary)
|
|
CALL INIT_DUST
|
|
|
|
! Find drydep species in DEPSAV
|
|
DO N = 1, NUMDEP
|
|
SELECT CASE ( TRIM( DEPNAME(N) ) )
|
|
CASE ( 'DST1' )
|
|
DRYDST1 = N
|
|
CASE ( 'DST2' )
|
|
DRYDST2 = N
|
|
CASE ( 'DST3' )
|
|
DRYDST3 = N
|
|
CASE ( 'DST4' )
|
|
DRYDST4 = N
|
|
CASE DEFAULT
|
|
! Nothing
|
|
END SELECT
|
|
ENDDO
|
|
|
|
! This may lead to out of bounds errors
|
|
IDDEP(1) = DRYDST1
|
|
IDDEP(2) = DRYDST2
|
|
IDDEP(3) = DRYDST3
|
|
IDDEP(4) = DRYDST4
|
|
|
|
! Reset first-time flag
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Do dust settling & deposition
|
|
!=================================================================
|
|
|
|
! Dust settling
|
|
CALL DRY_SETTLING( STT(:,:,:,IDTDST1:IDTDST4) )
|
|
|
|
! Dust deposition
|
|
IF ( LDRYD ) THEN
|
|
CALL DRY_DEPOSITION( STT(:,:,:,IDTDST1:IDTDST4) )
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CHEMDUST
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE DRY_SETTLING( TC )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine DRY_SETTLING computes the dry settling of dust tracers.
|
|
! (tdf, bmy, 3/30/04, 10/25/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) TC (REAL*8) : Dust tracer array
|
|
!
|
|
! NOTES
|
|
! (1 ) Updated comments, cosmetic changes (bmy, 3/30/04)
|
|
! (2 ) Remove reference to CMN, it's not needed (bmy, 7/20/04)
|
|
! (3 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
|
|
!******************************************************************************
|
|
!
|
|
USE DAO_MOD, ONLY : T, BXHEIGHT
|
|
USE DIAG_MOD, ONLY : AD44
|
|
USE PRESSURE_MOD, ONLY : GET_PCENTER
|
|
USE TIME_MOD, ONLY : GET_TS_CHEM
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTDST1
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_GCTM" ! g0
|
|
# include "CMN_DIAG" ! ND44
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR,NDSTBIN)
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, L, N
|
|
REAL*8 :: DT_SETTL, DELZ, DELZ1
|
|
REAL*8 :: REFF, DEN, CONST
|
|
REAL*8 :: NUM, LAMDA, FLUX
|
|
REAL*8 :: AREA_CM2, TC0(LLPAR)
|
|
REAL*8 :: TOT1, TOT2
|
|
|
|
! Pressure in Kpa 1 mb = 100 pa = 0.1 kPa
|
|
REAL*8 :: P
|
|
|
|
! Diameter of aerosol [um]
|
|
REAL*8 :: Dp
|
|
|
|
! Pressure * DP
|
|
REAL*8 :: PDp
|
|
|
|
! Temperature (K)
|
|
REAL*8 :: TEMP
|
|
|
|
! Slip correction factor
|
|
REAL*8 :: Slip
|
|
|
|
! Viscosity of air (Pa s)
|
|
REAL*8 :: Visc
|
|
|
|
! Settling velocity of particle (m/s)
|
|
REAL*8 :: VTS(LLPAR)
|
|
|
|
! Parameters
|
|
REAL*8, PARAMETER :: C1 = 0.7674D0
|
|
REAL*8, PARAMETER :: C2 = 3.079d0
|
|
REAL*8, PARAMETER :: C3 = 2.573D-11
|
|
REAL*8, PARAMETER :: C4 = -1.424d0
|
|
|
|
!=================================================================
|
|
! DRY_SETTLING begins here!
|
|
!=================================================================
|
|
|
|
! Dust settling timestep [s]
|
|
DT_SETTL = GET_TS_CHEM() * 60d0
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N, DEN, REFF, DP )
|
|
!$OMP+PRIVATE( CONST, AREA_CM2, VTS, TEMP, P, PDP, SLIP )
|
|
!$OMP+PRIVATE( VISC, TC0, DELZ, DELZ1, TOT1, TOT2, FLUX )
|
|
|
|
! Loop over dust bins
|
|
DO N = 1, NDSTBIN
|
|
|
|
! Initialize
|
|
DEN = DUSTDEN(N)
|
|
REFF = DUSTREFF(N)
|
|
DP = 2D0 * REFF * 1.D6 ! Dp [um] = particle diameter
|
|
CONST = 2D0 * DEN * REFF**2 * G0 / 9D0
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Surface area [cm2]
|
|
AREA_CM2 = GET_AREA_CM2(J)
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Initialize settling velocity
|
|
DO L = 1, LLPAR
|
|
VTS(L) = 0d0
|
|
ENDDO
|
|
|
|
! Loop over levels
|
|
DO L = 1, LLPAR
|
|
|
|
! Get P [kPa], T [K], and P*DP
|
|
P = GET_PCENTER(I,J,L) * 0.1d0
|
|
TEMP = T(I,J,L)
|
|
PDP = P * DP
|
|
|
|
!=====================================================
|
|
! # air molecule number density
|
|
! num = P * 1d3 * 6.023d23 / (8.314 * Temp)
|
|
!
|
|
! # gas mean free path
|
|
! lamda = 1.d6 /
|
|
! & ( 1.41421 * num * 3.141592 * (3.7d-10)**2 )
|
|
!
|
|
! # Slip correction
|
|
! Slip = 1. + 2. * lamda * (1.257 + 0.4 *
|
|
! & exp( -1.1 * Dp / (2. * lamda))) / Dp
|
|
!=====================================================
|
|
! NOTE, Slip correction factor calculations following
|
|
! Seinfeld, pp464 which is thought to be more
|
|
! accurate but more computation required.
|
|
!=====================================================
|
|
|
|
! Slip correction factor as function of (P*dp)
|
|
SLIP = 1d0 +
|
|
& ( 15.60d0 + 7.0d0 * EXP(-0.059d0*PDP) ) / PDP
|
|
|
|
!=====================================================
|
|
! NOTE, Eq) 3.22 pp 50 in Hinds (Aerosol Technology)
|
|
! which produce slip correction factor with small
|
|
! error compared to the above with less computation.
|
|
!=====================================================
|
|
|
|
! Viscosity [Pa s] of air as a function of temp (K)
|
|
VISC = 1.458d-6 * (TEMP)**(1.5d0) / ( TEMP + 110.4d0 )
|
|
|
|
! Settling velocity [m/s]
|
|
VTS(L) = CONST * SLIP / VISC
|
|
|
|
ENDDO
|
|
|
|
! Method is to solve bidiagonal matrix
|
|
! which is implicit and first order accurate in Z
|
|
DO L = 1, LLPAR
|
|
TC0(L) = TC(I,J,L,N)
|
|
ENDDO
|
|
|
|
! We know the boundary condition at the model top
|
|
L = LLTROP
|
|
DELZ = BXHEIGHT(I,J,L)
|
|
TC(I,J,L,N) = TC(I,J,L,N) /
|
|
& ( 1.d0 + DT_SETTL * VTS(L) / DELZ )
|
|
|
|
DO L = LLTROP-1, 1, -1
|
|
DELZ = BXHEIGHT(I,J,L)
|
|
DELZ1 = BXHEIGHT(I,J,L+1)
|
|
TC(I,J,L,N) = 1.d0 /
|
|
& ( 1.d0 + DT_SETTL * VTS(L) / DELZ )
|
|
& * (TC(I,J,L,N) + DT_SETTL * VTS(L+1) / DELZ1
|
|
& * TC(I,J,L+1,N) )
|
|
ENDDO
|
|
|
|
!========================================================
|
|
! ND44: Dry deposition diagnostic [#/cm2/s]
|
|
!========================================================
|
|
IF ( ND44 > 0 ) THEN
|
|
|
|
! Initialize
|
|
TOT1 = 0d0
|
|
TOT2 = 0d0
|
|
|
|
! Compute column totals of TCO(:) and TC(I,J,:,N)
|
|
DO L = 1, LLPAR
|
|
TOT1 = TOT1 + TC0(L)
|
|
TOT2 = TOT2 + TC(I,J,L,N)
|
|
ENDDO
|
|
|
|
! Convert dust flux from [kg/s] to [#/cm2/s]
|
|
FLUX = ( TOT1 - TOT2 ) / DT_SETTL
|
|
FLUX = FLUX * XNUMOL(IDTDST1) / AREA_CM2
|
|
|
|
! Save in AD44
|
|
AD44(I,J,IDDEP(N),1) = AD44(I,J,IDDEP(N),1) + FLUX
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE DRY_SETTLING
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE DRY_DEPOSITION( TC )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine DRY_DEPOSITION computes the loss of dust due to dry deposition
|
|
! at the surface using an implicit method. (tdf, bmy, 3/30/04, 10/25/05)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) TC (REAL*8) : Dust tracer array
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now references XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIAG_MOD, ONLY : AD44
|
|
USE DRYDEP_MOD, ONLY : DEPSAV
|
|
USE TIME_MOD, ONLY : GET_TS_CHEM
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTDST1
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND44
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR,NDSTBIN)
|
|
|
|
! local variables
|
|
INTEGER :: I, J, L, N
|
|
REAL*8 :: OLD, NEW, DTCHEM, FLUX, AREA_CM2
|
|
|
|
!=================================================================
|
|
! DRY_DEPOSITION begins here!
|
|
!=================================================================
|
|
|
|
! DTCHEM is the chemistry timestep in seconds
|
|
DTCHEM = GET_TS_CHEM() * 60d0
|
|
|
|
! Loop over dust bins
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, N, OLD, NEW, AREA_CM2, FLUX )
|
|
!$OMP+SCHEDULE( DYNAMIC )
|
|
|
|
! Loop over dust bins
|
|
DO N = 1, NDSTBIN
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Surface area [cm2]
|
|
AREA_CM2 = GET_AREA_CM2(J)
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Original dust concentration at surface
|
|
OLD = TC(I,J,1,N)
|
|
|
|
! Dust left after dry deposition
|
|
NEW = OLD * EXP( -DEPSAV(I,J,IDDEP(N)) * DTCHEM )
|
|
|
|
!========================================================
|
|
! ND44 diagnostic: dust drydep loss [#/cm2/s]
|
|
!========================================================
|
|
IF ( ND44 > 0 ) THEN
|
|
|
|
! Convert drydep flux from [kg/s] to [#/cm2/s]
|
|
FLUX = ( OLD - NEW ) / DTCHEM
|
|
FLUX = FLUX * XNUMOL(IDTDST1) / AREA_CM2
|
|
|
|
! Store in AD44
|
|
AD44(I,J,IDDEP(N),1) = AD44(I,J,IDDEP(N),1) + FLUX
|
|
ENDIF
|
|
|
|
! Save back into STT
|
|
TC(I,J,1,N) = NEW
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE DRY_DEPOSITION
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE EMISSDUST
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine EMISSDUST is the driver routine for the dust emission
|
|
! module. You may call either the GINOUX or the DEAD dust source
|
|
! function. (tdf, bmy, 3/30/04, 10/3/05)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now reference LDEAD, LDUST, LPRT from "logical_mod.f". Now reference!
|
|
! STT from "tracer_mod.f" (bmy, 7/20/04)
|
|
! (2 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
!******************************************************************************
|
|
!
|
|
! References to F(0 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP, DEBUG_MSG
|
|
USE LOGICAL_MOD, ONLY : LDEAD, LDUST, LPRT
|
|
USE TRACER_MOD, ONLY : STT
|
|
USE TRACERID_MOD, ONLY : IDTDST1, IDTDST2, IDTDST3, IDTDST4
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
|
|
!=================================================================
|
|
! EMISSDUST begins here!
|
|
!=================================================================
|
|
|
|
! Execute on first-call only
|
|
IF ( FIRST ) THEN
|
|
|
|
! Return if dust ID flags are not defined
|
|
IF ( IDTDST1 + IDTDST2 + IDTDST3 + IDTDST4 == 0 ) THEN
|
|
IF ( LDUST ) THEN
|
|
CALL ERROR_STOP(
|
|
& 'LDUST=T but dust tracers are undefined!',
|
|
& 'EMISSDUST ("dust_mod.f")' )
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! Allocate module arrays
|
|
CALL INIT_DUST
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSDUST: a INIT_DUST' )
|
|
|
|
! Reset first-time flag
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Call appropriate emissions routine
|
|
!=================================================================
|
|
IF ( LDEAD ) THEN
|
|
|
|
! Use Zender's DEAD dust source function
|
|
CALL SRC_DUST_DEAD( STT(:,:,:,IDTDST1:IDTDST4) )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSDUST: a SRC_DUST_DEAD' )
|
|
|
|
ELSE
|
|
|
|
! Use Paul Ginoux's dust source function
|
|
CALL SRC_DUST_GINOUX( STT(:,:,:,IDTDST1:IDTDST4) )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### EMISSDUST: a SRC_DUST_GINOUX')
|
|
|
|
ENDIF
|
|
! Return to calling program
|
|
END SUBROUTINE EMISSDUST
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE SRC_DUST_DEAD( TC )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine SRC_DUST_DEAD is the DEAD model dust emission scheme,
|
|
! alternative to Ginoux scheme. Increments the TC array with emissions
|
|
! from the DEAD model. (tdf, bmy, 4/8/04, 1/23/07)
|
|
!
|
|
! Input:
|
|
! SRCE_FUNK Source function (-)
|
|
! for 1: Sand, 2: Silt, 3: Clay
|
|
! DUSTDEN Dust density (kg/m3)
|
|
! DUSTREFF Effective radius (um)
|
|
! AD Air mass for each grid box (kg)
|
|
! NTDT Time step (s)
|
|
! W10M Velocity at the anemometer level (10meters) (m/s)
|
|
! GWET Surface wetness (-)
|
|
!
|
|
! Parameters used in GEOS-CHEM
|
|
!
|
|
! Longitude: IIPAR
|
|
! Latitude : JJPAR
|
|
! Levels : LLPAR = 20 (GEOS-1), 26 (GEOS-strat), 30 (GEOS-terra)
|
|
! Size bins: NDSTBIN = 4
|
|
!
|
|
! Dust properties used in GOCART
|
|
!
|
|
! Size classes: 01-1, 1-1.8, 1.8-3, 3-6 (um)
|
|
! Radius: 0.7, 1.5, 2.5, 4 (um)
|
|
! Density: 2500, 2650, 2650, 2650 (kg/m3)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Added OpenMP parallelization, added comments (bmy, 4/8/04)
|
|
! (2 ) Bug fix: DSRC needs to be held PRIVATE (bmy, 4/14/04)
|
|
! (3 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
|
|
! (4 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (5 ) Bug fix: It should be SNOW/1d3 not SNOW*1d3 (tdf, bmy, 11/18/05)
|
|
! (6 ) Updated output statement (bmy, 1/23/07)
|
|
! (7 ) Use SNOMAS (m H2O) for GEOS-5 (bmy, 1/24/07)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DAO_MOD, ONLY : BXHEIGHT, GWETTOP, LWI
|
|
USE DAO_MOD, ONLY : SNOW, SPHU, T
|
|
USE DAO_MOD, ONLY : TS, UWND, VWND
|
|
USE DAO_MOD, ONLY : SNOMAS
|
|
USE DUST_DEAD_MOD, ONLY : GET_TIME_INVARIANT_DATA, GET_ORO
|
|
USE DUST_DEAD_MOD, ONLY : GET_MONTHLY_DATA, DST_MBL
|
|
USE DIAG_MOD, ONLY : AD06
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE FILE_MOD, ONLY : IOERROR
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
USE GRID_MOD, ONLY : GET_YMID_R
|
|
USE PRESSURE_MOD, ONLY : GET_PEDGE, GET_PCENTER
|
|
USE TIME_MOD, ONLY : GET_TS_EMIS, GET_MONTH
|
|
USE TIME_MOD, ONLY : GET_DAY_OF_YEAR, ITS_A_NEW_MONTH
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_2D
|
|
|
|
! adj_group: add for emissions scale factors (xxu, 11/02/10, adj32_011)
|
|
USE ADJ_ARRAYS_MOD, ONLY : EMS_SF
|
|
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EDST1, IDADJ_EDST2
|
|
USE ADJ_ARRAYS_MOD, ONLY : IDADJ_EDST3, IDADJ_EDST4
|
|
USE ADJ_ARRAYS_MOD, ONLY : IS_DUST_EMS_ADJ
|
|
USE LOGICAL_ADJ_MOD, ONLY : LADJ_EMS
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND06
|
|
# include "CMN_GCTM" ! g0
|
|
|
|
!----------------
|
|
! Arguments
|
|
!----------------
|
|
REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR,NDSTBIN)
|
|
|
|
!-----------------
|
|
! Local variables
|
|
!-----------------
|
|
|
|
! Scalars
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: I, J, L, N
|
|
INTEGER :: M, IOS, INC, LAT_IDX
|
|
INTEGER :: NDB, NSTEP
|
|
INTEGER :: MM
|
|
REAL*8 :: W10M, DEN, DIAM, U_TS0
|
|
REAL*8 :: U_TS, SRCE_P, Reynol, YMID_R
|
|
REAL*8 :: ALPHA, BETA, GAMMA, CW
|
|
REAL*8 :: DTSRCE, XTAU, P1, P2
|
|
REAL*8 :: DOY
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! Arrays
|
|
INTEGER :: OROGRAPHY(IIPAR,JJPAR)
|
|
REAL*8 :: PSLON(IIPAR) ! surface pressure
|
|
REAL*8 :: PTHICK(IIPAR) ! delta P (L=1)
|
|
REAL*8 :: PMID(IIPAR) ! mid layer P (L=1)
|
|
REAL*8 :: TLON(IIPAR) ! temperature (L=1)
|
|
REAL*8 :: THLON(IIPAR) ! pot. temp. (L=1)
|
|
REAL*8 :: ULON(IIPAR) ! U-wind (L=1)
|
|
REAL*8 :: VLON(IIPAR) ! V-wind (L=1)
|
|
REAL*8 :: BHT2(IIPAR) ! half box height (L=1)
|
|
REAL*8 :: Q_H2O(IIPAR) ! specific humidity (L=1)
|
|
REAL*8 :: ORO(IIPAR) ! "orography"
|
|
REAL*8 :: SNW_HGT_LQD(IIPAR) ! equivalent snow ht.
|
|
REAL*8 :: DSRC(IIPAR,NDSTBIN) ! dust mixing ratio incr.
|
|
|
|
!----------------
|
|
! Parameters
|
|
!----------------
|
|
REAL*8, PARAMETER :: Ch_dust = 9.375d-10
|
|
REAL*8, PARAMETER :: G = g0 * 1.D2
|
|
REAL*8, PARAMETER :: RHOA = 1.25D-3
|
|
REAL*8, PARAMETER :: CP = 1004.16d0
|
|
REAL*8, PARAMETER :: RGAS = 8314.3d0 / 28.97d0
|
|
REAL*8, PARAMETER :: AKAP = RGAS / CP
|
|
REAL*8, PARAMETER :: P1000 = 1000d0
|
|
|
|
! External functions
|
|
REAL*8, EXTERNAL :: SFCWINDSQR
|
|
|
|
!=================================================================
|
|
! SRC_DUST_DEAD begins here!
|
|
!=================================================================
|
|
|
|
! DTSRCE is the emission timestep in seconds
|
|
DTSRCE = GET_TS_EMIS() * 60d0
|
|
|
|
! DOY is the day of year (0-365 or 0-366)
|
|
DOY = DBLE( GET_DAY_OF_YEAR() )
|
|
|
|
!=================================================================
|
|
! Read data fields for the DEAD model from disk
|
|
!=================================================================
|
|
IF ( FIRST ) THEN
|
|
|
|
! Echo info
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, 100 )
|
|
WRITE( 6, 110 )
|
|
WRITE( 6, 120 )
|
|
WRITE( 6, 130 )
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
! FORMAT strings
|
|
100 FORMAT( 'D E A D D U S T M O B I L I Z A T I O N' )
|
|
110 FORMAT( 'Routines from DEAD model by Charlie Zender et al' )
|
|
120 FORMAT( 'Modified for GEOS-CHEM by D. Fairlie and R. Yantosca')
|
|
130 FORMAT( 'Last Modification Date: 1/23/07' )
|
|
|
|
! Read fields for DEAD that are time-invariant
|
|
CALL GET_TIME_INVARIANT_DATA
|
|
|
|
! Reset first-time flag
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
! Read monthly data for DEAD
|
|
IF ( ITS_A_NEW_MONTH() ) THEN
|
|
CALL GET_MONTHLY_DATA
|
|
ENDIF
|
|
|
|
! Determine group (temporal) (xxu, dkh, 01/13/12, adj32_011)
|
|
MM = GET_SCALE_GROUP()
|
|
! Print out scaling info
|
|
WRITE(6,*) '- READ / RESCALE DUST EMISSIONS: use SCALE_GROUP ', MM
|
|
|
|
!=================================================================
|
|
! Call dust mobilization scheme
|
|
!=================================================================
|
|
|
|
! Make OROGRAPHY array from GEOS-CHEM LWI
|
|
CALL GET_ORO( OROGRAPHY )
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, P1, P2, PTHICK, PMID, TLON )
|
|
!$OMP+PRIVATE( THLON, ULON, VLON, BHT2, Q_H2O, ORO, SNW_HGT_LQD )
|
|
!$OMP+PRIVATE( N, YMID_R, DSRC )
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Pressure [hPa] at bottom and top edge of level 1
|
|
P1 = GET_PEDGE(I,J,1)
|
|
P2 = GET_PEDGE(I,J,2)
|
|
|
|
! Pressure thickness of 1st layer [Pa]
|
|
PTHICK(I) = ( P1 - P2 ) * 100d0
|
|
|
|
! Pressure at midpt of surface layer [Pa]
|
|
PMID(I) = GET_PCENTER(I,J,1) * 100d0
|
|
|
|
! Temperature [K] at surface layer
|
|
TLON(I) = T(I,J,1)
|
|
|
|
! Potential temperature [K] at surface layer
|
|
THLON(I) = TLON(I) * ( P1000 / PMID(I) )**AKAP
|
|
|
|
! U and V winds at surface [m/s]
|
|
ULON(I) = UWND(I,J,1)
|
|
VLON(I) = VWND(I,J,1)
|
|
|
|
! Half box height at surface [m]
|
|
BHT2(I) = BXHEIGHT(I,J,1) / 2.d0
|
|
|
|
! Specific humidity at surface [kg H2O/kg air]
|
|
Q_H2O(I) = SPHU(I,J,1) / 1000.d0
|
|
|
|
! Orography at surface
|
|
! Ocean is 0; land is 1; ice is 2
|
|
ORO(I) = OROGRAPHY(I,J)
|
|
|
|
! Snow height [m H2O]
|
|
#if defined( GEOS_5 ) || defined(GEOS_FP )
|
|
SNW_HGT_LQD(I) = SNOMAS(I,J)
|
|
#else
|
|
SNW_HGT_LQD(I) = SNOW(I,J) / 1000d0
|
|
#endif
|
|
! Dust tracer and increments
|
|
DO N = 1, NDSTBIN
|
|
DSRC(I,N) = 0.0d0
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! Call dust mobilization driver (DST_MBL) for latitude J
|
|
!==============================================================
|
|
|
|
! Latitude in RADIANS
|
|
YMID_R = GET_YMID_R(J)
|
|
|
|
! Call DEAD dust mobilization
|
|
CALL DST_MBL( DOY, BHT2, J, YMID_R, ORO,
|
|
& PTHICK, PMID, Q_H2O, DSRC, SNW_HGT_LQD,
|
|
& DTSRCE, TLON, THLON, VLON, ULON,
|
|
& FIRST, J )
|
|
|
|
! Update
|
|
DO N = 1, NDSTBIN
|
|
DO I = 1, IIPAR
|
|
|
|
! Include dust adjoint scale factor (xxu, 11/02/10, adj32_011)
|
|
IF ( LADJ_EMS .and. IS_DUST_EMS_ADJ) THEN
|
|
|
|
IF(N==1) DSRC(I,N) = DSRC(I,N)*EMS_SF(I,J,MM,IDADJ_EDST1)
|
|
IF(N==2) DSRC(I,N) = DSRC(I,N)*EMS_SF(I,J,MM,IDADJ_EDST2)
|
|
IF(N==3) DSRC(I,N) = DSRC(I,N)*EMS_SF(I,J,MM,IDADJ_EDST3)
|
|
IF(N==4) DSRC(I,N) = DSRC(I,N)*EMS_SF(I,J,MM,IDADJ_EDST4)
|
|
|
|
ENDIF
|
|
|
|
! Add dust emissions into tracer array [kg]
|
|
TC(I,J,1,N) = TC(I,J,1,N) + DSRC(I,N)
|
|
|
|
! ND19 diagnostics [kg]
|
|
IF ( ND06 > 0 ) THEN
|
|
AD06(I,J,N) = AD06(I,J,N) + DSRC(I,N)
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE SRC_DUST_DEAD
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE SRC_DUST_GINOUX( TC )
|
|
!
|
|
!******************************************************************************
|
|
! Paul GINOUX dust source function
|
|
! (Added to GEOS-CHEM, tdf, bmy, 4/8/04, 7/20/04)
|
|
!
|
|
! This subroutine updates the surface mixing ratio of dust aerosols for
|
|
! NDSTBIN size bins. The uplifting of dust depends in space on the source
|
|
! function, and in time and space on the soil moisture and surface
|
|
! wind speed (10 meters). Dust is uplifted if the wind speed is greater
|
|
! than a threshold velocity which is calculated with the formula of
|
|
! Marticorena et al. (JGR, v.102, p 23277-23287, 1997).
|
|
! To run this subroutine you need the source function which can be
|
|
! obtained by contacting Paul Ginoux at ginoux@rondo.gsfc.nasa.gov
|
|
! If you are not using GEOS DAS met fields, you will most likely need
|
|
! to adapt the adjusting parameter.
|
|
!
|
|
! Contact: Paul Ginoux (ginoux@rondo.gsfc.nasa.gov)
|
|
!
|
|
!
|
|
! Input:
|
|
! SRCE_FUNK Source function (-)
|
|
! for 1: Sand, 2: Silt, 3: Clay
|
|
!
|
|
! DUSTDEN Dust density (kg/m3)
|
|
! DUSTREFF Effective radius (um)
|
|
! AD Air mass for each grid box (kg)
|
|
! NTDT Time step (s)
|
|
! W10m Velocity at the anemometer level (10meters) (m/s)
|
|
! GWET Surface wetness (-)
|
|
!
|
|
!
|
|
! Parameters used in GEOS-CHEM
|
|
!
|
|
! Longitude: IIPAR
|
|
! Latitude : JJPAR
|
|
! Levels : LLPAR = 20 (GEOS-1), 26 (GEOS-strat), 30 (GEOS-terra)
|
|
! Size bins: NDSTBIN = 4
|
|
!
|
|
! Dust properties used in GOCART
|
|
!
|
|
! Size classes: 01-1, 1-1.8, 1.8-3, 3-6 (um)
|
|
! Radius: 0.7, 1.5, 2.5, 4 (um)
|
|
! Density: 2500, 2650, 2650, 2650 (kg/m3)
|
|
!
|
|
! References:
|
|
! ============================================================================
|
|
! (1 ) Ginoux, P., M. Chin, I. Tegen, J. Prospero, B. Hoben, O. Dubovik,
|
|
! and S.-J. Lin, "Sources and distributions of dust aerosols simulated
|
|
! with the GOCART model", J. Geophys. Res., 2001
|
|
! (2 ) Chin, M., P. Ginoux, S. Kinne, B. Holben, B. Duncan, R. Martin,
|
|
! J. Logan, A. Higurashi, and T. Nakajima, "Tropospheric aerosol
|
|
! optical thickness from the GOCART model and comparisons with
|
|
! satellite and sunphotometers measurements", J. Atmos Sci., 2001.
|
|
!
|
|
! NOTES:
|
|
! (1 ) Added OpenMP parallelization (bmy, 4/8/04)
|
|
! (2 ) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE DAO_MOD, ONLY : GWETTOP
|
|
USE DIAG_MOD, ONLY : AD06
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE FILE_MOD, ONLY : IOERROR
|
|
USE TIME_MOD, ONLY : GET_TS_EMIS
|
|
USE GRID_MOD, ONLY : GET_AREA_M2
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND19, LD13 (for now)
|
|
# include "CMN_GCTM" ! g0
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR,NDSTBIN)
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: I, J, N, M, IOS
|
|
INTEGER :: IPOINT(NDSTBIN) = (/3, 2, 2, 2/)
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,3)
|
|
REAL*8, SAVE :: SRCE_FUNC(IIPAR,JJPAR,3)
|
|
REAL*8 :: W10M, DEN, DIAM, U_TS0, U_TS
|
|
REAL*8 :: SRCE_P, DSRC, REYNOL, ALPHA, BETA
|
|
REAL*8 :: GAMMA, CW, DTSRCE, AREA_M2
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! Transfer coeff for type natural source (kg*s2/m5)
|
|
REAL*8, PARAMETER :: CH_DUST = 9.375d-10
|
|
REAL*8, PARAMETER :: G = G0 * 1.d2
|
|
REAL*8, PARAMETER :: RHOA = 1.25d-3
|
|
|
|
! External functions
|
|
REAL*8, EXTERNAL :: SFCWINDSQR
|
|
|
|
!=================================================================
|
|
! SRC_DUST_GINOUX begins here!
|
|
!=================================================================
|
|
|
|
! Emission timestep [s]
|
|
DTSRCE = GET_TS_EMIS() * 60d0
|
|
|
|
!=================================================================
|
|
! Read dust source function
|
|
!=================================================================
|
|
IF ( FIRST ) THEN
|
|
|
|
! Echo info
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, 100 )
|
|
WRITE( 6, 110 )
|
|
WRITE( 6, 120 )
|
|
WRITE( 6, 130 )
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
! FORMAT strings
|
|
100 FORMAT( 'G I N O U X D U S T M O B I L I Z A T I O N' )
|
|
110 FORMAT( 'Routines originally by Paul Ginoux, GSFC' )
|
|
120 FORMAT( 'Modified for GEOS-CHEM by D. Fairlie and R. Yantosca')
|
|
130 FORMAT( 'Last Modification Date: 4/6/04' )
|
|
|
|
! Filename
|
|
FILENAME = TRIM( DATA_DIR ) //
|
|
& 'dust_200203/NSP.dust.' // GET_RES_EXT()
|
|
|
|
! Open file
|
|
OPEN( 65, FILE=FILENAME, STATUS='OLD',
|
|
& FORM= 'UNFORMATTED', IOSTAT=IOS )
|
|
IF ( IOS > 0 ) CALL IOERROR( IOS, 65, 'SRC_DUST_GINOUX:1' )
|
|
|
|
! Read data
|
|
READ( 65, IOSTAT=IOS ) ARRAY
|
|
IF ( IOS > 0 ) CALL IOERROR( IOS, 65, 'SRC_DUST_GINOUX:2' )
|
|
|
|
! Close file
|
|
CLOSE( 65 )
|
|
|
|
! Cast to REAL*8
|
|
SRCE_FUNC = ARRAY
|
|
|
|
! Reset first-time flag
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, M, N, DEN, DIAM )
|
|
!$OMP+PRIVATE( REYNOL, ALPHA, BETA, GAMMA, U_TS0, AREA_M2 )
|
|
!$OMP+PRIVATE( CW, U_TS, W10M, SRCE_P, DSRC )
|
|
|
|
! Loop over size bins
|
|
DO N = 1, NDSTBIN
|
|
|
|
!==============================================================
|
|
! Threshold velocity as a function of the dust density and the
|
|
! diameter from Bagnold (1941), valid for particles larger
|
|
! than 10 um.
|
|
!
|
|
! u_ts0 = 6.5*sqrt(dustden(n)*g0*2.*dustreff(n))
|
|
!
|
|
! Threshold velocity from Marticorena and Bergametti
|
|
! Convert units to fit dimensional parameters
|
|
!==============================================================
|
|
DEN = DUSTDEN(N) * 1.d-3 ! [g/cm3]
|
|
DIAM = 2d0 * DUSTREFF(N) * 1.d2 ! [cm in diameter]
|
|
REYNOL = 1331.d0 * DIAM**(1.56d0) + 0.38d0 ! [Reynolds number]
|
|
ALPHA = DEN * G * DIAM / RHOA
|
|
BETA = 1d0 + ( 6.d-3 / ( DEN * G * DIAM**(2.5d0) ) )
|
|
GAMMA = ( 1.928d0 * REYNOL**(0.092d0) ) - 1.d0
|
|
|
|
!==============================================================
|
|
! I think the 129.d-5 is to put U_TS in m/sec instead of cm/sec
|
|
! This is a threshold friction velocity! from M&B
|
|
! i.e. Ginoux uses the Gillette and Passi formulation
|
|
! but has substituted Bagnold's Ut with M&B's U*t.
|
|
! This appears to be a problem. (tdf, 4/2/04)
|
|
!==============================================================
|
|
|
|
! [m/s]
|
|
U_TS0 = 129.d-5 * SQRT( ALPHA ) * SQRT( BETA ) / SQRT( GAMMA )
|
|
M = IPOINT(N)
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Get grid box surface area [m2]
|
|
AREA_M2 = GET_AREA_M2(J)
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Fraction of emerged surfaces
|
|
! (subtract lakes, coastal ocean,...)
|
|
CW = 1.d0
|
|
|
|
! Case of surface dry enough to erode
|
|
IF ( GWETTOP(I,J) < 0.2d0 ) THEN
|
|
|
|
U_TS = U_TS0*( 1.2d0 +
|
|
& 0.2d0*LOG10( MAX(1.d-3,GWETTOP(I,J))))
|
|
U_TS = MAX( 0.d0, U_TS )
|
|
|
|
ELSE
|
|
|
|
! Case of wet surface, no erosion
|
|
U_TS = 100.d0
|
|
|
|
ENDIF
|
|
|
|
! 10m wind speed [m/s]
|
|
W10M = SQRT( SFCWINDSQR(I,J) )
|
|
|
|
! Units are m2
|
|
SRCE_P = FRAC_S(N) * SRCE_FUNC(I,J,M) * AREA_M2
|
|
|
|
! Dust source increment [kg]
|
|
DSRC = CW * CH_DUST * SRCE_P * W10M**2
|
|
& * ( W10M - U_TS ) * DTSRCE
|
|
|
|
! Not less than zero
|
|
IF ( DSRC < 0.d0 ) DSRC = 0.d0
|
|
|
|
! Dust SOURCE at first model level [kg].
|
|
TC(I,J,1,N) = TC(I,J,1,N) + DSRC
|
|
|
|
!========================================================
|
|
! ND06 diagnostics: dust emissions [kg/timestep]
|
|
!========================================================
|
|
IF ( ND06 > 0 ) THEN
|
|
AD06(I,J,N) = AD06(I,J,N) + DSRC
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE SRC_DUST_GINOUX
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE RDUST_ONLINE( DUST )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine RDUST reads global mineral dust concentrations as determined
|
|
! by P. Ginoux. Calculates dust optical depth at each level for the
|
|
! FAST-J routine "set_prof.f". (rvm, rjp, tdf, bmy, 4/1/04, 7/20/04)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) DUST (REAL*8) : Dust from soils [kg/m3]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Bundled into "dust_mod.f" (bmy, 4/1/04)
|
|
! (2 ) Now references DATA_DIR from "directory_mod.f". Now parallelize over
|
|
! the L-dimension for ND21 diagnostics. (bmy, 7/20/04)
|
|
! (3 ) Archive only hydrophilic aerosol/aqueous dust surface area
|
|
! (excluding BCPO and OCPO), WTAREA and WERADIUS. (tmf, 3/6/09)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE COMODE_MOD, ONLY : ERADIUS, IXSAVE, IYSAVE
|
|
USE COMODE_MOD, ONLY : IZSAVE, JLOP, TAREA
|
|
USE DAO_MOD, ONLY : BXHEIGHT
|
|
USE DIAG_MOD, ONLY : AD21
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_3D
|
|
USE COMODE_MOD, ONLY : WTAREA, WERADIUS
|
|
USE DAO_MOD, ONLY : RH
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "cmn_fj.h" ! LPAR, CMN_SIZE
|
|
# include "jv_cmn.h" ! ODMDUST, QAA, RAA, QAA_AOD (clh)
|
|
# include "CMN_DIAG" ! ND21, LD21
|
|
# include "comode.h" ! NTTLOOP
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(IN) :: DUST(IIPAR,JJPAR,LLPAR,NDUST)
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, JLOOP, L, N
|
|
REAL*8 :: MSDENS(NDUST), XTAU
|
|
! Added to calculate aqueous dust surface area (WTAREA, WERADIUS)
|
|
! (tmf, 3/6/09)
|
|
REAL*8 :: XRH
|
|
REAL*8 :: CRITRH ! Critical RH [%], above which
|
|
! heteorogeneous chem takes place
|
|
|
|
!=================================================================
|
|
! RDUST_ONLINE begins here!
|
|
!=================================================================
|
|
|
|
! Dust density
|
|
MSDENS(1) = 2500.0d0
|
|
MSDENS(2) = 2500.0d0
|
|
MSDENS(3) = 2500.0d0
|
|
MSDENS(4) = 2500.0d0
|
|
MSDENS(5) = 2650.0d0
|
|
MSDENS(6) = 2650.0d0
|
|
MSDENS(7) = 2650.0d0
|
|
|
|
! Critical RH, above which heteorogeneous chem takes place (tmf, 6/14/07)
|
|
CRITRH = 35.0d0 ! [%]
|
|
|
|
!=================================================================
|
|
! Convert concentration [kg/m3] to optical depth [unitless].
|
|
!
|
|
! ODMDUST = ( 0.75 * BXHEIGHT * CONC * QAA ) /
|
|
! ( MSDENS * RAA * 1e-6 )
|
|
! (see Tegen and Lacis, JGR, 1996, 19237-19244, eq. 1)
|
|
!
|
|
! Units ==> DUST [ kg/m3 ]
|
|
! MSDENS [ kg/m3 ]
|
|
! RAA [ um ]
|
|
! BXHEIGHT [ m ]
|
|
! QAA [ unitless ]
|
|
! ODMDUST [ unitless ]
|
|
!
|
|
! NOTES:
|
|
! (1) Do the calculation at QAA(4,:) (i.e. 999 nm).
|
|
!=================================================================
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N )
|
|
DO N = 1, NDUST
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
ODMDUST(I,J,L,N) = 0.75d0 * BXHEIGHT(I,J,L) *
|
|
& DUST(I,J,L,N) * QAA(4,14+N) /
|
|
& ( MSDENS(N) * RAA(4,14+N) * 1.0D-6 )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!==============================================================
|
|
! Calculate Dust Surface Area
|
|
!
|
|
! Units ==> DUST [ kg dust/m^3 air ]
|
|
! MSDENS [ kg dust/m^3 dust ]
|
|
! RAA [ um ]
|
|
! TAREA [ cm^2 dust/cm^3 air ]
|
|
! ERADIUS [ cm ]
|
|
!
|
|
! NOTE: first find volume of dust (cm3 dust/cm3 air), then
|
|
! multiply by 3/radius to convert to surface area in cm2
|
|
!
|
|
! TAREA(:,1:NDUST) and ERADIUS(:,1:NDUST) are for
|
|
! the NDUST FAST-J dust wavelength bins (read into DUST)
|
|
!==============================================================
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, JLOOP, L, N, XRH )
|
|
DO N = 1, NDUST
|
|
DO JLOOP = 1, NTTLOOP
|
|
|
|
! Compute 3-D grid box indices
|
|
I = IXSAVE(JLOOP)
|
|
J = IYSAVE(JLOOP)
|
|
L = IZSAVE(JLOOP)
|
|
|
|
ERADIUS(JLOOP,N) = RAA(4,14+N) * 1.0D-4
|
|
|
|
TAREA(JLOOP,N) = 3.D0 / ERADIUS(JLOOP,N) *
|
|
& DUST(I,J,L,N) / MSDENS(N)
|
|
|
|
! Archive WTAREA and WERADIUS when RH > 35% (tmf, 6/13/07)
|
|
! Get RH
|
|
XRH = RH( I, J, L ) ![%]
|
|
WTAREA(JLOOP, N) = 0.d0
|
|
WERADIUS(JLOOP, N) = 0.d0
|
|
|
|
IF ( XRH >= CRITRH ) THEN
|
|
WTAREA(JLOOP, N) = TAREA(JLOOP, N)
|
|
WERADIUS(JLOOP, N) = ERADIUS(JLOOP, N)
|
|
ENDIF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!=================================================================
|
|
! ND21 Diagnostic:
|
|
!
|
|
! Tracer #1: Cloud optical depths (from "optdepth_mod.f")
|
|
! Tracer #2: Max Overlap Cld Frac (from "optdepth_mod.f")
|
|
! Tracer #3: Random Overlap Cld Frac (from "optdepth_mod.f")
|
|
! Tracer #4: Dust optical depths (total all size bins)
|
|
! Tracer #5: Dust surface areas (from all size bins)
|
|
!==============================================================
|
|
IF ( ND21 > 0 ) THEN
|
|
|
|
DO N = 1, NDUST
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, JLOOP, L )
|
|
DO L = 1, LD21
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
!--------------------------------------
|
|
! ND21 tracer #4: Dust optical depths (clh)
|
|
!--------------------------------------
|
|
AD21(I,J,L,4) = AD21(I,J,L,4) +
|
|
& ( ODMDUST(I,J,L,N) * QAA_AOD(14+N) / QAA(4,14+N) )
|
|
|
|
!--------------------------------------
|
|
! ND21 tracer #21-27: size-resolved dust optical depths
|
|
!--------------------------------------
|
|
AD21(I,J,L,21+(N-1)) = AD21(I,J,L,21+(N-1)) +
|
|
& ( ODMDUST(I,J,L,N) * QAA_AOD(14+N)/QAA(4,14+N) )
|
|
|
|
!--------------------------------------
|
|
! ND21 tracer #5: Dust surface areas
|
|
!--------------------------------------
|
|
IF ( L <= LLTROP ) THEN
|
|
|
|
! Convert 3-D indices to 1-D index
|
|
! JLOP is only defined in the tropopause
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
! Add to AD21
|
|
IF ( JLOOP > 0 ) THEN
|
|
AD21(I,J,L,5) = AD21(I,J,L,5) + TAREA(JLOOP,N)
|
|
ENDIF
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE RDUST_ONLINE
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE RDUST_OFFLINE( THISMONTH, THISYEAR )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine RDUST_OFFLINE reads global mineral dust concentrations as
|
|
! determined by P. Ginoux. Calculates dust optical depth at each level for
|
|
! the FAST-J routine "set_prof.f". (rvm, bmy, 9/30/00, 8/4/06)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) THISMONTH (INTEGER) : Number of the current month (1-12)
|
|
! (2 ) THISYEAR (INTEGER) : 4-digit year number (e.g. 1996, 2001)
|
|
!
|
|
! NOTES:
|
|
! (1 ) RDUST was patterned after rdaerosol.f (rvm, 9/30/00)
|
|
! (2 ) Don't worry about rewinding the binary file...reading from
|
|
! binary files is pretty fast. And it's only done once a month.
|
|
! (3 ) Now references punch file utility routines from F90 module
|
|
! "bpch2_mod.f". Also reference variable DATA_DIR from the
|
|
! header file "CMN_SETUP". (bmy, 9/30/00)
|
|
! (4 ) Now selects proper GEOS-STRAT dust field for 1996 or 1997.
|
|
! Also need to pass THISYEAR thru the arg list. (rvm, bmy, 11/21/00)
|
|
! (5 ) CONC is now declared as REAL*8 (rvm, bmy, 12/15/00)
|
|
! (6 ) Removed obsolete code from 12/15/00 (bmy, 12/21/00)
|
|
! (7 ) CONC(IGLOB,JGLOB,LGLOB,NDUST) is now CONC(IIPAR,JJPAR,LLPAR,NDUST).
|
|
! Now use routine TRANSFER_3D from "transfer_mod.f" to cast from REAL*4
|
|
! to REAL*8 and also to convert from {IJL}GLOB to IIPAR,JJPAR,LLPAR
|
|
! space. Use 3 arguments in call to GET_TAU0. Updated comments.
|
|
! (bmy, 9/26/01)
|
|
! (8 ) Removed obsolete code from 9/01 (bmy, 10/24/01)
|
|
! (9 ) Now reference ERADIUS, IXSAVE, IYSAVE, IZSAVE, TAREA from
|
|
! "comode_mod.f". Compute ERADIUS and TAREA for the NDUST dust
|
|
! size bins from FAST-J. Renamed CONC to DUST to avoid conflicts.
|
|
! Also reference NTTLOOP from "comode.h". Also added parallel
|
|
! DO-loops. Also renamed MONTH and YEAR to THISMONTH and THISYEAR
|
|
! to avoid conflicts w/ other variables. (bmy, 11/15/01)
|
|
! (10) Bug fix: Make sure to use 1996 dust data for Dec 1995 for the
|
|
! GEOS-STRAT met field dataset. Set off CASE statement with an
|
|
! #if defined( GEOS_STRAT ) block. (rvm, bmy, 1/2/02)
|
|
! (11) Eliminate obsolete code from 1/02 (bmy, 2/27/02)
|
|
! (12) Now report dust optical depths in ND21 diagnostic at 400 nm. Now
|
|
! report dust optical depths as one combined diagnostic field instead
|
|
! of 7 separate fields. Now reference JLOP from "comode_mod.f".
|
|
! Now save aerosol surface areas as tracer #5 of the ND21 diagnostic.
|
|
! (rvm, bmy, 2/28/02)
|
|
! (13) Remove declaration for TIME, since that is also defined in the
|
|
! header file "comode.h" (bmy, 3/20/02)
|
|
! (14) Now read mineral dust files directly from the DATA_DIR/dust_200203/
|
|
! subdirectory (bmy, 4/2/02)
|
|
! (15) Now reference BXHEIGHT from "dao_mod.f". Also reference ERROR_STOP
|
|
! from "error_mod.f". (bmy, 10/15/02)
|
|
! (16) Now call READ_BPCH2 with QUIET=TRUE to suppress extra informational
|
|
! output from being printed. Added cosmetic changes. (bmy, 3/14/03)
|
|
! (17) Since December 1997 dust data does not exist, use November 1997 dust
|
|
! data as a proxy. (bnd, bmy, 6/30/03)
|
|
! (18) Bundled into "dust_mod.f" and renamed to RDUST_OFFLINE. (bmy, 4/1/04)
|
|
! (19) Now references DATA_DIR from "directory_mod.f". Now parallelize over
|
|
! the L-dimension for ND21 diagnostic. (bmy, 7/20/04)
|
|
! (20) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (21) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (22) Archive only hydrophilic aerosol/aqueous dust surface area
|
|
! (excluding BCPO and OCPO), WTAREA and WERADIUS. (tmf, 3/6/09)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT, GET_RES_EXT
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE COMODE_MOD, ONLY : ERADIUS, IXSAVE, IYSAVE
|
|
USE COMODE_MOD, ONLY : IZSAVE, JLOP, TAREA
|
|
USE DAO_MOD, ONLY : BXHEIGHT
|
|
USE DIAG_MOD, ONLY : AD21
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_3D
|
|
USE COMODE_MOD, ONLY : WTAREA, WERADIUS
|
|
USE DAO_MOD, ONLY : RH
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "cmn_fj.h" ! LPAR, CMN_SIZE
|
|
# include "jv_cmn.h" ! ODMDUST, QAA, RAA
|
|
# include "CMN_DIAG" ! ND21, LD21
|
|
# include "comode.h" ! NTTLOOP
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: THISMONTH, THISYEAR
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, JLOOP, L, N
|
|
INTEGER, SAVE :: MONTH_LAST = -999
|
|
REAL*4 :: TEMP(IGLOB,JGLOB,LGLOB)
|
|
REAL*8 :: DUST(IIPAR,JJPAR,LLPAR,NDUST)
|
|
REAL*8 :: MSDENS(NDUST), XTAU
|
|
CHARACTER (LEN=255) :: FILENAME
|
|
|
|
! Added to calculate aqueous dust surface area (WTAREA, WERADIUS)
|
|
! (tmf, 3/6/09)
|
|
REAL*8 :: XRH
|
|
REAL*8 :: CRITRH ! Critical RH [%], above which
|
|
! heteorogeneous chem takes place
|
|
|
|
!=================================================================
|
|
! RDUST begins here!
|
|
!
|
|
! Read aerosol data from the binary punch file during the first
|
|
! chemistry timestep and, after that, at the start of each month.
|
|
!=================================================================
|
|
IF ( THISMONTH /= MONTH_LAST ) THEN
|
|
|
|
! Save the current month
|
|
MONTH_LAST = THISMONTH
|
|
|
|
! Get TAU0 value used to index the punch file
|
|
! Use the "generic" year 1985
|
|
XTAU = GET_TAU0( THISMONTH, 1, 1985 )
|
|
|
|
! Select proper dust file name for GEOS-1, GEOS-3, or GEOS-4
|
|
FILENAME = TRIM( DATA_DIR ) // 'dust_200203/dust.' //
|
|
& GET_NAME_EXT() // '.' //
|
|
& GET_RES_EXT()
|
|
|
|
! Echo filename
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - RDUST: Reading ', a )
|
|
|
|
! Read aerosol concentrations [kg/m3] for each
|
|
! dust type from the binary punch file
|
|
DO N = 1, NDUST
|
|
CALL READ_BPCH2( FILENAME, 'MDUST-$', N, XTAU,
|
|
& IGLOB, JGLOB, LGLOB, TEMP,
|
|
& QUIET=.TRUE. )
|
|
|
|
CALL TRANSFER_3D( TEMP, DUST(:,:,:,N) )
|
|
ENDDO
|
|
|
|
!==============================================================
|
|
! Convert concentration [kg/m3] to optical depth [unitless].
|
|
!
|
|
! ODMDUST = ( 0.75 * BXHEIGHT * CONC * QAA ) /
|
|
! ( MSDENS * RAA * 1e-6 )
|
|
! (see Tegen and Lacis, JGR, 1996, 19237-19244, eq. 1)
|
|
!
|
|
! Units ==> DUST [ kg/m3 ]
|
|
! MSDENS [ kg/m3 ]
|
|
! RAA [ um ]
|
|
! BXHEIGHT [ m ]
|
|
! QAA [ unitless ]
|
|
! ODMDUST [ unitless ]
|
|
!
|
|
! NOTES:
|
|
! (1) Do the calculation at QAA(4,:) (i.e. 999 nm).
|
|
!==============================================================
|
|
MSDENS(1) = 2500.0d0
|
|
MSDENS(2) = 2500.0d0
|
|
MSDENS(3) = 2500.0d0
|
|
MSDENS(4) = 2500.0d0
|
|
MSDENS(5) = 2650.0d0
|
|
MSDENS(6) = 2650.0d0
|
|
MSDENS(7) = 2650.0d0
|
|
|
|
! Critical RH, above which heteorogeneous chem takes place (tmf, 6/14/07)
|
|
CRITRH = 35.0d0 ! [%]
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N )
|
|
DO N = 1, NDUST
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
ODMDUST(I,J,L,N) = 0.75d0 * BXHEIGHT(I,J,L) *
|
|
& DUST(I,J,L,N) * QAA(4,14+N) /
|
|
& ( MSDENS(N) * RAA(4,14+N) * 1.0D-6 )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Echo information
|
|
WRITE( 6, 110 )
|
|
110 FORMAT( ' - RDUST: Finished computing optical depths' )
|
|
|
|
!==============================================================
|
|
! Calculate Dust Surface Area
|
|
!
|
|
! Units ==> DUST [ kg dust/m^3 air ]
|
|
! MSDENS [ kg dust/m^3 dust ]
|
|
! RAA [ um ]
|
|
! TAREA [ cm^2 dust/cm^3 air ]
|
|
! ERADIUS [ cm ]
|
|
!
|
|
! NOTE: first find volume of dust (cm3 dust/cm3 air), then
|
|
! multiply by 3/radius to convert to surface area in cm2
|
|
!
|
|
! TAREA(:,1:NDUST) and ERADIUS(:,1:NDUST) are for
|
|
! the NDUST FAST-J dust wavelength bins (read into DUST)
|
|
!==============================================================
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, JLOOP, L, N, XRH )
|
|
DO N = 1, NDUST
|
|
DO JLOOP = 1, NTTLOOP
|
|
|
|
! Compute 3-D grid box indices
|
|
I = IXSAVE(JLOOP)
|
|
J = IYSAVE(JLOOP)
|
|
L = IZSAVE(JLOOP)
|
|
|
|
ERADIUS(JLOOP,N) = RAA(4,14+N) * 1.0D-4
|
|
|
|
TAREA(JLOOP,N) = 3.D0 / ERADIUS(JLOOP,N) *
|
|
& DUST(I,J,L,N) / MSDENS(N)
|
|
|
|
! Archive WTAREA and WERADIUS when RH > 35% (tmf, 6/13/07)
|
|
! Get RH
|
|
XRH = RH( I, J, L ) ![%]
|
|
WTAREA(JLOOP, N) = 0.d0
|
|
WERADIUS(JLOOP, N) = 0.d0
|
|
|
|
IF ( XRH >= CRITRH ) THEN
|
|
WTAREA(JLOOP, N) = TAREA(JLOOP, N)
|
|
WERADIUS(JLOOP, N) = ERADIUS(JLOOP, N)
|
|
ENDIF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!==============================================================
|
|
! ND21 Diagnostic:
|
|
!
|
|
! Tracer #1: Cloud optical depths (from "optdepth_mod.f")
|
|
! Tracer #2: Max Overlap Cld Frac (from "optdepth_mod.f")
|
|
! Tracer #3: Random Overlap Cld Frac (from "optdepth_mod.f")
|
|
! Tracer #4: Dust optical depths (from all size bins)
|
|
! Tracer #5: Dust surface areas (from all size bins)
|
|
!==============================================================
|
|
IF ( ND21 > 0 ) THEN
|
|
DO N = 1, NDUST
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, JLOOP, L )
|
|
DO L = 1, LD21
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
!--------------------------------------
|
|
! ND21 tracer #4: Dust optical depths
|
|
!--------------------------------------
|
|
AD21(I,J,L,4) = AD21(I,J,L,4) +
|
|
& ( ODMDUST(I,J,L,N) * QAA(2,14+N) / QAA(4,14+N) )
|
|
|
|
!--------------------------------------
|
|
! ND21 tracer #5: Dust surface areas
|
|
!--------------------------------------
|
|
IF ( L <= LLTROP ) THEN
|
|
|
|
! Convert 3-D indices to 1-D index
|
|
! JLOP is only defined in the tropopause
|
|
JLOOP = JLOP(I,J,L)
|
|
|
|
! Add to AD21
|
|
IF ( JLOOP > 0 ) THEN
|
|
AD21(I,J,L,5) = AD21(I,J,L,5) + TAREA(JLOOP,N)
|
|
ENDIF
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDDO
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE RDUST_OFFLINE
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION GET_SCALE_GROUP( ) RESULT( CURRENT_GROUP )
|
|
!
|
|
!********************************************************************************
|
|
! Subroutine GET_SCALE_GROUP determines which predifined scaling index corresponds
|
|
! to the current time and location (dkh, 12/02/04)
|
|
!
|
|
! Added to forward model (xxu, dkh, 01/13/12, adj32_011)
|
|
!
|
|
! NOTES
|
|
! (1 ) CURRENT_GROUP is currently only a function of TAU
|
|
! (2 ) Get rid of I,J as argument. (dkh, 03/28/05)
|
|
!
|
|
!********************************************************************************
|
|
|
|
! Reference to f90 modules
|
|
USE TIME_MOD, ONLY : GET_TAU, GET_TAUe, GET_TAUb, GET_MONTH
|
|
USE ADJ_ARRAYS_MOD, ONLY: MMSCL
|
|
|
|
# include "CMN_SIZE" ! Size stuff
|
|
|
|
! Arguments
|
|
INTEGER :: I, J
|
|
|
|
! Local Variables
|
|
REAL*8 :: TOTAL_HR, CURRENT_HR, GROUP_LENGTH
|
|
REAL*8 :: TAU, TAUe, TAUb
|
|
|
|
! Function variable
|
|
INTEGER :: CURRENT_GROUP
|
|
LOGICAL, SAVE :: MONTHLY = .FALSE.
|
|
INTEGER, SAVE :: MONTH_SAVE
|
|
INTEGER, SAVE :: GROUP_SAVE
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
|
|
!============================================================
|
|
! GET_SCALE_GROUP begins here!
|
|
!============================================================
|
|
|
|
! Currently there is no spatial grouping
|
|
|
|
! Determine temporal grouping
|
|
IF ( MMSCL == 1 ) THEN
|
|
CURRENT_GROUP = 1
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( MONTHLY ) THEN
|
|
IF (FIRST) THEN
|
|
MONTH_SAVE = GET_MONTH()
|
|
CURRENT_GROUP = MMSCL
|
|
GROUP_SAVE = MMSCL
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
IF ( MONTH_SAVE /= GET_MONTH() ) THEN
|
|
MONTH_SAVE = GET_MONTH()
|
|
GROUP_SAVE = GROUP_SAVE - 1
|
|
CURRENT_GROUP = GROUP_SAVE
|
|
ELSE
|
|
CURRENT_GROUP = GROUP_SAVE
|
|
ENDIF
|
|
|
|
ELSE
|
|
! Retrieve time parameters
|
|
TAUe = GET_TAUe()
|
|
TAUb = GET_TAUb()
|
|
TAU = GET_TAU()
|
|
TOTAL_HR = TAUe - TAUb
|
|
CURRENT_HR = TAU - TAUb
|
|
|
|
! The last time step always belongs to the last group
|
|
IF ( TAU == TAUe ) THEN
|
|
CURRENT_GROUP = MMSCL
|
|
RETURN
|
|
ELSE
|
|
|
|
! Determine the length of each group
|
|
GROUP_LENGTH = REAL( TOTAL_HR / MMSCL )
|
|
|
|
! Index is the current time divided by the group length, plus one
|
|
CURRENT_GROUP = SNGL( CURRENT_HR / GROUP_LENGTH ) + 1
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
! Return to the calling routine
|
|
END FUNCTION GET_SCALE_GROUP
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE INIT_DUST
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine INIT_DUST allocates all module arrays (bmy, 3/30/04)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now references LDEAD from "logical_mod.f" (bmy, 7/20/04)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE LOGICAL_MOD, ONLY : LDEAD
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: IS_INIT = .FALSE.
|
|
INTEGER :: AS
|
|
|
|
!=================================================================
|
|
! INIT_DUST begins here!
|
|
!=================================================================
|
|
|
|
! Return if we have already allocated arrays
|
|
IF ( IS_INIT ) RETURN
|
|
|
|
! Drydep flags
|
|
ALLOCATE( IDDEP( NDSTBIN ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'IDDEP' )
|
|
IDDEP = 0
|
|
|
|
! Dust radii
|
|
ALLOCATE( DUSTREFF( NDSTBIN ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'DUSTREFF' )
|
|
DUSTREFF(1:NDSTBIN) = (/ 0.73d-6, 1.4d-6, 2.4d-6, 4.5d-6 /)
|
|
|
|
! Dust density
|
|
ALLOCATE( DUSTDEN( NDSTBIN ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'DUSTREFF' )
|
|
DUSTDEN(1:NDSTBIN) = (/ 2500.d0, 2650.d0, 2650.d0, 2650.d0 /)
|
|
|
|
! These only have to be allocated for the Ginoux source function
|
|
IF ( .not. LDEAD ) THEN
|
|
ALLOCATE( FRAC_S( NDSTBIN ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'FRAC_S' )
|
|
FRAC_S(1:NDSTBIN) = (/ 0.095d0, 0.3d0, 0.3d0, 0.3d0 /)
|
|
ENDIF
|
|
|
|
! Reset flag
|
|
IS_INIT = .TRUE.
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE INIT_DUST
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CLEANUP_DUST
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CLEANUP_DUST deallocates all module arrays (bmy, 3/30/04)
|
|
!
|
|
! NOTES:
|
|
!******************************************************************************
|
|
!
|
|
!=================================================================
|
|
! CLEANUP_DUST begins here!
|
|
!=================================================================
|
|
IF ( ALLOCATED( IDDEP ) ) DEALLOCATE( IDDEP )
|
|
IF ( ALLOCATED( FRAC_S ) ) DEALLOCATE( FRAC_S )
|
|
IF ( ALLOCATED( DUSTREFF ) ) DEALLOCATE( DUSTREFF )
|
|
IF ( ALLOCATED( DUSTDEN ) ) DEALLOCATE( DUSTDEN )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CLEANUP_DUST
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
! End of module
|
|
END MODULE DUST_MOD
|