Add files via upload
This commit is contained in:
Xuesong (Steve)
332
code/adjoint/strat_chem_adj_mod.f
Normal file
332
code/adjoint/strat_chem_adj_mod.f
Normal file
@ -0,0 +1,332 @@
|
||||
!$ID$
|
||||
!
|
||||
! Subroutine STRAT_CHEM_ADJ_MOD performs adjoint of strat chem.
|
||||
! Based on forward model routine STRAT_CHEM_MOD.
|
||||
!
|
||||
! !INTERFACE:
|
||||
!
|
||||
MODULE STRAT_CHEM_ADJ_MOD
|
||||
!
|
||||
! !USES:
|
||||
!
|
||||
IMPLICIT NONE
|
||||
PRIVATE
|
||||
!
|
||||
! !PUBLIC MEMBER FUNCTIONS:
|
||||
!
|
||||
PUBLIC :: DO_STRAT_CHEM_ADJ
|
||||
!
|
||||
!------------------------------------------------------------------------------
|
||||
!BOC
|
||||
!
|
||||
! !PRIVATE TYPES:
|
||||
!
|
||||
! Scalars
|
||||
!REAL*8 :: DTCHEM
|
||||
|
||||
! Parameters
|
||||
!INTEGER, PARAMETER :: NTR_GMI = 120 ! Number of species
|
||||
! 118 as output from GMI + NOx + Ox families
|
||||
|
||||
!INTEGER, PARAMETER :: MAX_FM = 1 ! Max number of species in a fam
|
||||
! Vestigial, as NOx and Ox families pre-processed, but may be useful
|
||||
! for future uses, e.g., ClOx.
|
||||
|
||||
! Arrays
|
||||
!REAL*8, ALLOCATABLE :: PROD(:,:,:,:)
|
||||
!REAL*8, ALLOCATABLE :: LOSS(:,:,:,:)
|
||||
!INTEGER, ALLOCATABLE :: GMI_TO_GC(:,:)
|
||||
!INTEGER, SAVE :: ncID_strat_rates
|
||||
|
||||
!=================================================================
|
||||
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
||||
!=================================================================
|
||||
CONTAINS
|
||||
!EOC
|
||||
!------------------------------------------------------------------------------
|
||||
!BOP
|
||||
!
|
||||
! !IROUTINE: DO_STRAT_CHEM_ADJ
|
||||
!
|
||||
! !DESCRIPTION: Function DO\_STRAT\_CHEM is the driver routine for computing
|
||||
! the simple linearized stratospheric chemistry scheme for a host of species
|
||||
! whose prod/loss rates were determined from the GMI combo model. Ozone is
|
||||
! treated using either Linoz or Synoz.
|
||||
!
|
||||
! !INTERFACE:
|
||||
!
|
||||
SUBROUTINE DO_STRAT_CHEM_ADJ
|
||||
!
|
||||
! !USES:
|
||||
!
|
||||
USE DAO_MOD, ONLY : AD, CONVERT_UNITS
|
||||
USE ERROR_MOD, ONLY : DEBUG_MSG
|
||||
USE LOGICAL_MOD, ONLY : LLINOZ, LPRT
|
||||
USE TIME_MOD, ONLY : GET_MONTH, TIMESTAMP_STRING
|
||||
USE TRACER_MOD, ONLY : ITS_A_FULLCHEM_SIM, ITS_A_TAGOX_SIM
|
||||
USE TRACER_MOD, ONLY : N_TRACERS, STT, TCVV, TRACER_MW_KG
|
||||
USE TRACERID_MOD, ONLY : IDTOX
|
||||
USE TROPOPAUSE_MOD, ONLY : GET_MIN_TPAUSE_LEVEL, ITS_IN_THE_TROP
|
||||
! adj_group (hml, 07/20/11)
|
||||
USE STRAT_CHEM_MOD, ONLY : PROD_0, LOSS_0
|
||||
USE STRAT_CHEM_MOD, ONLY : PROD, LOSS
|
||||
USE STRAT_CHEM_MOD, ONLY : DTCHEM
|
||||
USE STRAT_CHEM_MOD, ONLY : NSCHEM
|
||||
USE STRAT_CHEM_MOD, ONLY : Strat_TrID_GC
|
||||
USE STRAT_CHEM_MOD, ONLY : GET_RATES
|
||||
USE STRAT_CHEM_MOD, ONLY : GET_RATES_INTERP
|
||||
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
|
||||
USE ADJ_ARRAYS_MOD, ONLY : PROD_SF, LOSS_SF
|
||||
USE ADJ_ARRAYS_MOD, ONLY : PROD_SF_ADJ, LOSS_SF_ADJ
|
||||
USE ADJ_ARRAYS_MOD, ONLY : ID_LOSS
|
||||
USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD, LFD
|
||||
USE ADJ_ARRAYS_MOD, ONLY : NSTPL
|
||||
USE TIME_MOD, ONLY : ITS_A_NEW_MONTH
|
||||
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
||||
USE LINOZ_ADJ_MOD, ONLY : DO_LINOZ_ADJ
|
||||
USE CHECKPOINT_MOD, ONLY : READ_BEFSTRAT_CHKFILE
|
||||
USE TIME_MOD, ONLY : GET_NHMS
|
||||
USE TIME_MOD, ONLY : GET_NYMD
|
||||
USE TRACER_MOD, ONLY : STT_STRAT_TMP
|
||||
USE LOGICAL_ADJ_MOD,ONLY : LADJ_STRAT
|
||||
|
||||
# include "define.h"
|
||||
# include "CMN_SIZE"
|
||||
!
|
||||
!EOP
|
||||
!------------------------------------------------------------------------------
|
||||
!
|
||||
! !LOCAL VARIABLES:
|
||||
!
|
||||
INTEGER, SAVE :: LASTSEASON = -1
|
||||
INTEGER :: I, J, L, N, LMIN
|
||||
INTEGER :: IORD, JORD, KORD
|
||||
INTEGER :: NN, NS, NSL
|
||||
REAL*8 :: dt, P, k, M0
|
||||
REAL*8 :: P_ADJ, k_ADJ, M0_ADJ
|
||||
REAL*8 :: LOSS_ADJ, PROD_ADJ
|
||||
CHARACTER(LEN=16) :: STAMP
|
||||
INTEGER :: NHMS
|
||||
INTEGER :: NYMD
|
||||
|
||||
|
||||
!===============================
|
||||
! DO_STRAT_CHEM_ADJ begins here!
|
||||
!===============================
|
||||
|
||||
STAMP = TIMESTAMP_STRING()
|
||||
WRITE( 6, 100 ) STAMP
|
||||
100 FORMAT( ' - DO_STRAT_CHEM_ADJ: Strat chemistry at ', a )
|
||||
|
||||
!================================================
|
||||
! Determine the rates from disk; merge families
|
||||
!================================================
|
||||
|
||||
! Get the minimum level extent of the tropopause
|
||||
LMIN = GET_MIN_TPAUSE_LEVEL()
|
||||
|
||||
! Use ITS_A_NEW_MONTH instead, which works for forward and adjoint
|
||||
!IF ( GET_MONTH() /= LASTMONTH ) THEN
|
||||
IF ( ITS_A_NEW_MONTH() ) THEN
|
||||
|
||||
WRITE(6,*) 'Getting new strat rates for month: ',GET_MONTH()
|
||||
|
||||
IF ( LPRT ) CALL DEBUG_MSG( '### STRAT_CHEM_ADJ: at GET_RATES')
|
||||
|
||||
! Read rates for this month
|
||||
IF ( ITS_A_FULLCHEM_SIM() ) THEN
|
||||
#if defined( GRID4x5 ) || defined( GRID2x25 )
|
||||
CALL GET_RATES( GET_MONTH() )
|
||||
#else
|
||||
! For resolutions finer than 2x2.5, nested,
|
||||
! or otherwise exotic domains and resolutions
|
||||
CALL GET_RATES_INTERP( GET_MONTH() )
|
||||
#endif
|
||||
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
IF ( LPRT )
|
||||
& CALL DEBUG_MSG( '### STRAT_CHEM_ADJ: at DO_STRAT_CHEM_ADJ' )
|
||||
|
||||
! READING STT FROM CHECKPOINT FILE (hml, 07/31/11)
|
||||
NHMS = GET_NHMS()
|
||||
NYMD = GET_NYMD()
|
||||
CALL READ_BEFSTRAT_CHKFILE( NYMD, NHMS )
|
||||
|
||||
WRITE(6,*) '-----------------------------------------------------'
|
||||
write(6,*) ' Doing strat chem ajdiont (STRAT_CHEM_ADJ_MOD) '
|
||||
WRITE(6,*) '-----------------------------------------------------'
|
||||
|
||||
!================================================================
|
||||
! Full chemistry simulations
|
||||
!================================================================
|
||||
IF ( ITS_A_FULLCHEM_SIM() ) THEN
|
||||
|
||||
!=============================================================
|
||||
! Do chemical production and loss for non-ozone species for
|
||||
! which we have explicit prod/loss rates from GMI
|
||||
!=============================================================
|
||||
|
||||
!$OMP PARALLEL DO
|
||||
!$OMP+DEFAULT( SHARED )
|
||||
!$OMP+PRIVATE( I, J, L, N, k, P, dt, M0, NN, NS )
|
||||
!$OMP+PRIVATE( k_ADJ, P_ADJ, M0_ADJ )
|
||||
!$OMP+PRIVATE( LOSS_ADJ, PROD_ADJ )
|
||||
!$OMP+SCHEDULE( DYNAMIC )
|
||||
DO J = 1,JJPAR
|
||||
DO I = 1,IIPAR
|
||||
|
||||
DO L = LMIN,LLPAR
|
||||
|
||||
IF ( ITS_IN_THE_TROP( I, J, L ) ) CYCLE
|
||||
|
||||
DO N=1,NSCHEM ! Tracer index of active strat chem species
|
||||
NN = Strat_TrID_GC(N) ! Tracer index in STT
|
||||
|
||||
! Include something to expediate skipping past species
|
||||
! that we do not have strat chem for. Prob put tracer on
|
||||
! outermost loop.
|
||||
|
||||
! Skip Ox; we'll always use either Linoz or Synoz
|
||||
! Now we will use GMI rate for Ox if LINOZ is off (hml, 10/31/11)
|
||||
IF ( ITS_A_FULLCHEM_SIM() .and. (NN .eq. IDTOx) .and.
|
||||
& LLINOZ) CYCLE
|
||||
|
||||
! adj_group: make a version that applies scaling factors
|
||||
! and use this if the stratosphere adjoint ID #'s are active
|
||||
IF ( LADJ_STRAT ) THEN
|
||||
DO NS = 1, NSTPL
|
||||
|
||||
NSL = ID_LOSS(NS) ! same for ID_PROD(NS)
|
||||
|
||||
IF ( NN .EQ. NSL ) THEN
|
||||
|
||||
PROD(I,J,L,N) = PROD_0(I,J,L,N)
|
||||
& * PROD_SF(I,J,1,NS)
|
||||
LOSS(I,J,L,N) = LOSS_0(I,J,L,N)
|
||||
& * LOSS_SF(I,J,1,NS)
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDIF
|
||||
|
||||
! recalculate forward values to use for adjoint code (hml)
|
||||
dt = DTCHEM ! timestep [s]
|
||||
k = LOSS(I,J,L,N) ! loss freq [s-1]
|
||||
P = PROD(I,J,L,N) * AD(I,J,L) / TCVV(NN)! production term [kg s-1]
|
||||
! Use checkpointed value
|
||||
M0 = STT_STRAT_TMP(I,J,L,NN) ! initial mass [kg]
|
||||
|
||||
! debug test
|
||||
!IF ( I == IFD .and. J == JFD .and. L == LFD ) THEN
|
||||
! print*, ' IFD, JFD, LFD = ', IFD, JFD, LFD
|
||||
! print*, NN,' STRAT TEST adj: k = ', k
|
||||
! print*, NN,' STRAT TEST adj: P = ', P
|
||||
! print*, NN,' STRAT TEST adj: M0= ', M0
|
||||
!ENDIF
|
||||
|
||||
! No prod or loss at all
|
||||
IF ( k .eq. 0d0 .and. P .eq. 0d0 ) CYCLE
|
||||
|
||||
! Simple analytic solution to dM/dt = P - kM over [0,t]
|
||||
IF ( k .gt. 0d0 ) THEN
|
||||
! fwd code:
|
||||
!STT(I,J,L,N) = M0 * exp(-k*t) + (P/k)*(1d0-exp(-k*t))
|
||||
! adj code:
|
||||
M0_ADJ = STT_ADJ(I,J,L,NN) * exp(-k*dt)
|
||||
P_ADJ = STT_ADJ(I,J,L,NN) * (1d0 - exp(-k*dt))/k
|
||||
k_ADJ = STT_ADJ(I,J,L,NN)
|
||||
& * ( -p/(k**2) + p/(k**2)*exp(-k*dt)
|
||||
& + (p*dt/k)*exp(-k*dt) - dt*exp(-k*dt)*M0 )
|
||||
ELSE
|
||||
! fwd code:
|
||||
!STT(I,J,L,N) = M0 + P*t
|
||||
! adj code:
|
||||
M0_ADJ = STT_ADJ(I,J,L,NN)
|
||||
P_ADJ = STT_ADJ(I,J,L,NN) * dt
|
||||
ENDIF
|
||||
|
||||
! fwd code:
|
||||
!k = LOSS(I,J,L,N) ! loss freq [s-1]
|
||||
!P = PROD(I,J,L,N) * AD(I,J,L) / TCVV(N) ! production term [kg s-1]
|
||||
!M0 = STT(I,J,L,N) ! initial mass [kg]
|
||||
! adj code:
|
||||
LOSS_ADJ = K_ADJ
|
||||
PROD_ADJ = P_ADJ * AD(I,J,L) / TCVV(NN)
|
||||
STT_ADJ (I,J,L,NN) = M0_ADJ
|
||||
|
||||
IF ( LADJ_STRAT ) THEN
|
||||
DO NS = 1, NSTPL
|
||||
|
||||
NSL = ID_LOSS(NS) ! same for ID_PROD(NS)
|
||||
|
||||
IF ( NN .EQ. NSL ) THEN
|
||||
|
||||
! fwd code:
|
||||
!PROD(I,J,L,N) = PROD_0(I,J,L,N) * PROD_SF(I,J,1,N)
|
||||
!LOSS(I,J,L,N) = LOSS_0(I,J,L,N) * LOSS_SF(I,J,1,N)
|
||||
! adj code:
|
||||
PROD_SF_ADJ(I,J,1,NS) = PROD_SF_ADJ(I,J,1,NS)
|
||||
& + PROD_0(I,J,L,N)
|
||||
& * PROD_ADJ
|
||||
LOSS_SF_ADJ(I,J,1,NS) = LOSS_SF_ADJ(I,J,1,NS)
|
||||
& + LOSS_0(I,J,L,N)
|
||||
& * LOSS_ADJ
|
||||
ENDIF
|
||||
ENDDO
|
||||
ENDIF
|
||||
|
||||
ENDDO ! N
|
||||
ENDDO ! L
|
||||
ENDDO ! I
|
||||
ENDDO ! J
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
|
||||
!===================================
|
||||
! Ozone
|
||||
!===================================
|
||||
|
||||
! fwd code: Put ozone in v/v
|
||||
!STT(:,:,:,IDTOX ) = STT(:,:,:,IDTOX) * TCVV( IDTOX ) / AD
|
||||
! adj code: Put ozone back to kg
|
||||
STT_ADJ(:,:,:,IDTOX ) =
|
||||
& STT_ADJ(:,:,:,IDTOX) * AD / TCVV( IDTOX )
|
||||
|
||||
IF ( LLINOZ ) THEN
|
||||
CALL DO_LINOZ_ADJ ! Linoz
|
||||
ELSE
|
||||
! must use Linoz or strat chem Ox fluxes for the adjoint
|
||||
ENDIF
|
||||
|
||||
! fwd code: Put ozone back to kg
|
||||
!STT(:,:,:,IDTOX) = STT(:,:,:,IDTOX) * AD / TCVV( IDTOX )
|
||||
! adj code: Put ozone in v/v
|
||||
STT_ADJ(:,:,:,IDTOX) =
|
||||
& STT_ADJ(:,:,:,IDTOX)* TCVV( IDTOX ) / AD
|
||||
|
||||
ELSE IF ( ITS_A_TAGOX_SIM() ) THEN
|
||||
|
||||
! fwd code:
|
||||
!CALL CONVERT_UNITS( 1, N_TRACERS, TCVV, AD, STT ) ! kg -> v/v
|
||||
! adj code:
|
||||
CALL CONVERT_UNITS( 2, N_TRACERS, TCVV, AD, STT_ADJ ) ! v/v -> kg
|
||||
|
||||
! adjoint LINOZ does not support tagged Ox simulation for now (hml, 10/05/11)
|
||||
IF ( LLINOZ ) THEN
|
||||
CALL DO_LINOZ_ADJ ! Linoz
|
||||
ELSE
|
||||
! must use Linoz or strat chem Ox fluxes for the adjoint
|
||||
ENDIF
|
||||
|
||||
! fwd code:
|
||||
!CALL CONVERT_UNITS( 2, N_TRACERS, TCVV, AD, STT ) ! v/v -> kg
|
||||
! adj code:
|
||||
CALL CONVERT_UNITS( 1, N_TRACERS, TCVV, AD, STT_ADJ ) ! kg -> v/v
|
||||
|
||||
ENDIF
|
||||
|
||||
END SUBROUTINE DO_STRAT_CHEM_ADJ
|
||||
!EOC
|
||||
!------------------------------------------------------------------------------
|
||||
END MODULE STRAT_CHEM_ADJ_MOD
|
||||
Reference in New Issue
Block a user