799 lines
32 KiB
Fortran
799 lines
32 KiB
Fortran
!$Id: chemdr_adj.f,v 1.9 2012/03/01 22:00:26 daven Exp $
|
|
SUBROUTINE CHEMDR_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CHEMDR_ADJ is the driver subroutine for full chemistry adjoint.
|
|
! Adapted from original code by lwh, jyl, gmg, djj. (bmy, 11/15/01, 6/3/08)
|
|
! Adjoint developed by dkh, ks, 07/30/09
|
|
!
|
|
! Important input variables from "dao_mod.f" and "uvalbedo_mod.f":
|
|
! ============================================================================
|
|
! ALBD : DAO visible albedo [unitless]
|
|
! AVGW : Mixing ratio of water vapor [v/v]
|
|
! BXHEIGHT : Grid box heights [m]
|
|
! OPTD : DAO grid-box optical depths (for FAST-J) [unitless]
|
|
! SUNCOS : Cosine of solar zenith angle [unitless]
|
|
! SUNCOSB : Cosine of solar zenith angle 1 hr from now [unitless]
|
|
! UVALBEDO : TOMS UV albedo 340-380 nm (for FAST-J) [unitless]
|
|
!
|
|
! Important input variables from "comode.h" or "comode_mod.f":
|
|
! ============================================================================
|
|
! NPTS : Number of points (grid-boxes) to calculate
|
|
! REMIS : Emission rates [molec/cm3/s-1]
|
|
! RAERSOL : Frequency of gas-aerosol collisions [s-1]
|
|
! PRESS : Pressure [Pa]
|
|
! TMPK : Temperature [K]
|
|
! ABSHUM : Absolute humidity [molec/cm3]
|
|
! CSPEC : Initial species concentrations [molec/cm3]
|
|
!
|
|
! Important output variables in "comode.h" etc.
|
|
! ============================================================================
|
|
! NAMESPEC : Character array of species names
|
|
! NNSPEC : # of ACTIVE + INACTIVE (not DEAD) species
|
|
! CSPEC : Final species concentrations [molec/cm3]
|
|
!
|
|
! Other Important Variables
|
|
! ============================================================================
|
|
! MAXPTS : Maximum number of points or grid-boxes (in "comsol.h")
|
|
! (NPTS must be <= MAXPTS, for SLOW-J only)
|
|
! MAXDEP : Maximum number of deposition species (note # of
|
|
! depositing species listed in tracer.dat must be <= MAXDEP)
|
|
! IGAS : Maximum number of gases, ACTIVE + INACTIVE
|
|
! IO93 : I/O unit for output for "ctm.chem" file
|
|
!
|
|
! Input files for SMVGEAR II:
|
|
! ============================================================================
|
|
! mglob.dat : control switches (read in "reader.f")
|
|
! tracer.dat : list of tracers, emitting species (read in "reader.f")
|
|
! and depositing species
|
|
! globchem.dat : species list, reaction list, (read in "chemset.f")
|
|
! photolysis reaction list
|
|
!
|
|
! Input files for FAST-J photolysis:
|
|
! ============================================================================
|
|
! ratj.d : Lists photo species, branching ratios (read in "rd_js.f")
|
|
! jv_atms.dat : Climatology of T and O3 (read in "rd_prof.f")
|
|
! jv_spec.dat : Cross-sections for each species (read in "RD_TJPL.f")
|
|
!
|
|
! Input files for SLOW-J photolysis:
|
|
! ============================================================================
|
|
! jvalue.dat : Solar flux data, standard T and O3 (read in "jvaluein.f")
|
|
! profiles, aerosol optical depths
|
|
! 8col.dat : SLOW-J cross-section data (read in "jvaluein.f")
|
|
! chemga.dat : Aerosol data
|
|
! o3du.dat : O3 in Dobson units, cloud data (read in "jvaluein.f")
|
|
!
|
|
! NOTES:
|
|
! (1 ) Cleaned up a lot of stuff. SUNCOS, OPTD, ALBD, and AVGW are now
|
|
! referenced from dao_mod.f. IREF and JREF are obsolete. Also
|
|
! updated comments. (bmy, 9/27/01)
|
|
! (2 ) Do not declare LPRT or set LPRT = .FALSE. in "chemdr.f". LPRT is
|
|
! included via "CMN" and is defined in "main.f". (bmy, 10/9/01)
|
|
! (3 ) Removed obsolete data from 9/01 (bmy, 10/23/01)
|
|
! (4 ) ERADIUS(JLOOP) is now ERADIUS(JLOOP,1) and TAREA(JLOOP) is now
|
|
! TAREA(JLOOP,1) for sulfate aerosol. Updated comments. (bmy, 11/15/01)
|
|
! (5 ) Renamed routine PAFTOP to DEBUG_MSG. Also deleted obsolete code
|
|
! from 11/01. Enhanced debug output via DEBUG_MSG. Also reference
|
|
! the UVALBEDO array directly from "uvalbedo_mod.f". Remove UVALBEDO
|
|
! from the argument list. Removed obsolete comments. (bmy, 1/15/02)
|
|
! (6 ) Now pass LPAUSE to "initgas.f" via the arg list (bmy, 2/14/02)
|
|
! (7 ) Now call "rdaer.f" instead of RDAEROSOL to read the aerosol and dust
|
|
! fields from disk. Also, ignore hygroscopic growth for dust. Now
|
|
! pass SAVEHO2 and FRACNO2 arrays in the arg list to "ohsave.f"; these
|
|
! return HO2 conc.'s and NO2 fraction. Delete NTRACE from call
|
|
! to "ohsave.f", it's obsolete. Delete reference to DARSFCA from
|
|
! "comode_mod.f", it's obsolete. (rvm, bmy, 2/27/02)
|
|
! (8 ) Removed obsolete code from 2/02. (bmy, 4/15/02)
|
|
! (9 ) Replaced all instances of IM with IIPAR and JM with JJPAR, in order
|
|
! to prevent namespace confusion for the new TPCORE (bmy, 6/25/02)
|
|
! (10) Now reference IU_CTMCHEM from "file_mod.f". Assign the value of
|
|
! IU_CTMCHEM (which =93) to IO93 for SMVGEAR routines. Also open
|
|
! "ctm.chem" file on the first call as file unit # IO93. Add
|
|
! references to "CMN_DIAG" and "planeflight_mod.f". Call routine
|
|
! SETUP_PLANEFLIGHT to initialize the plane track diagnostic
|
|
! after reading the "chem.dat" file. (bmy, 7/2/02)
|
|
! (11) Now reference AD, T and BXHEIGHT from "dao_mod.f". Also removed
|
|
! obsolete commented out code in various sections below. Now also
|
|
! references "tracerid_mod.f". Also remove reference to BIOTRCE, since
|
|
! this is now obsolete. Now make FIRSTCHEM a local SAVED variable
|
|
! instead of an argument. Now calls MAKE_AVGW, which was formerly
|
|
! called in "main.f". (bmy, 11/15/02)
|
|
! (12) Now reference "AIRVOL" from "dao_mod.f". Now declare local array
|
|
! SO4_NH4_NIT, which will contain lumped SO4, NH3, NIT aerosol. Now
|
|
! pass SO4_NH4_NIT to "rdaer.f" via the arg list if sulfate chemistry
|
|
! is turned on. Now also references CMN_SETUP. (rjp, bmy, 3/23/03)
|
|
! (13) Removed ITAU from the arg list. Removed reference to IHOUR. Now use
|
|
! functions GET_MONTH, GET_YEAR from "time_mod.f" (bmy, 3/27/03)
|
|
! (14) Remove KYEAR and TWO_PI, these are now obsolete for SMVGEAR II. Now
|
|
! open unit #93 and call READER in the same FIRSTCHEM if-block. Now
|
|
! Replace call to CHEMSET with call to READCHEM. JPARSE is now called
|
|
! from w/in READCHEM. Replace call to INITGAS w/ call to GASCONC.
|
|
! Removed reference to "file_mod.f". Remove call to SETPL, we now must
|
|
! call this in "readchem.f" before the call to JSPARSE.
|
|
! (bdf, ljm, bmy, 5/8/03)
|
|
! (15) Now reference routine GET_GLOBAL_CH4 from "global_ch4_mod.f". Also
|
|
! added CH4_YEAR as a SAVEd variable. (bnd, bmy, 7/1/03)
|
|
! (16) Remove references to MONTHP, IMIN, ISEC; they are obsolete and not
|
|
! defined anywhere. (bmy, 7/16/03)
|
|
! (17) Now reference SUNCOSB from "dao_mod.f". Now pass SUNCOSB to "chem.f".
|
|
! Also remove LSAMERAD from call to CHEM, since it's obsolete.
|
|
! (gcc, bmy, 7/30/03)
|
|
! (18) Added BCPO, BCPI, OCPO, OCPI, and SOILDUST arrays. Now pass SOILDUST
|
|
! to RDUST_ONLINE (in "dust_mod.f"). Now pass PIEC, POEC, PIOC, POOC to
|
|
! "rdaer.f". Now references "dust_mod.f". (rjp, tdf, bmy, 4/1/04)
|
|
! (19) Added SALA and SALC arrays for passing seasalt to rdaer.f. Now
|
|
! rearranged the DO loop for computational efficiency. (bmy, 4/20/04)
|
|
! (20) Added OCF parameter to account for the other chemical components that
|
|
! are attached to OC. Also now handle hydrophilic OC differently for
|
|
! online & offline SOA. (rjp, bmy, 7/15/04)
|
|
! (21) Now reference "logical_mod.f". Now reference STT and N_TRACERS from
|
|
! "tracer_mod.f". Now references DO_DIAG_PL from "diag_pl_mod.f".
|
|
! Now references DO_DIAG_OH from "diag_oh_mod.f". Now references
|
|
! AEROSOL_CONC, RDAER, & SOILDUST from "aerosol_mod.f" (bmy, 7/20/04)
|
|
! (22) Now references ITS_A_NEW_DAY from "time_mod.f". Now calls routine
|
|
! SETUP_PLANEFLIGHT at the start of each new day. (bmy, 3/24/05)
|
|
! (23) FAST-J is now the default, so we don't need the LFASTJ C-preprocessor
|
|
! switch any more (bmy, 6/23/05)
|
|
! (24) Now remove LPAUSE from the arg list to "ruralbox.f" and "gasconc.f".
|
|
! (bmy, 8/22/05)
|
|
! (25) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (26) Now references XNUMOL & XNUMOLAIR from "tracer_mod.f" (bmy, 10/25/05)
|
|
! (27) Remove more obsolete SLOW-J code references. Also now move function
|
|
! calls from subroutine "chem.f" into "chemdr.f". Remove obsolete
|
|
! arguments from call to RURALBOX. (bmy, 4/10/06)
|
|
! (28) Remove reference to "global_ch4_mod.f". Add error check for LISOPOH
|
|
! when using the online SOA tracers. (dkh, bmy, 6/1/06)
|
|
! (29) Now support variable tropopause (bdf, phs, bmy, 10/3/06)
|
|
! (30) Now get CH4 concentrations for FUTURE_YEAR when using the future
|
|
! emissions scale factors (swu, havala, bmy, 1/28/04)
|
|
! (31) Now call "save_full_trop" at the end to account for "do_diag_pl"
|
|
! resetting some of CSPEC elements (phs, 6/3/08)
|
|
! (32) Reading the CSPEC_FULL restart file if asked.(dkh, hotp, ccc 2/26/09)
|
|
! (33) Now use GET_DIRECTION
|
|
! (34) LVARTROP treated correctly (dkh, 01/26/11)
|
|
! (35) Add support for strat chem adj LADJ_STRAT and check to make sure that
|
|
! FD location is in the trop prior to printing debug info for LPRINTFD.
|
|
! (hml, dkh, 02/14/12, adj32_025)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE AEROSOL_MOD, ONLY : AEROSOL_CONC, RDAER, SOILDUST
|
|
USE COMODE_MOD, ONLY : ABSHUM, CSPEC, ERADIUS, TAREA,
|
|
& CSPEC_FOR_KPP, JLOP, R_KPP
|
|
USE DAO_MOD, ONLY : AD, AIRVOL, ALBD, AVGW
|
|
USE DAO_MOD, ONLY : BXHEIGHT, MAKE_AVGW, OPTD, SUNCOS
|
|
USE DAO_MOD, ONLY : SUNCOSB, T
|
|
USE DIAG_OH_MOD, ONLY : DO_DIAG_OH
|
|
USE DIAG_PL_MOD, ONLY : DO_DIAG_PL
|
|
USE DUST_MOD, ONLY : RDUST_ONLINE, RDUST_OFFLINE
|
|
USE ERROR_MOD, ONLY : DEBUG_MSG, ERROR_STOP
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_YEAR
|
|
USE LOGICAL_MOD, ONLY : LCARB, LDUST, LEMBED
|
|
USE LOGICAL_MOD, ONLY : LPRT, LSSALT, LSULF
|
|
USE LOGICAL_MOD, ONLY : LSOA, LVARTROP, LFUTURE
|
|
USE LOGICAL_MOD, ONLY : LEMIS
|
|
USE PLANEFLIGHT_MOD, ONLY : SETUP_PLANEFLIGHT
|
|
USE TIME_MOD, ONLY : GET_MONTH, GET_YEAR
|
|
USE TIME_MOD, ONLY : ITS_A_NEW_DAY
|
|
USE TRACER_MOD, ONLY : STT, N_TRACERS, XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTNOX, IDTOX, SETTRACE
|
|
USE TROPOPAUSE_MOD, ONLY : SAVE_FULL_TROP
|
|
USE UVALBEDO_MOD, ONLY : UVALBEDO
|
|
! To use CSPEC_FULL restart (dkh, 02/12/09
|
|
USE RESTART_MOD, ONLY : READ_CSPEC_FILE
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS, GET_TAU
|
|
USE LOGICAL_MOD, ONLY : LSVCSPEC
|
|
! add for adjoint (dkh, 07/31/09)
|
|
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD
|
|
USE ADJ_ARRAYS_MOD, ONLY : NFD
|
|
USE ADJ_ARRAYS_MOD, ONLY : CHECK_STT_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : ID2C
|
|
USE ADJ_ARRAYS_MOD, ONLY : IDCSPEC_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : NOBS_CSPEC
|
|
USE TIME_MOD, ONLY : GET_DIRECTION
|
|
USE CHECKPT_MOD, ONLY : CHK_STT_BEFCHEM
|
|
USE CHEMISTRY_MOD, ONLY : GCKPP_ADJ_DRIVER
|
|
USE COMODE_MOD, ONLY : CSPEC_FOR_KPP, CSPEC_ADJ
|
|
!USE COMODE_MOD, ONLY : NO2_AFTER_CHEM_ADJ
|
|
!USE COMODE_MOD, ONLY : CSPEC_ADJ_FORCE
|
|
USE COMODE_MOD, ONLY : CSPEC_AFTER_CHEM_ADJ
|
|
USE COMODE_MOD, ONLY : CHK_CSPEC
|
|
USE COMODE_MOD, ONLY : CSPEC_ORIG
|
|
USE DRYDEP_MOD, ONLY : NUMDEP
|
|
USE GCKPP_ADJ_Global, ONLY : NTT
|
|
USE GRID_MOD, ONLY : GET_XMID, GET_YMID
|
|
USE LOGICAL_MOD, ONLY : LSCHEM
|
|
USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD, LFDTEST
|
|
USE LOGICAL_ADJ_MOD, ONLY : LCSPEC_OBS
|
|
USE STRAT_CHEM_ADJ_MOD, ONLY : DO_STRAT_CHEM_ADJ
|
|
|
|
USE TIME_MOD, ONLY : GET_NYMDb, GET_NHMSb
|
|
USE TIME_MOD, ONLY : GET_LOCALTIME
|
|
USE TRACERID_MOD, ONLY : IDTSO2, IDTSO4
|
|
|
|
! dkh debug
|
|
USE TRACERID_MOD, ONLY : IDNO
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN" ! IEBD1, IEBD2, etc.
|
|
# include "CMN_O3" ! EMISRRN, EMISRR
|
|
# include "CMN_NOX" ! SLBASE
|
|
# include "comode.h" ! SMVGEAR variables
|
|
# include "CMN_DEP" ! FRCLND
|
|
# include "CMN_DIAG" ! ND40
|
|
# include "define_adj.h" ! OBS operators
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRSTCHEM = .TRUE.
|
|
INTEGER, SAVE :: CH4_YEAR = -1
|
|
INTEGER :: I, J, JLOOP, L, NPTS, N, MONTH, YEAR
|
|
! Now use GET_DIRECTION (dkh, 01/26/10)
|
|
!INTEGER :: DIRECTION
|
|
|
|
|
|
! To use CSPEC_FULL restart (dkh, 02/12/09)
|
|
LOGICAL :: IT_EXISTS
|
|
|
|
! ADJ_GROUP
|
|
INTEGER :: NYMD, NHMS
|
|
INTEGER :: JLOOPTMP
|
|
INTEGER :: IDCSPEC
|
|
REAL*8 :: TAU
|
|
REAL*8 :: ADJ_SO4_NH4_NIT(IIPAR,JJPAR,LLPAR)
|
|
REAL*8 :: ADJ_BCPI(IIPAR,JJPAR,LLPAR)
|
|
REAL*8 :: ADJ_BCPO(IIPAR,JJPAR,LLPAR)
|
|
REAL*8 :: ADJ_OCPI(IIPAR,JJPAR,LLPAR)
|
|
REAL*8 :: ADJ_OCPO(IIPAR,JJPAR,LLPAR)
|
|
! (dkh, 01/06/12, adj32_006)
|
|
INTEGER :: JJ, NK
|
|
|
|
|
|
!=================================================================
|
|
! CHEMDR_ADJ begins here!
|
|
!=================================================================
|
|
|
|
! Set some size variables
|
|
NLAT = JJPAR
|
|
NLONG = IIPAR
|
|
NVERT = IVERT
|
|
NPVERT = NVERT
|
|
NPVERT = NVERT + IPLUME
|
|
|
|
! Get month and year
|
|
MONTH = GET_MONTH()
|
|
YEAR = GET_YEAR()
|
|
|
|
!=================================================================
|
|
! Compute AVGW, the mixing ratio of water vapor
|
|
!=================================================================
|
|
CALL MAKE_AVGW
|
|
|
|
! All the FIRSTCHEM stuff will have been done during the forward run,
|
|
! Only redo this on the final adjoint step.
|
|
IF ( GET_NYMD() == GET_NYMDb() .AND.
|
|
& GET_NHMS() == GET_NHMSb() ) THEN
|
|
! dkh debug
|
|
print*, ' FIRSTCHEM = TRUE '
|
|
FIRSTCHEM = .TRUE.
|
|
ELSE
|
|
FIRSTCHEM = .FALSE.
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Open "smv2.log" output file and read chem mechanism switches
|
|
!=================================================================
|
|
IF ( FIRSTCHEM ) THEN
|
|
|
|
! Read from data file mglob.dat
|
|
CALL READER( FIRSTCHEM )
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after READER' )
|
|
|
|
! Set NCS for urban chemistry only (since that is where we
|
|
! have defined the GEOS-CHEM mechanism) (bdf, bmy, 4/21/03)
|
|
NCS = NCSURBAN
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Call RURALBOX, which defines tropospheric boxes to be sent to
|
|
! the SMVGEAR solver, as well as setting up some SMVGEAR arrays.
|
|
!=================================================================
|
|
|
|
! Redefine NTLOOP since READER defines it initially (bmy, 9/28/04)
|
|
NLOOP = NLAT * NLONG
|
|
NTLOOP = NLOOP * NVERT
|
|
|
|
CALL RURALBOX( AD, T, AVGW, ALBD, SUNCOS,
|
|
& LEMBED, IEBD1, IEBD2, JEBD1, JEBD2 )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after RURALBOX' )
|
|
|
|
! Reset NTTLOOP, the # of tropospheric grid boxes
|
|
NTTLOOP = NTLOOP
|
|
|
|
!=================================================================
|
|
! Call SETMODEL which defines number of grid-blocks in calculation,
|
|
! and copies meteorological parameters into local variables
|
|
!=================================================================
|
|
CALL SETMODEL
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after SETMODEL' )
|
|
|
|
!=================================================================
|
|
! Do the following only on the first call ...
|
|
!=================================================================
|
|
IF ( FIRSTCHEM ) THEN
|
|
|
|
!---------------------------------
|
|
! Initialize chemistry mechanism
|
|
!---------------------------------
|
|
|
|
|
|
NEMIS(NCSURBAN) = 0
|
|
NNADDV(NCSURBAN) = 0
|
|
NNADDA(NCSURBAN) = 0
|
|
NNADDB(NCSURBAN) = 0
|
|
NNADDC(NCSURBAN) = 0
|
|
NNADDD(NCSURBAN) = 0
|
|
NNADDF(NCSURBAN) = 0
|
|
NNADDH(NCSURBAN) = 0
|
|
NNADDG(NCSURBAN) = 0
|
|
! dkh debug: try not reading this during adj integration
|
|
! to avoid over incrementing NEMIS (dkh, 07/31/09)
|
|
! Read "globchem.dat" chemistry mechanism
|
|
CALL READCHEM
|
|
|
|
! Set NCS=NCSURBAN here since we have defined our tropospheric
|
|
! chemistry mechanism in the urban slot of SMVGEAR II (bmy, 4/21/03)
|
|
NCS = NCSURBAN
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after READCHEM' )
|
|
|
|
!---------------------------------
|
|
! Check for LISOPOH for SOA
|
|
!---------------------------------
|
|
IF ( LSOA .and. ILISOPOH == 0 ) THEN
|
|
CALL ERROR_STOP( 'LISOPOH needs to be defined for SOA!',
|
|
& 'chemdr.f' )
|
|
ENDIF
|
|
|
|
!---------------------------------
|
|
! Set global concentration of CH4
|
|
!---------------------------------
|
|
IF ( ICH4 > 0 .and. ( CH4_YEAR /= GET_YEAR() ) ) THEN
|
|
|
|
! If CH4 is a SMVGEAR II species, then call GET_GLOBAL_CH4
|
|
! to return the globally-varying CH4 conc. as a function of
|
|
! year and latitude bin. (ICH4 is defined in READCHEM.)
|
|
! (bnd, bmy, 7/1/03)
|
|
!
|
|
! If we are using the future emissions, then get the CH4
|
|
! concentrations for FUTURE_YEAR. Otherwise get the CH4
|
|
! concentrations for the current met field year.
|
|
! (swu, havala, bmy, 1/24/08)
|
|
IF ( LFUTURE ) THEN
|
|
CH4_YEAR = GET_FUTURE_YEAR()
|
|
ELSE
|
|
CH4_YEAR = GET_YEAR()
|
|
ENDIF
|
|
|
|
! Get CH4 [ppbv] in 4 latitude bins for each year
|
|
CALL GET_GLOBAL_CH4( CH4_YEAR, .TRUE., C3090S,
|
|
& C0030S, C0030N, C3090N )
|
|
ENDIF
|
|
|
|
!-------------------------------
|
|
! Initialize FAST-J photolysis
|
|
!-------------------------------
|
|
CALL INPHOT( LLTROP, NPHOT )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after INPHOT' )
|
|
|
|
!-------------------------------
|
|
! Flag certain chemical species
|
|
!-------------------------------
|
|
CALL SETTRACE
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after SETTRACE' )
|
|
|
|
!-------------------------------
|
|
! Flag emission & drydep rxns
|
|
!-------------------------------
|
|
CALL SETEMDEP( N_TRACERS )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after SETEMDEP' )
|
|
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! At the beginning of each new day, call SETUP_PLANEFLIGHT
|
|
! to see if there are any plane flight points to be processed
|
|
!=================================================================
|
|
IF ( ND40 > 0 .and. ITS_A_NEW_DAY() ) THEN
|
|
CALL SETUP_PLANEFLIGHT
|
|
ENDIF
|
|
|
|
!================================================================
|
|
! Get concentrations of aerosols in [kg/m3]
|
|
! for FAST-J and optical depth diagnostics
|
|
!=================================================================
|
|
IF ( LSULF .or. LCARB .or. LDUST .or. LSSALT ) THEN
|
|
|
|
! Skip this section if all these are turned off
|
|
CALL AEROSOL_CONC
|
|
|
|
ENDIF
|
|
|
|
! Now this is done at the end of DO_WETDEP_ADJ
|
|
! ! SO2 and SO4 may have changed during DO_ADJ_WETDEP, so
|
|
! ! reload their values here. (dkh, 2006)
|
|
! IF ( GET_DIRECTION() < 0 ) THEN
|
|
! STT(:,:,:,IDTSO2) = CHK_STT_BEFCHEM(:,:,:,IDTSO2)
|
|
! STT(:,:,:,IDTSO4) = CHK_STT_BEFCHEM(:,:,:,IDTSO4)
|
|
! ENDIF
|
|
|
|
|
|
!=================================================================
|
|
! Call GASCONC which initializes gas concentrations and sets
|
|
! miscellaneous parameters. GASCONC also calls PARTITION, which
|
|
! splits up family tracers like NOx and Ox into individual
|
|
! chemical species for SMVGEAR.
|
|
! NOTE:
|
|
! (1) The call to GASCONC is modified to use CSPEC_FULL restart
|
|
! file (dkh, hotp, ccc,2/26/09)
|
|
!=================================================================
|
|
IT_EXISTS = .FALSE.
|
|
IF ( FIRSTCHEM .AND. LSVCSPEC ) THEN
|
|
|
|
CALL READ_CSPEC_FILE( GET_NYMD(), GET_NHMS(), IT_EXISTS )
|
|
|
|
IF ( .not. IT_EXISTS ) THEN
|
|
|
|
! Use default background values
|
|
WRITE(6,*)
|
|
& ' - CHEMDR: CSPEC restart not found, use background values'
|
|
|
|
CALL GASCONC( FIRSTCHEM, N_TRACERS, STT, XNUMOL, FRCLND,
|
|
& IT_EXISTS )
|
|
|
|
ELSE
|
|
|
|
! Use default background values
|
|
WRITE(6,*)
|
|
& ' - CHEMDR: using CSPEC values from restart file'
|
|
|
|
! Call GASCONC but don't reset CSPEC values
|
|
CALL GASCONC( .FALSE., N_TRACERS, STT, XNUMOL, FRCLND,
|
|
& IT_EXISTS )
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
! dkh debug
|
|
!IF ( LPRINTFD ) THEN
|
|
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
|
print*, ' CSPEC before partition adj = ',
|
|
& CSPEC(JLOP(IFD,JFD,LFD),:)
|
|
ENDIF
|
|
|
|
! Copy CSPEC top CSPEC_FULL so that CSPEC doesn't get
|
|
! overwritten with an old CSPEC_FULL in GASCONC (dkh, 08/04/09)
|
|
! LVARTROP support for adj (dkh, 01/26/11)
|
|
! don't need to do this now becuase we actually checkpt CSPEC_FULL
|
|
! IF ( LVARTROP ) CALL SAVE_FULL_TROP
|
|
CALL GASCONC( FIRSTCHEM, N_TRACERS, STT, XNUMOL, FRCLND,
|
|
& IT_EXISTS )
|
|
|
|
ENDIF
|
|
IT_EXISTS = .FALSE.
|
|
|
|
!ADJ_GROUP: Saving CSPEC for KPP calculation
|
|
CSPEC_FOR_KPP(:,:) = CSPEC(:,:)
|
|
CSPEC_ORIG(:,:) = CSPEC(:,:)
|
|
|
|
!IF ( LPRINTFD ) THEN
|
|
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
|
|
|
WRITE(6,*) 'CSPEC(FD) after GASCONC = ',
|
|
& CSPEC(JLOP(IFD,JFD,LFD),:)
|
|
print*, 'STT_ADJ in chemdr_adj', STT_ADJ(IFD,JFD,LFD,:)
|
|
print*, 'CSPEC_ADJ before lump_adj',
|
|
& CSPEC_ADJ(JLOP(IFD,JFD,LFD),:)
|
|
ENDIF
|
|
|
|
|
|
! Use dkh's adjoint routine for lumping and partioning
|
|
CALL LUMP_ADJ( N_TRACERS, XNUMOL, STT_ADJ )
|
|
|
|
!IF ( LPRINTFD ) THEN
|
|
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
|
print*, 'STT_ADJ after lump_adj', STT_ADJ(IFD,JFD,LFD,:)
|
|
print*, 'CSPEC_ADJ after lump_adj',
|
|
& CSPEC_ADJ(JLOP(IFD,JFD,LFD),:)
|
|
ENDIF
|
|
|
|
|
|
! Update for new strat chem (hml dkh, 02/14/12, adj32_025)
|
|
!! SCHEM applies a simplified strat chemistry in order
|
|
!! to prevent stuff from building up in the stratosphere
|
|
!!CALL SCHEM_ADJ
|
|
! Do stratospheric chemistry adjoint
|
|
IF ( LSCHEM ) CALL DO_STRAT_CHEM_ADJ
|
|
|
|
!### Debug
|
|
IF ( LPRT )
|
|
& CALL DEBUG_MSG( '### CHEMDR_ADJ: after STRAT_CHEM_ADJ' )
|
|
|
|
! Reset dry dep adjoints (fp, dkh, 01/06/12, adj32_006)
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( N, NK, JJ )
|
|
DO N = 1,NUMDEP
|
|
NK = NTDEP(N)
|
|
IF (NK.NE.0) THEN
|
|
JJ = IRM(NPRODLO+1,NK,NCS)
|
|
IF (JJ.GT.0) THEN
|
|
CSPEC_ADJ(:,JJ) = 0.0D0
|
|
ENDIF
|
|
ENDIF
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
|
|
! Apply forcing from observation (or sensitivyt w.r.t)
|
|
! of CSPEC species. (dkh, 10/25/07)
|
|
! Now use CSPEC_AFTER_CHEM_ADJ (dkh, 02/09/11)
|
|
IF ( LCSPEC_OBS ) THEN
|
|
DO N = 1, NOBS_CSPEC
|
|
|
|
IDCSPEC = IDCSPEC_ADJ(N)
|
|
|
|
CSPEC_ADJ(:,IDCSPEC) = CSPEC_ADJ(:,IDCSPEC)
|
|
& + CSPEC_AFTER_CHEM_ADJ(:,N)
|
|
|
|
CSPEC_AFTER_CHEM_ADJ(:,N) = 0d0
|
|
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after GASCONC' )
|
|
|
|
!=================================================================
|
|
! Call RDAER -- computes aerosol optical depths
|
|
!=================================================================
|
|
CALL RDAER( MONTH, YEAR )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after RDAER' )
|
|
|
|
!=================================================================
|
|
! If LDUST is turned on, then we have online dust aerosol in
|
|
! GEOS-CHEM...so just pass SOILDUST to RDUST_ONLINE in order to
|
|
! compute aerosol optical depth for FAST-J, etc.
|
|
!
|
|
! If LDUST is turned off, then we do not have online dust aerosol
|
|
! in GEOS-CHEM...so read monthly-mean dust files from disk.
|
|
! (rjp, tdf, bmy, 4/1/04)
|
|
!=================================================================
|
|
IF ( LDUST ) THEN
|
|
CALL RDUST_ONLINE( SOILDUST )
|
|
ELSE
|
|
CALL RDUST_OFFLINE( MONTH, YEAR )
|
|
ENDIF
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR: after RDUST' )
|
|
|
|
NPTS = NTTLOOP
|
|
|
|
! At present, we are only doing tropospheric chemistry, which
|
|
! for the moment we are storing in SMVGEAR II's "urban" slot
|
|
NCS = NCSURBAN
|
|
|
|
!=================================================================
|
|
! Call photolysis routine to compute J-Values
|
|
!=================================================================
|
|
CALL FAST_J( SUNCOS, OPTD, UVALBEDO )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after FAST-J' )
|
|
|
|
!=================================================================
|
|
! Call SETEMIS which sets emission rates REMIS
|
|
!=================================================================
|
|
CALL SETEMIS( EMISRR, EMISRRN )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after SETEMIS' )
|
|
|
|
!================================================================
|
|
! Call chemistry routines
|
|
!================================================================
|
|
|
|
! PHYSPROC calls both CALCRATE, which computes rxn rates
|
|
! and SMVGEAR, which is the chemistry solver
|
|
CALL PHYSPROC( SUNCOS, SUNCOSB )
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### CHEMDR_ADJ: after PHYSPROC' )
|
|
|
|
NHMS = GET_NHMS()
|
|
NYMD = GET_NYMD()
|
|
TAU = GET_TAU()
|
|
|
|
NTT = NTTLOOP
|
|
|
|
!================================================================
|
|
! Call KPP generated chemical solver. DIRECTION = -1 is adjoint
|
|
!================================================================
|
|
CALL GCKPP_ADJ_DRIVER( GET_DIRECTION() )
|
|
|
|
!### Debug
|
|
IF ( LPRT )
|
|
& CALL DEBUG_MSG( '### CHEMDR_ADJ: after GCKPP_ADJ_DRIVER')
|
|
|
|
! Can compare KPP to SMVGEAR side-by-side (dkh, 06/20/05)
|
|
!IF ( LPRINTFD ) THEN
|
|
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
|
|
|
|
|
!! Display times (SMVGEAR time will be padded by time to do CALCRATE )
|
|
!WRITE(6,*) ' SMVGEAR TIME : ', TIME2 - TIME1
|
|
!WRITE(6,*) ' ROSENBK TIME : ', TIME3 - TIME2
|
|
|
|
! Display comparison for a particular cell
|
|
JLOOPTMP = JLOP(IFD,JFD,LFD)
|
|
WRITE(6,*) ' Spot test in cell:', JLOOPTMP
|
|
WRITE(6,*) ' LON = ', GET_XMID(IFD)
|
|
WRITE(6,*) ' LAT = ', GET_YMID(JFD)
|
|
WRITE(6,*) ' LOCAL TIME = ', GET_LOCALTIME(IFD)
|
|
|
|
WRITE(6,*) ' Species SMVGEAR ROS R/S
|
|
& ORIG '
|
|
WRITE(6,69) (NAMEGAS(I),CSPEC(JLOOPTMP,I),
|
|
& CSPEC_FOR_KPP(JLOOPTMP,I),
|
|
& CSPEC_FOR_KPP(JLOOPTMP,I) / CSPEC(JLOOPTMP,I),
|
|
& CSPEC_ORIG(JLOOPTMP,I),
|
|
& I=1,87)
|
|
69 FORMAT(A10,1X,F20.2,1X,F20.2,1X,1PE10.2,1X,F20.2)
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
! dkh debug
|
|
WRITE(6,*) ' - CHECK_STT_ADJ after GCKPP_ADJ_DRIVER'
|
|
CALL CHECK_STT_ADJ('AFTER GCKPP_ADJ_DRIVER')
|
|
|
|
! We don't call any adjoint of PHYSPROC. We just directly call CALCRATE_ADJ
|
|
! from within GCKPP_ADJ_DRIVER. That saves us some RAM.
|
|
|
|
|
|
!=================================================================
|
|
! Do adjoint of rdaer
|
|
!=================================================================
|
|
print*, ' NEED to update ADJ_RDAER '
|
|
print*, ' NEED to update ADJ_RDAER '
|
|
print*, ' NEED to update ADJ_RDAER '
|
|
print*, ' NEED to update RDAER_ADJ '
|
|
! CALL RDAER_ADJ( SO4_NH4_NIT, BCPI, BCPO, OCPI, OCPO,
|
|
! & ADJ_SO4_NH4_NIT, ADJ_BCPI, ADJ_BCPO,
|
|
! & ADJ_OCPI, ADJ_OCPO )
|
|
|
|
! For now, don't include these in FDTESTs
|
|
IF ( LFDTEST ) THEN
|
|
ADJ_SO4_NH4_NIT = 0d0
|
|
ADJ_BCPI = 0D0
|
|
ADJ_BCPO = 0D0
|
|
ADJ_OCPI = 0D0
|
|
ADJ_OCPO = 0D0
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Do adjoint of setemis
|
|
!=================================================================
|
|
|
|
CALL SETEMIS_ADJ
|
|
|
|
!=================================================================
|
|
! To do this we need STT = STT_BEFCHEM and
|
|
! CSPEC = CSPEC_CHK = CSPEC from after chem of step n - 1.
|
|
! CSPEC neads to be reloaded, it
|
|
! was overwritten in the above call to PARTITION
|
|
!$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(I,J,L,N) = CHK_STT_BEFCHEM(I,J,L,N)
|
|
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( JLOOP, N )
|
|
DO N = 1, IGAS
|
|
DO JLOOP = 1, ITLOOP
|
|
|
|
CSPEC(JLOOP,N) = CHK_CSPEC(JLOOP,N)
|
|
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!IF ( LPRINTFD ) THEN
|
|
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
|
print*, 'CSPEC_ADJ before partition_adj',
|
|
& CSPEC_ADJ(JLOP(IFD,JFD,LFD),:)
|
|
ENDIF
|
|
|
|
! Use partition adjoint from dkh
|
|
CALL PARTITION_ADJ( STT_ADJ, STT, N_TRACERS, XNUMOL )
|
|
|
|
! Now use insead of CSPEC_AFTER_CHEM_ADJ (nb, dkh, 01/06/12, adj32_003)
|
|
!#if defined( SCIA_KNMI_NO2_OBS ) || defined( SCIA_DAL_NO2_OBS )
|
|
! ! Apply forcing from satellite observations
|
|
! CSPEC_ADJ(:,IDNO2) = CSPEC_ADJ(:,IDNO2) + CSPEC_NO2_ADJ(:)
|
|
! CSPEC_NO2_ADJ(:) = 0d0
|
|
!#endif
|
|
|
|
|
|
!### Debug
|
|
IF ( LPRT )
|
|
& CALL DEBUG_MSG( '### CHEMDR_ADJ: after PARTITION_ADJ' )
|
|
|
|
!IF ( LPRINTFD ) THEN
|
|
IF ( LPRINTFD .and. JLOP(IFD,JFD,LFD) > 0 ) THEN
|
|
print*, 'CSPEC_ADJ after partition_adj',
|
|
& CSPEC_ADJ(JLOP(IFD,JFD,LFD),:)
|
|
print*, 'STT_ADJ after partition_adj',
|
|
& STT_ADJ(IFD,JFD,LFD,:)
|
|
ENDIF
|
|
|
|
! dkh debug
|
|
WRITE(6,*) 'CHECK_STT_ADJ after PARTITION_ADJ'
|
|
CALL CHECK_STT_ADJ('after partition_adj')
|
|
|
|
|
|
! Adjoint of AEROSOL_CONT
|
|
!=================================================================
|
|
IF ( LSULF .or. LCARB .or. LDUST .or. LSSALT ) THEN
|
|
|
|
! Skip this section if all these are turned off
|
|
print*, ' NEED to updae AEROSOL_CONC_ADJ'
|
|
print*, ' NEED to updae AEROSOL_CONC_ADJ'
|
|
print*, ' NEED to updae AEROSOL_CONC_ADJ'
|
|
print*, ' NEED to updae AEROSOL_CONC_ADJ'
|
|
!CALL AEROSOL_CONC_ADJ
|
|
|
|
ENDIF
|
|
|
|
|
|
!### Debug
|
|
IF ( LPRT ) CALL DEBUG_MSG( '### Now exiting CHEMDR_ADJ!' )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CHEMDR_ADJ
|
|
|
|
|
|
|
|
|