623 lines
25 KiB
Fortran
623 lines
25 KiB
Fortran
! $Id: diag1.f,v 1.1 2009/06/09 21:51:50 daven Exp $
|
|
SUBROUTINE DIAG1
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine DIAG1 accumulates diagnostic quantities every NDIAG minutes
|
|
! (bmy, bey, 6/16/98, 1/28/04)
|
|
!
|
|
! NOTES:
|
|
! (1 ) This subroutine was reconstructed from gmg's version of (10/10/97)
|
|
! (2 ) GISS-specific code has been eliminated (bmy, 3/15/99)
|
|
! (3 ) UWND, VWND, WW no longer needs to be passed (bmy, 4/7/99)
|
|
! (4 ) Use F90 syntax for declarations, etc (bmy, 4/7/99)
|
|
! (5 ) Remove counter KWACC...this is now redundant (bmy, 11/5/99)
|
|
! (6 ) ND31, ND33, ND35, ND67, and ND69 now use dynamically
|
|
! allocatable arrays declared in "diag_mod.f". (bmy, 3/9/00)
|
|
! (7 ) LTOTH is now an allocatable array in "diag_mod.f". (bmy, 3/17/00)
|
|
! (8 ) Add parallel loops over tracer where expedient (bmy, 5/4/00)
|
|
! (9 ) Updated comments and diagnostics list. Also add more parallel
|
|
! loops for ND31 and ND68. (bmy, 6/21/00)
|
|
! (10) Use NTRACE to dimension STT_VV instead of NNPAR (bmy, 10/17/00)
|
|
! (11) Removed obsolete code from 10/17/00 (bmy, 12/21/00)
|
|
! (12) Updated diagnostic list & comments, cosmetic changes (bmy, 6/19/01)
|
|
! (13) Updated diagnostic list & comments (bmy, 9/4/01)
|
|
! (14) Now reference AVGW from "dao_mod.f", and make sure it is allocated
|
|
! before we reference it in the ND68 diagnostic. Also reference PBL,
|
|
! PS, AIRDEN from "dao_mod.f". (bmy, 9/25/01)
|
|
! (15) Removed obsolete code from 9/01 (bmy, 10/23/01)
|
|
! (16) Renamed ND33 to "ATMOSPHERIC COLUMN SUM OF TRACER", since this is
|
|
! a sum over all levels and not just in the troposphere. Also
|
|
! removed more obsolete code from 9/01. Now use P(I,J)+PTOP instead
|
|
! of PS, since that is the way to ensure that we use will be used
|
|
! consistently. Remove reference to PS from "dao_mod.f"(bmy, 4/11/02)
|
|
! (17) Replaced all instances of IM with IIPAR and JM with JJPAR, in order
|
|
! to prevent namespace confusion for the new TPCORE. Also removed
|
|
! obsolete, commented-out code. Also now replaced reference to
|
|
! P(IREF,JREF) with P(I,J). (bmy, 6/25/02)
|
|
! (18) Replaced references to P(I,J) with call to GET_PEDGE(I,J,1) from
|
|
! "pressure_mod.f" Eliminated obsolete commented-out code from
|
|
! 6/02. (dsa, bdf, bmy, 8/20/02)
|
|
! (19) Now reference AD, and BXHEIGHT from "dao_mod.f". Removed obsolete
|
|
! code. Now refEerence IDTOX from "tracerid_mod.f". (bmy, 11/6/02)
|
|
! (20) Now replace DXYP(J) with routine GET_AREA_M2 from "grid_mod.f"
|
|
! (bmy, 2/4/03)
|
|
! (21) Now compute PBL top for ND67 for GEOS-4/fvDAS. Also now include
|
|
! SCALE_HEIGHT from header file "CMN_GCTM". (bmy, 6/23/03)
|
|
! (22) Now references N_TRACERS, STT, and ITS_A_FULLCHEM_SIM from
|
|
! "tracer_mod.f" (bmy, 7/20/04)
|
|
! (23) Fixed ND67 PS-PBL for GCAP and GEOS-5 met fields (swu, bmy, 6/9/05)
|
|
! (24) Now archive ND30 diagnostic for land/water/ice flags (bmy, 8/18/05)
|
|
! (25) Now reference XNUMOL from "tracer_mod.f" (bmy, 10/25/05)
|
|
! (26) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (27) Added count for time in the troposphere - array AD54 (phs, 9/22/06)
|
|
! (28) Now only archive O3 in ND45 and ND47 at chem timsteps (phs, 1/24/07)
|
|
! (29) Bug fix: Update ND30 for both GEOS-3 and otherwise. Also now save
|
|
! 3-D pressure edges in ND31 instead of PS-PTOP. Revert to the !
|
|
! pre-near-land ND30 diagnostic algorithm. (bmy, 1/28/04)
|
|
!******************************************************************************
|
|
! List of GEOS-CHEM Diagnostics (bmy, 10/25/05)
|
|
!
|
|
! FLAG DIM'S QUANTITY UNITS
|
|
! ---- -------- -------- -----
|
|
! ND01 (I,J,L,3) RADON 222 - LEAD 210 - BERYLLIUM 7 SOURCE [kg/s]
|
|
!
|
|
! ND02 (I,J,L,3) RADON 222 - LEAD 210 - BERYLLIUM 7 DECAY [kg/s]
|
|
!
|
|
! ND03 ---- Free Diagnostic
|
|
! ND04 ---- Free Diagnostic
|
|
!
|
|
! ND05 PROD/LOSS for SULFATE CHEMISTRY QUANTITIES
|
|
! (I,J,L) P(SO2) from DMS + OH [kg S]
|
|
! (I,J,L) P(SO2) from DMS + NO3 [kg S]
|
|
! (I,J,L) Total P(SO2) [kg S]
|
|
! (I,J,L) P(MSA) from DMS [kg S]
|
|
! (I,J,L) P(SO4) gas phase [kg S]
|
|
! (I,J,L) P(SO4) aqueous phase [kg S]
|
|
! (I,J,L) Total P(SO4) [kg S]
|
|
! (I,J,L) L(OH) by DMS [kg OH]
|
|
! (I,J,L) L(NO3) by DMS [kg NO3]
|
|
! (I,J,L) L(H2O2) [kg H2O2]
|
|
!
|
|
! ND06 (I,J) DESERT DUST EMISSIONS [kg]
|
|
!
|
|
! ND07 SOURCES OF BLACK CARBON & ORGANIC CARBON
|
|
! (I,J) BLACK CARBON from anthro sources [kg]
|
|
! (I,J) BLACK CARBON from biomass burning [kg]
|
|
! (I,J) BLACK CARBON from biofuels [kg]
|
|
! (I,J,L) Hydrophilic BC from Hydrophobic BC [kg]
|
|
! (I,J) ORGANIC CARBON from anthro sources [kg]
|
|
! (I,J) ORGANIC CARBON from biomass burning [kg]
|
|
! (I,J) ORGANIC CARBON from biofuels [kg]
|
|
! (I,J) ORGANIC CARBON from biogenic sources [kg]
|
|
! (I,J) Hydrophilic OC from Hydrophobic OC [kg]
|
|
!
|
|
! ND08 (I,J) SEA SALT EMISSIONS [kg]
|
|
!
|
|
! ND09 ---- Free Diagnostic
|
|
! ND10 ---- Free Diagnostic
|
|
!
|
|
! ND11 ACETONE SOURCES & SINKS
|
|
! (I,J) Acetone source from MONOTERPENES atoms C/cm2/s
|
|
! (I,J) Acetone source from METHYL BUTENOL atoms C/cm2/s
|
|
! (I,J) Acetone source from DIRECT EMISSION atoms C/cm2/s
|
|
! (I,J) Acetone source from DRY LEAF MATTER atoms C/cm2/s
|
|
! (I,J) Acetone source from GRASSLANDS atoms C/cm2/s
|
|
! (I,J) Acetone source from OCEANS atoms C/cm2/s
|
|
! (I,J) Acetone sink from OCEANS atoms C/cm2/s
|
|
!
|
|
! ND12 (I,J) FRACTION OF BOUNDARY LAYER OCCUPIED BY unitless
|
|
! LEVEL L (for new emissions in "setemis.f")
|
|
!
|
|
! ND13 TROPOSPHERIC SULFUR EMISSIONS
|
|
! (I,J) DMS kg S
|
|
! (I,J,L) Aircraft SO2 ( 1 <= L <= ND13 ) kg S
|
|
! (I,J,L) Anthro SO2 ( 1 <= L <= 2 ) kg S
|
|
! (I,J) Biomass SO2 kg S
|
|
! (I,J,L) Non-eruptive volcano SO2 ( 1 <= L <= ND13 ) kg S
|
|
! (I,J,L) Eruptive volcano SO2 ( 1 <= L <= ND13 ) kg S
|
|
! (I,J,L) Anthro SO4 ( 1 <= L <= 2 ) kg S
|
|
! (I,J) Anthro NH3 kg NH3
|
|
! (I,J) Biomass NH3 kg NH3
|
|
! (I,J) Biofuel NH3 kg NH3
|
|
!
|
|
! ND14 (I,J,L,N) UPWARD MASS FLUX DUE TO WET CONVECTION kg/s
|
|
! ( 1 <= L <= ND14 )
|
|
!
|
|
! ND15 (I,J,L,N) MASS CHANGE DUE TO BOUNDARY-LAYER MIXING kg/s
|
|
! ( 1 <= L <= ND15 )
|
|
!
|
|
! ND16 (I,J,L) AREAL FRACTION OF LARGE-SCALE PRECIP unitless
|
|
! (I,J,L) AREAL FRACTION OF CONVECTIVE PRECIP unitless
|
|
! ( 1 <= L <= ND16 )
|
|
!
|
|
! ND17 (I,J,L,4) RAINOUT FRACTION IN LARGE-SCALE PRECIP unitless
|
|
! (I,J,L,4) RAINOUT FRACTION IN CONVECTIVE PRECIP unitless
|
|
! ( 1 <= L <= ND17 )
|
|
!
|
|
! ND18 (I,J,L,4) WASHOUT FRACTION IN LARGE-SCALE PRECIP unitless
|
|
! (I,J,L,4) WASHOUT FRACTION IN CONVECTIVE PRECIP unitless
|
|
! ( 1 <= L <= ND18 )
|
|
!
|
|
! ND19 ---- Free Diagnostic
|
|
!
|
|
! ND20 (I,J,L,2) SAVE O3 PROD/LOSS RATES TO DISK molec/cm3/s
|
|
! ( 1 <= L <= LLTROP )
|
|
!
|
|
! ND21 (I,J,L,3) CLOUD OPTICAL DEPTHS AND CLOUD FRACTIONS unitless
|
|
! ( 1 <= L <= ND21 )
|
|
!
|
|
! ND22 (I,J,L,6) J-VALUES: NO2, HNO3, H2O2, CH2O, OH, O3 s^-1
|
|
! ( 1 <= L <= ND22 )
|
|
!
|
|
! ND23 ---- METHYL CHLOROFORM (CH3CCl3) LIFETIME years
|
|
!
|
|
! ND24 (I,J,L,N) EASTWARD MASS FLUX BY TRANSPORT kg/s
|
|
! ( 1 <= L <= ND24 )
|
|
!
|
|
! ND25 (I,J,L,N) NORTHWARD MASS FLUX BY TRANSPORT kg/s
|
|
! ( 1 <= L <= ND25 )
|
|
!
|
|
! ND26 (I,J,L,N) UPWARD MASS FLUX BY TRANSPORT kg/s
|
|
! ( 1 <= L <= ND26 )
|
|
!
|
|
! ND27 (I,J,3) STRATOSPHERIC INFLUX of NOX, OX, HNO3 kg/s
|
|
!
|
|
! ND28 (I,J,10) BIOMASS BURNING EMISSIONS: molec/cm2/s
|
|
! NOX, CO, ALK4, ACET, MEK,
|
|
! ALD2, PRPE, C3H8, CH2O, C2H6
|
|
!
|
|
! ND29 TROPOSPHERIC CO EMISSIONS molec/cm2/s
|
|
! (I,J) Anthropogenic
|
|
! (I,J) Biomass
|
|
! (I,J) Biofuel
|
|
! (I,J) CO produced from monoterpenes
|
|
! (I,J) CO produced from methanol
|
|
!
|
|
! ND30 (I,J) PLOT LAND MAP FOR GISS or GEOS models integers
|
|
!
|
|
! ND31 (I,J) SURFACE PRESSURE - PTOP mb
|
|
!
|
|
! ND32 TROPOSPHERIC NOx EMISSIONS
|
|
! (I,J,L) Aircraft ( 1 <= L <= LAIREMS ) molec/cm2/s
|
|
! (I,J,L) Anthropogenic ( 1 <= L <= NOXEXTENT ) molec/cm2/s
|
|
! (I,J) Biomass molec/cm2/s
|
|
! (I,J) Fertilization molec/cm2/s
|
|
! (I,J,L) Lightning ( 1 <= L <= LCONVM ) molec/cm2/s
|
|
! (I,J) Soils molec/cm2/s
|
|
! (I,J) Upper Boundary molec/cm2/s
|
|
!
|
|
! ND33 (I,J,N) ATMOSPHERIC COLUMN SUM OF TRACER kg
|
|
!
|
|
! ND34 (I,J,10) BIOFUEL BURNING EMISSIONS: molec/cm2/s
|
|
! NOx, CO, ALK4, ACET, MEK,
|
|
! ALD2, PRPE, C3H8, CH2O, C2H6
|
|
!
|
|
! ND35 (I,J,N) TRACER AT 500 HPA ( L = 9 ) v/v
|
|
!
|
|
! ND36 (I,J,9) ANTHROPOGENIC EMISSIONS (for NSRCX == 3) molec/cm2/s
|
|
! NOx, CO, ALK4, ACET,
|
|
! MEK, ALD2, PRPE, C3H8, C2H6
|
|
! OR CH3I EMISSIONS (for NSRCX == 2) ng/m2/s
|
|
!
|
|
! ND37 (I,J,L,4) FRACTION OF TRACER SCAVENGED BY CLOUD
|
|
! UPDRAFTS IN MOIST CONVECTION unitless
|
|
! ( 1 <= L <= ND37 )
|
|
!
|
|
! ND38 (I,J,L,N) LOSS OF TRACER IN MOIST CONVECTION kg/s
|
|
! ( 1 <= L <= ND38 )
|
|
!
|
|
! ND39 (I,J,L,N) LOSS OF TRACER IN AEROSOL WET DEPOSITION kg/s
|
|
! ( 1 <= L <= ND39 )
|
|
!
|
|
! ND40 ---- Free diagnostic kg/m2
|
|
!
|
|
! ND41 (I,J) AFTERNOON PBL DEPTH (1200-1600 LT) m
|
|
!
|
|
! ND42 ---- Free Diagnostic
|
|
!
|
|
! ND43 (I,J,L,2) OH CONCENTRATIONS (from SMVGEAR) and molec/cm3/s
|
|
! NO CONCENTRATIONS (from SMVGEAR) v/v
|
|
! ( 1 <= L <= ND43 )
|
|
!
|
|
! ND44 (I,J,M) DRYDEP FLUXES molec/cm2/s
|
|
! (I,J,M) DRYDEP VELOCITIES cm/s
|
|
! ( M = NUMDEP )
|
|
!
|
|
! ND45 (I,J,L,N) TRACER CONCENTRATION, AVERAGED BETWEEN v/v
|
|
! OTH_HR1 and OTH_HR2 (from "input.geos")
|
|
! ( 1 <= L <= ND45 )
|
|
!
|
|
! ND46 (I,J,5) BIOGENIC EMISSIONS of ISOP, PRPE, ACET, molec/cm2/s
|
|
! MONOTERPENES, METHYL BUTENOL
|
|
!
|
|
! ND47 (I,J,L,N) DAILY (24-h) AVERAGE TRACER CONCENTRATIONS v/v
|
|
! ( 1 <= L <= ND47 )
|
|
!
|
|
! ND48 (I,J,L,N) TIME SERIES AT N = NNSTA LOCATIONS
|
|
! FOR MS = 0, store tracer concentrations v/v
|
|
! FOR MS = 1, store the following
|
|
! N = 1, store O3 RURAL molec/cm3
|
|
! N = 2, store OH RURAL molec/cm3
|
|
! N = 3, store NOy RURAL molec/cm3
|
|
! N = 4, store Drydep Vel for NO2 cm/s
|
|
! N = 5, store Drydep Vel for O3 cm/s
|
|
! N = 6, store Drydep Vel for PAN cm/s
|
|
! N = 7, store Drydep Vel for HNO3 cm/s
|
|
! N = 8, store Drydep Vel for H2O2 cm/s
|
|
! N = 9, store NO RURAL molec/cm3
|
|
! (get I,J,L,MS,N from "inptr.ctm")
|
|
!
|
|
! ND49 (I,J,L,N) 3-D INSTANTANEOUS TRACER TIMESERIES v/v
|
|
! SAVED IN BINARY PUNCH FILE FORMAT
|
|
! (get I,J,L,N from "timeseries.dat")
|
|
!
|
|
! ND50 (I,J,L,N) 3-D 24-h AVERAGE TRACER TIMESERIES v/v
|
|
! SAVED IN BINARY PUNCH FILE FORMAT
|
|
! (get I,J,L,N from "timeseries.dat")
|
|
!
|
|
! ND51 (I,J,L,N) 3-D 1-4pm AVERAGE TRACER TIMESERIES v/v
|
|
! SAVED IN BINARY PUNCH FILE FORMAT
|
|
! (get I,J,L,N from "timeseries.dat")
|
|
!
|
|
! ND52 (I,J,L,N) HO2 aerosol uptake coefficient (gamma) unitless
|
|
!
|
|
! ND53 ---- Free Diagnostic
|
|
!
|
|
! ND54 (I,J,L) Time in troposphere (fraction of total time) unitless
|
|
!
|
|
! ND55 TROPOPAUSE DIAGNOSTICS
|
|
! (I,J) Tropopause level number unitless
|
|
! (I,J) Tropopause height km
|
|
! (I,J) Tropopause pressure hPa
|
|
!
|
|
! ND60 ---- Free Diagnostic
|
|
!
|
|
! ND61 ---- Free Diagnostic
|
|
!
|
|
! ND62 (I,J,N) INSTANTANEOUS COLUMN MIXING RATIO v/v
|
|
!
|
|
! ND63 ---- Free Diagnostic
|
|
!
|
|
! ND65 (I,J,L,N) PRODUCTION & LOSS OF SELECTED molec/cm3/s
|
|
! CHEMCIAL SPECIES (see "prodloss.dat")
|
|
!
|
|
! ND66 DAO 3-D FIELDS ( 1 <= L <= ND66 )
|
|
! (I,J,L) UWND : U-winds m/s
|
|
! (I,J,L) VWND : V-winds m/s
|
|
! (I,J,L) TMPU : Temperature K
|
|
! (I,J,L) SPHU : Specific humidity g H20/kg air
|
|
! (I,J,L) CLDMAS : Convective Mass Flux kg/m2/s
|
|
!
|
|
! ND67 DAO SURFACE FIELDS
|
|
! (I,J) HFLUX : sensible heat flux from surface W/m2
|
|
! (I,J) RADSWG : solar radiation @ ground W/m2
|
|
! (I,J) PREACC : total precip. @ ground mm/day
|
|
! (I,J) PRECON : conv. precip. @ ground mm/day
|
|
! (I,J) TS : surface air temperature K
|
|
! (I,J) RADSWT : solar radiation @ atm. top W/m2
|
|
! (I,J) USTAR : friction velocity m/s
|
|
! (I,J) Z0 : surface roughness height m
|
|
! (I,J) PBL : planetary boundary layer depth hPa
|
|
! (I,J) CLDFRC : column cloud fraction 0 - 1
|
|
! (I,J) U10M : U-winds @ 10 meters altitude m/s
|
|
! (I,J) V10M : V-winds @ 10 meters altitude m/s
|
|
! (I,J) PS-PBL : Boundary Layer Top Pressure hPa
|
|
! (I,J) ALBD : Surface Albedo unitless
|
|
! (I,J) PHIS : Geopotential Heights m
|
|
! (I,J) CLTOP : Cloud Top Height levels
|
|
! (I,J) TROPP : Tropopause pressure hPa
|
|
! (I,J) SLP : Sea Level pressure hPa
|
|
! (I,J) TSKIN : Ground / sea surface temperature K
|
|
! (I,J) PARDF : Photosyn active diffuse rad W/m2
|
|
! (I,J) PARDR : Photosyn active direct rad hPa
|
|
! (I,J) GWETTOP : Top soil wetness unitless
|
|
!
|
|
! ND68 GRID BOX QUANTITIES ( 1 <= L <= ND68 )
|
|
! (I,J,L) BXHEIGHT : (grid box heights) m
|
|
! (I,J,L) AD :(air mass in grid box) kg
|
|
! (I,J,L) AVGW : mixing ratio of water vapor v/v
|
|
! (I,J,L) N_AIR : Air number density molec air/m3
|
|
!
|
|
! ND69 (I,J) DXYP : grid box surface areas m2
|
|
!
|
|
! ND70 ---- DEBUG PRINTOUT to stdout file via routine DEBUG_MSG
|
|
!*****************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DAO_MOD, ONLY : AD, AIRDEN, AVGW, BXHEIGHT
|
|
USE DAO_MOD, ONLY : PBL, IS_ICE, IS_WATER, IS_LAND, IS_NEAR
|
|
USE DIAG_MOD, ONLY : AD30, AD31, AD33, AD35, AD45, AD54
|
|
USE DIAG_MOD, ONLY : AD47, AD67, AD68, AD69, LTOTH
|
|
USE GRID_MOD, ONLY : GET_AREA_M2
|
|
USE PRESSURE_MOD, ONLY : GET_PEDGE
|
|
USE TIME_MOD, ONLY : ITS_TIME_FOR_CHEM
|
|
USE TRACER_MOD, ONLY : N_TRACERS, STT, TCVV
|
|
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM
|
|
USE TRACER_MOD, ONLY : XNUMOLAIR
|
|
USE TRACERID_MOD, ONLY : IDTOX
|
|
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_TROP
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! Diagnostic arrays & parameters
|
|
# include "CMN_O3" ! FRACO3
|
|
# include "CMN_GCTM" ! Physical constants
|
|
|
|
! Local variables
|
|
LOGICAL :: AVGW_ALLOCATED, IS_FULLCHEM, IS_CHEM
|
|
INTEGER :: I, J, K, L, N, NN, IREF, JREF, LN45
|
|
REAL*8 :: FDTT, XLOCTM, AREA_M2
|
|
REAL*8 :: STT_VV(IIPAR,JJPAR,LLPAR,N_TRACERS)
|
|
|
|
!=================================================================
|
|
! DIAG1 begins here!
|
|
!=================================================================
|
|
|
|
! Is it a fullchem run?
|
|
IS_FULLCHEM = ITS_A_FULLCHEM_SIM()
|
|
IS_CHEM = ITS_TIME_FOR_CHEM()
|
|
|
|
! Compute conc. in mixing ratio for ND35, ND45, ND47 diagnostics
|
|
IF ( ND35 > 0 .or. ND45 > 0 .or. ND47 > 0 ) THEN
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N )
|
|
DO N = 1, N_TRACERS
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
STT_VV(I,J,L,N) =
|
|
& MAX( STT(I,J,L,N) * TCVV(N) / AD(I,J,L), 0d0 )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND30: Land/water/ice flags
|
|
!=================================================================
|
|
IF ( ND30 > 0 ) THEN
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
IF ( IS_WATER( I, J ) ) AD30(I,J) = AD30(I,J) + 0e0
|
|
IF ( IS_LAND ( I, J ) ) AD30(I,J) = AD30(I,J) + 1e0
|
|
IF ( IS_ICE ( I, J ) ) AD30(I,J) = AD30(I,J) + 2e0
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND31: Surface pressure diagnostic (PS - PTOP) in hPa
|
|
!=================================================================
|
|
IF ( ND31 > 0 ) THEN
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L )
|
|
DO L = 1, LD31
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD31(I,J,L) = AD31(I,J,L) + GET_PEDGE( I, J, L )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND33: Atmospheric column sum of tracer [kg]
|
|
!=================================================================
|
|
IF ( ND33 > 0 ) THEN
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N )
|
|
DO N = 1, N_TRACERS
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD33(I,J,N) = AD33(I,J,N) + STT(I,J,L,N)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND35: 500 HPa fields.
|
|
!
|
|
! NOTES:
|
|
! (1 ) Use level 9 for both GEOS-1 and GEOS-STRAT.
|
|
! They are both close to 500 hPa (bmy, 4/7/99)
|
|
!=================================================================
|
|
IF ( ND35 > 0 ) THEN
|
|
L = 9
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, N )
|
|
DO N = 1, N_TRACERS
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD35(I,J,N) = AD35(I,J,N) + STT_VV(I,J,L,N)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND45: Tracer (V/V) at level 1 to level LD45, averaged over
|
|
! the time period OTH_HR1 to OTH_HR2.
|
|
!
|
|
! Store pure O3 (as opposed to Ox) in the NTRACE+1 location of
|
|
! AD45. FRACO3(I,J,L) is the fraction of Ox that is actually O3,
|
|
! and is calculated in subroutine OHSAVE.
|
|
!
|
|
! NOTES:
|
|
! (1 ) AD45 array replaces the AIJ array for this diagnostic
|
|
! (bmy, 3/22/99)
|
|
! (2 ) Add parallel loop over tracers (bmy, 5/4/00)
|
|
!=================================================================
|
|
IF ( ND45 > 0 ) THEN
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N )
|
|
DO N = 1, N_TRACERS
|
|
DO L = 1, LD45
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD45(I,J,L,N) = AD45(I,J,L,N) +
|
|
& STT_VV(I,J,L,N) * LTOTH(I,J)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! NOTE: Only update on chem timesteps (phs, 1/24/07)
|
|
IF ( N == IDTOX .and. IS_FULLCHEM .and. IS_CHEM ) THEN
|
|
DO L = 1, LD45
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD45(I,J,L,N_TRACERS+1) = AD45(I,J,L,N_TRACERS+1) +
|
|
& ( STT_VV(I,J,L,N) * FRACO3(I,J,L) * LTOTH(I,J) )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND47: Tracer (V/V) at level 1 to level LD45,
|
|
! averaged from 0-24 hours
|
|
!
|
|
! Added parallel loop over tracers (bmy, 5/4/00)
|
|
!=================================================================
|
|
IF ( ND47 > 0 ) THEN
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, N )
|
|
DO N = 1, N_TRACERS
|
|
DO L = 1, LD47
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD47(I,J,L,N) = AD47(I,J,L,N) + STT_VV(I,J,L,N)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! NOTE: Only update on chem timesteps (phs, 1/24/07)
|
|
IF ( N == IDTOX .and. IS_FULLCHEM .and. IS_CHEM ) THEN
|
|
DO L = 1, LD47
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD47(I,J,L,N_TRACERS+1) = AD47(I,J,L,N_TRACERS+1) +
|
|
& ( STT_VV(I,J,L,N) * FRACO3(I,J,L) )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND54: Count time the box was tropospheric
|
|
!=================================================================
|
|
IF ( ND54 > 0 ) THEN
|
|
|
|
DO L = 1, LD54
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
IF ( ITS_IN_THE_TROP(I,J,L) )
|
|
& AD54(I,J,L) = AD54(I,J,L) + 1.
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
|
|
!=================================================================
|
|
! ND67: Store PBL top pressure [hPa]
|
|
!=================================================================
|
|
IF ( ND67 > 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
#if defined( GEOS_3 )
|
|
|
|
! PBL is in [hPa], subtract from PSurface
|
|
AD67(I,J,13) = AD67(I,J,13) + GET_PEDGE(I,J,1) - PBL(I,J)
|
|
|
|
#else
|
|
|
|
! PBL is in [m], use hydrostatic law to get [hPa]
|
|
AD67(I,J,13) = AD67(I,J,13) +
|
|
& ( GET_PEDGE(I,J,1) * EXP( -PBL(I,J) / SCALE_HEIGHT ) )
|
|
|
|
#endif
|
|
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND68: Quantity 1: BXHEIGHT(I,J,L) in meters
|
|
! Quantity 2: AD(I,J,L) in kg
|
|
! Quantity 3: AVGW(I,J,L) in v/v
|
|
! Quantity 4: N_AIR(I,J,L) in molecules air / m3
|
|
!
|
|
! NOTE: AVGW is now an allocatable array from "dao_mod.f"
|
|
!=================================================================
|
|
IF ( ND68 > 0 ) THEN
|
|
|
|
! Set a flag for whether AVGW is allocated or not
|
|
AVGW_ALLOCATED = ALLOCATED( AVGW )
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L )
|
|
DO L = 1, LD68
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
AD68(I,J,L,1) = AD68(I,J,L,1) + BXHEIGHT(I,J,L)
|
|
AD68(I,J,L,2) = AD68(I,J,L,2) + AD(I,J,L)
|
|
AD68(I,J,L,4) = AD68(I,J,L,4) + AIRDEN(L,I,J) * XNUMOLAIR
|
|
|
|
! Make sure AVGW is now allocated (bmy, 9/25/01)
|
|
IF ( AVGW_ALLOCATED ) THEN
|
|
AD68(I,J,L,3) = AD68(I,J,L,3) + AVGW(I,J,L)
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! ND69: Grid box surface areas [m2]
|
|
!
|
|
! NOTE: Only save areas on the first timestep since the
|
|
! grid box surface areas are a time-invariant field.
|
|
!=================================================================
|
|
IF ( ND69 > 0 ) THEN
|
|
DO J = 1, JJPAR
|
|
AREA_M2 = GET_AREA_M2( J )
|
|
|
|
DO I = 1, IIPAR
|
|
AD69(I,J,1) = AREA_M2
|
|
ENDDO
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE DIAG1
|
|
|