1924 lines
71 KiB
Fortran
1924 lines
71 KiB
Fortran
!$Id: mem_ch4_mod.f,v 1.1 2012/03/01 22:00:27 daven Exp $
|
|
MODULE MEM_CH4_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module MEM_CH4_MOD for CH4 observations.
|
|
! By kjw, added adj32_023 (dkh, 02/12/12)
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
IMPLICIT NONE
|
|
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
|
|
! Parameters
|
|
INTEGER, PARAMETER :: LLMEM = 13
|
|
INTEGER, PARAMETER :: MAXMEM = 639059
|
|
|
|
|
|
! Record to store information about the new instrument
|
|
REAL*8 :: AVGKERNEL( LLMEM, LLMEM )
|
|
REAL*8 :: OBSERROR( LLMEM, LLMEM )
|
|
REAL*8 :: OBSERROR_INV( LLMEM, LLMEM )
|
|
REAL*8 :: TOTERROR_INV( LLMEM, LLMEM )
|
|
REAL*8 :: PRESSURE( LLMEM )
|
|
REAL*8 :: PRESSURE_EDGE( LLMEM )
|
|
REAL*8 :: RANDNUM( MAXMEM )
|
|
REAL*8, ALLOCATABLE :: CH4_PRIOR(:,:,:)
|
|
|
|
|
|
CONTAINS
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE READ_MEM_INFO
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine READ_MEM_INFO reads and stores information about the new
|
|
! instrument, specifically AK, pressure levels and error covariance matrices.
|
|
! (kjw, 07/24/11)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) FILENAME (CHAR) : MEM filename to read
|
|
!
|
|
!
|
|
! NOTES:
|
|
! (1 )
|
|
!******************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE FILE_MOD, ONLY : IOERROR
|
|
USE TIME_MOD, ONLY : GET_NYMD
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
|
|
# include "CMN_SIZE" ! Size params
|
|
|
|
! Arguments
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: READ_FILENAME
|
|
|
|
! netCDF id's
|
|
INTEGER :: NCID, LG, LN
|
|
INTEGER :: nobs_id, yyyymmdd_id, hhmmss_id
|
|
INTEGER :: qflag_id, xch4_id, ch4ak_id
|
|
INTEGER :: ch4pres_id, ch4prior_id
|
|
INTEGER :: gcii_id, gcjj_id, gcfrac_id
|
|
LOGICAL, SAVE :: LDEBUG = .TRUE.
|
|
REAL*8 :: XTAU
|
|
REAL*4 :: DUMMY_PRIOR(IGLOB,JGLOB,LLMEM)
|
|
|
|
! Loop indexes, and error handling.
|
|
INTEGER :: IOS, IU_IN, AS
|
|
|
|
|
|
|
|
!=================================================================
|
|
! READ_MEM_CH4_OBS begins here!
|
|
!=================================================================
|
|
|
|
! Initialize module variabl
|
|
AVGKERNEL(:,:) = 0d0
|
|
OBSERROR(:,:) = 0d0
|
|
OBSERROR_INV(:,:) = 0d0
|
|
TOTERROR_INV(:,:) = 0d0
|
|
PRESSURE(:) = 0d0
|
|
PRESSURE_EDGE(:) = 0d0
|
|
RANDNUM(:) = 0d0
|
|
|
|
|
|
! Read and store one variable at a time
|
|
|
|
! ------ Averaging Kernel Matrix ------
|
|
! Filename to read
|
|
READ_FILENAME = TRIM( '/home/kjw/new_satellites/mem/' ) //
|
|
& 'data/' // TRIM( 'mem_AK.txt' )
|
|
WRITE(6,*) ' - READ_MEM_AK: reading file: ',
|
|
& TRIM(READ_FILENAME)
|
|
|
|
! Open file
|
|
OPEN( IU_IN, FILE=TRIM( READ_FILENAME ),
|
|
& STATUS='OLD', IOSTAT=IOS )
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_IN, 'read_avg_kernel:1' )
|
|
|
|
! Read File and save info into module variable AVGKERNEL(:,:)
|
|
DO LN=1,LLMEM
|
|
READ( IU_IN, '(13F12.6)', IOSTAT=IOS ) AVGKERNEL(LN,:)
|
|
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'Avg Kernel, row ',LN
|
|
WRITE(6,'(13F12.6)') AVGKERNEL(LN,:)
|
|
ENDIF
|
|
|
|
! IO status
|
|
IF ( IOS < 0 ) THEN
|
|
WRITE( 6, '(a)' ) 'Unexpected end of file encountered!'
|
|
WRITE( 6, '(a)' ) 'STOP in READ_MEM_CH4'
|
|
ENDIF
|
|
IF ( IOS > 0 ) THEN
|
|
CALL IOERROR(IOS, IU_IN, 'read_avg_kernel:2')
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! Close file
|
|
CLOSE( IU_IN )
|
|
|
|
|
|
! ------ Observation Error Covariance Matrix ------
|
|
! Filename to read
|
|
READ_FILENAME = TRIM( '/home/kjw/new_satellites/mem/' ) //
|
|
& 'data/' // TRIM( 'mem_obs_error.txt' )
|
|
WRITE(6,*) ' - READ_MEM_OBSERROR: reading file: ',
|
|
& TRIM(READ_FILENAME)
|
|
|
|
|
|
! Open file
|
|
OPEN( IU_IN, FILE=TRIM( READ_FILENAME ),
|
|
& STATUS='OLD', IOSTAT=IOS )
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_IN, 'read_obs_error:1' )
|
|
|
|
! Read File and save info into module variable OBSERROR(:,:)
|
|
DO LN=1,LLMEM
|
|
READ( IU_IN, '(13F18.12)', IOSTAT=IOS ) OBSERROR(LN,:)
|
|
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'Obs Error covar, row ',LN
|
|
WRITE(6,'(13F18.12)') OBSERROR(LN,:)
|
|
ENDIF
|
|
|
|
! IO status
|
|
IF ( IOS < 0 ) THEN
|
|
WRITE( 6, '(a)' ) 'Unexpected end of file encountered!'
|
|
WRITE( 6, '(a)' ) 'STOP in READ_MEM_CH4'
|
|
ENDIF
|
|
IF ( IOS > 0 ) THEN
|
|
CALL IOERROR(IOS, IU_IN, 'read_obs_error:2')
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! Close file
|
|
CLOSE( IU_IN )
|
|
|
|
|
|
! ------ Inverse of Observation Error Covariance Matrix ------
|
|
! Filename to read
|
|
READ_FILENAME = TRIM( '/home/kjw/new_satellites/mem/' ) //
|
|
& 'data/' // TRIM( 'mem_obs_error_inv.txt' )
|
|
WRITE(6,*) ' - READ_MEM_OBSERROR_INV: reading file: ',
|
|
& TRIM(READ_FILENAME)
|
|
|
|
|
|
! Open file
|
|
OPEN( IU_IN, FILE=TRIM( READ_FILENAME ),
|
|
& STATUS='OLD', IOSTAT=IOS )
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_IN, 'read_obs_error:1' )
|
|
|
|
! Read File and save info into module variable OBSERROR_INV(:,:)
|
|
DO LN=1,LLMEM
|
|
READ( IU_IN, '(13F18.6)', IOSTAT=IOS ) OBSERROR_INV(LN,:)
|
|
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'Inv Obs Error covar, row ',LN
|
|
WRITE(6,'(13F18.6)') OBSERROR_INV(LN,:)
|
|
ENDIF
|
|
|
|
! IO status
|
|
IF ( IOS < 0 ) THEN
|
|
WRITE( 6, '(a)' ) 'Unexpected end of file encountered!'
|
|
WRITE( 6, '(a)' ) 'STOP in READ_MEM_CH4'
|
|
ENDIF
|
|
IF ( IOS > 0 ) THEN
|
|
CALL IOERROR(IOS, IU_IN, 'read_obs_error:2')
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! Close file
|
|
CLOSE( IU_IN )
|
|
|
|
|
|
! ! ------ Total Error Covariance Matrix ------
|
|
! ! Filename to read
|
|
! READ_FILENAME = TRIM( '/home/kjw/new_satellites/mem/' ) //
|
|
! & 'data/' // TRIM( 'mem_total_error_inv.txt' )
|
|
! WRITE(6,*) ' - READ_MEM_TOTERROR: reading file: ',
|
|
! & TRIM(READ_FILENAME)
|
|
!
|
|
!
|
|
! ! Open file
|
|
! OPEN( IU_IN, FILE=TRIM( READ_FILENAME ),
|
|
! & STATUS='OLD', IOSTAT=IOS )
|
|
! IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_IN, 'read_tot_error:1' )
|
|
!
|
|
! ! Read File and save info into module variable OBSERROR(:,:)
|
|
! DO LN=1,LLMEM
|
|
! READ( IU_IN, '(13F18.12)', IOSTAT=IOS ) TOTERROR_INV(LN,:)
|
|
!
|
|
! ! IO status
|
|
! IF ( IOS < 0 ) THEN
|
|
! WRITE( 6, '(a)' ) 'Unexpected end of file encountered!'
|
|
! WRITE( 6, '(a)' ) 'STOP in READ_MEM_CH4'
|
|
! ENDIF
|
|
! IF ( IOS > 0 ) THEN
|
|
! CALL IOERROR(IOS, IU_IN, 'read_tot_error:2')
|
|
! ENDIF
|
|
! ENDDO
|
|
!
|
|
! ! Close file
|
|
! CLOSE( IU_IN )
|
|
|
|
|
|
! ------ Pressure Levels ------
|
|
! Filename to read
|
|
READ_FILENAME = TRIM( '/home/kjw/new_satellites/mem/' ) //
|
|
& 'data/' // TRIM( 'mem_pressure.txt' )
|
|
WRITE(6,*) ' - READ_MEM_PRESSURE: reading file: ',
|
|
& TRIM(READ_FILENAME)
|
|
|
|
! Open file
|
|
OPEN( IU_IN, FILE=TRIM( READ_FILENAME ),
|
|
& STATUS='OLD', IOSTAT=IOS )
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_IN, 'read_pressure:1' )
|
|
|
|
! Read File and save info into module variable PRESSURE(:)
|
|
READ( IU_IN, '(13F12.6)', IOSTAT=IOS ) PRESSURE(:)
|
|
|
|
! IO status
|
|
IF ( IOS < 0 ) THEN
|
|
WRITE( 6, '(a)' ) 'Unexpected end of file encountered!'
|
|
WRITE( 6, '(a)' ) 'STOP in READ_MEM_CH4'
|
|
ENDIF
|
|
IF ( IOS > 0 ) THEN
|
|
CALL IOERROR(IOS, IU_IN, 'read_pressure:2')
|
|
ENDIF
|
|
|
|
! Close file
|
|
CLOSE( IU_IN )
|
|
|
|
|
|
! ------ Pressure Edges ------
|
|
! By finite difference on log(pressure) grid
|
|
PRESSURE_EDGE(1) = PRESSURE(1)
|
|
PRESSURE_EDGE(LLMEM) = 0.
|
|
DO LN=2,LLMEM-1
|
|
PRESSURE_EDGE(LN) = exp( log(pressure(LN+1)) +
|
|
& ( log(PRESSURE(LN)) - log(PRESSURE(LN+1)) ) / 2. )
|
|
ENDDO
|
|
|
|
|
|
! ------ A priori vertical profiles ------
|
|
ALLOCATE( CH4_PRIOR(IGLOB,JGLOB,LLMEM), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CH4_PRIOR' )
|
|
CH4_PRIOR(:,:,:) = 0d0
|
|
|
|
FILENAME = '/home/kjw/new_satellites/mem/data/' //
|
|
& 'mem_prior.' // GET_RES_EXT() // '.bpch'
|
|
XTAU = GET_TAU0( 1, 1, 1985 )
|
|
|
|
WRITE(6,*) ' - READ_CH4_PRIOR: reading file: ',
|
|
& TRIM(FILENAME)
|
|
|
|
CALL READ_BPCH2( FILENAME, 'IJ-AVG-$', 1,
|
|
& XTAU, IGLOB, JGLOB,
|
|
& LLMEM, DUMMY_PRIOR, QUIET=.TRUE. )
|
|
CH4_PRIOR(:,:,:) = DUMMY_PRIOR(:,:,:)
|
|
|
|
|
|
! LDEBUG = FALSE. Only print values first time reading
|
|
LDEBUG = .FALSE.
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_MEM_INFO
|
|
!------------------------------------------------------------------------------
|
|
|
|
|
|
SUBROUTINE CALC_MEM_CH4_FORCE( COST_FUNC )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CALC_MEM_CH4_FORCE calculates the adjoint forcing from the MEM
|
|
! CH4 observations and updates the cost function. (kjw, 07/20/11)
|
|
!
|
|
!
|
|
! Arguments as Input/Output:
|
|
! ============================================================================
|
|
! (1 ) COST_FUNC (REAL*8) : Cost funciton [unitless]
|
|
!
|
|
!
|
|
! NOTES:
|
|
! (1 )
|
|
!******************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT, GET_TAU0
|
|
USE BPCH2_MOD, ONLY : READ_BPCH2, GET_MODELNAME
|
|
USE BPCH2_MOD, ONLY : BPCH2, OPEN_BPCH2_FOR_WRITE
|
|
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ, CHECK_STT_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
|
|
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
|
|
USE CHECKPT_MOD, ONLY : CHK_STT
|
|
USE DAO_MOD, ONLY : AD, CLDFRC
|
|
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR, ADJTMP_DIR
|
|
USE GRID_MOD, ONLY : GET_YEDGE, GET_AREA_M2
|
|
USE PRESSURE_MOD, ONLY : GET_PCENTER, GET_PEDGE
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
USE TIME_MOD, ONLY : GET_DAY, GET_MONTH, GET_YEAR
|
|
USE TIME_MOD, ONLY : GET_TAU
|
|
USE TIME_MOD, ONLY : GET_LOCALTIME, EXPAND_DATE
|
|
USE TRACER_MOD, ONLY : STT
|
|
USE TRACER_MOD, ONLY : XNUMOL, XNUMOLAIR
|
|
USE TRACER_MOD, ONLY : TCVV
|
|
USE ERROR_MOD, ONLY : ERROR_STOP, IT_IS_NAN
|
|
USE LOGICAL_ADJ_MOD, ONLY : LDCOSAT
|
|
USE FILE_MOD, ONLY : IU_RST
|
|
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
|
|
|
|
|
|
# include "CMN_SIZE" ! Size params
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(INOUT) :: COST_FUNC
|
|
|
|
! Local variables
|
|
INTEGER, SAVE :: NT ! # observations processed this day
|
|
INTEGER :: LG, LN, LLN, II, JJ, JMIN, OB
|
|
INTEGER :: nlev, lind, IU_IN
|
|
INTEGER :: nboxes, nobs
|
|
INTEGER :: NTSTART, NTSTOP, NTh, NB
|
|
INTEGER, SAVE :: NTT
|
|
REAL*8 :: GC_CH4_TRUE_ARRAY(IIPAR,JJPAR,LLPAR)
|
|
REAL*4 :: DUMMY_TRUE(IIPAR,JJPAR,LLPAR)
|
|
REAL*4 :: DUMMY_RAND(IGLOB,JGLOB,1)
|
|
REAL*4, SAVE :: RANDOM_GRID(IGLOB,JGLOB)
|
|
REAL*8 :: GC_PCENTER(LLPAR)
|
|
REAL*8 :: GC_PEDGE(LLPAR)
|
|
REAL*8 :: GC_AD(LLPAR)
|
|
REAL*8 :: GC_CH4_NATIVE(LLPAR)
|
|
REAL*8 :: GC_CH4_NATIVE_OB(LLPAR)
|
|
REAL*8 :: GC_CH4_onMEM(LLMEM)
|
|
REAL*8 :: GC_CH4_onMEM_OB(LLMEM)
|
|
REAL*8 :: GRIDMAP(LLPAR,LLMEM)
|
|
REAL*8 :: OBSERROR_INV_SUPER(LLMEM,LLMEM)
|
|
REAL*8 :: SIGN(LLMEM,LLMEM)
|
|
REAL*8 :: OBSERROR_SQRT(LLMEM,LLMEM)
|
|
REAL*8 :: CH4_HAT(LLMEM)
|
|
REAL*8 :: CH4_HAT_EXP(LLMEM)
|
|
REAL*8 :: CH4_HAT_OB(LLMEM)
|
|
REAL*8 :: CH4_HAT_OB_EXP(LLMEM)
|
|
REAL*8 :: CH4_HAT_ADJ(LLMEM)
|
|
REAL*8 :: CH4_HAT_EXP_ADJ(LLMEM)
|
|
REAL*8 :: CH4_PERT(LLMEM)
|
|
REAL*8 :: CH4_PERT_OB(LLMEM)
|
|
REAL*8 :: CH4_PERT_ADJ(LLMEM)
|
|
REAL*8 :: frac, frac_total
|
|
REAL*8 :: latmin, Jfrac_min, Jfrac
|
|
REAL*8 :: box_area, cloud_frac
|
|
REAL*8 :: mass_air, mole_air, mole_ch4
|
|
REAL*8 :: LHS, RHS, GC_XCH4, XTAU
|
|
REAL*8 :: PUP, PLO
|
|
REAL*8 :: XCH4_HAT, XCH4_HAT_OB
|
|
REAL*8 :: XCH4_HAT_ADJ, XCH4_HAT_OB_ADJ
|
|
REAL*8 :: SUPER_ERR, S_obs_inv
|
|
REAL*8 :: SUPER_ERR_EXPECTED
|
|
REAL*8 :: XWEIGHT(LLMEM)
|
|
REAL*8 :: DIFF, FORCE
|
|
REAL*8 :: sumxweight
|
|
REAL*8 :: DIFF_ADJ
|
|
REAL*8 :: GC_CH4_onMEM_ADJ(LLMEM)
|
|
REAL*8 :: GC_CH4_NATIVE_ADJ(LLPAR)
|
|
REAL*8 :: NEW_COST(IIPAR*JJPAR*LLPAR)
|
|
REAL*8 :: OLD_COST
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
LOGICAL, SAVE :: DO_FDTEST = .TRUE.
|
|
INTEGER :: IOS
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
CHARACTER(LEN=255) :: FILENAME_OBS
|
|
|
|
! Arrays for saving with satellite diagnostic turned on
|
|
REAL*8 :: hourly_nobs(IIPAR,JJPAR)
|
|
REAL*8 :: hourly_xch4_sat(IIPAR,JJPAR)
|
|
REAL*8 :: hourly_xch4_model(IIPAR,JJPAR)
|
|
REAL*4 :: DATA_FIELD(IIPAR,JJPAR)
|
|
REAL*4 :: LONRES, LATRES
|
|
INTEGER :: TRACER, I0, J0
|
|
INTEGER, PARAMETER :: HALFPOLAR = 1
|
|
INTEGER, PARAMETER :: CENTER180 = 1
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED = ''
|
|
CHARACTER(LEN=80) :: TITLE
|
|
|
|
! Parameters
|
|
REAL*8, PARAMETER :: XCH4_ERR = 8d0
|
|
|
|
! Variables for FD testing
|
|
REAL*8 :: cost_func_pos, cost_func_neg
|
|
REAL*8 :: cost_func_0
|
|
REAL*8 :: PERT(LLPAR)
|
|
REAL*8 :: ADJ_SAVE(LLPAR)
|
|
REAL*8 :: ADJ(LLPAR)
|
|
REAL*8 :: FD_CEN(LLPAR)
|
|
REAL*8 :: FD_POS(LLPAR)
|
|
REAL*8 :: FD_NEG(LLPAR)
|
|
REAL*8 :: DOFS
|
|
|
|
|
|
!=================================================================
|
|
! CALC_MEM_CH4_FORCE begins here!
|
|
!=================================================================
|
|
|
|
NEW_COST(:) = 0d0
|
|
|
|
|
|
! Open files for output
|
|
IF ( FIRST ) THEN
|
|
FILENAME = 'pres.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 101, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'gc_nh3.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 102, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'tes_nh3.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 103, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'apriori.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 104, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'diff.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 105, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'force.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 106, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'nt_ll.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 107, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'adj_nh3_pert.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 108, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'adj_gc_nh3.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 109, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'exp_nh3_hat.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 110, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
FILENAME = 'exp_nh3_hat_dbl.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 111, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
!kjw for testing adjoint of obs operator
|
|
FILENAME = 'test_adjoint_obs.NN.m'
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
OPEN( 116, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
& IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
|
|
! Read CH4 data
|
|
CALL READ_MEM_INFO
|
|
|
|
! Initialize counter for total number of observations processed
|
|
NTT = 0
|
|
|
|
|
|
FIRST = .FALSE. ! only open files on first call to
|
|
ENDIF
|
|
|
|
|
|
! ! Open file for this hour's satellite diagnostics
|
|
! FILENAME = 'diag_sat.YYYYMMDD.hhmm.NN'
|
|
! CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
! CALL EXPAND_DATE( FILENAME, GET_NYMD(), GET_NHMS() )
|
|
! FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
! OPEN( IU_FILE, FILE=TRIM( FILENAME ), STATUS='UNKNOWN',
|
|
! & IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' )
|
|
|
|
|
|
! Check that we haven't added any NaN to the STT_ADJ array
|
|
CALL CHECK_STT_ADJ( 'Start of CALC_MEM_CH4_FORCE' )
|
|
|
|
! Save a value of the cost function first
|
|
OLD_COST = COST_FUNC
|
|
|
|
! Read "TRUE" state for this time step [kg/box]
|
|
GC_CH4_TRUE_ARRAY(:,:,:) = 0d0
|
|
! FILENAME_OBS = '/home/kjw/GEOS-Chem/gcadj_std/runs/v8-02-01/' //
|
|
! & 'ch4/mem/' // GET_RES_EXT() // '/adjtmp/' //
|
|
! & 'gctm.obs.YYYYMMDD.hhmm'
|
|
FILENAME_OBS = 'gctm.obs.YYYYMMDD.hhmm'
|
|
CALL EXPAND_DATE( FILENAME_OBS, GET_NYMD(), GET_NHMS() )
|
|
FILENAME_OBS = TRIM( ADJTMP_DIR ) // TRIM( FILENAME_OBS )
|
|
XTAU = GET_TAU()
|
|
CALL READ_BPCH2( TRIM(FILENAME_OBS), 'IJ-OBS-$', 1,
|
|
& XTAU, IIPAR, JJPAR,
|
|
& LLPAR, DUMMY_TRUE , QUIET=.TRUE.)
|
|
GC_CH4_TRUE_ARRAY(:,:,:) = DUMMY_TRUE(:,:,:)
|
|
|
|
! Convert from [kg] --> [v/v]
|
|
DO II=1,IIPAR
|
|
DO JJ=1,JJPAR
|
|
DO LG=1,LLPAR
|
|
GC_CH4_TRUE_ARRAY(II,JJ,LG) = GC_CH4_TRUE_ARRAY(II,JJ,LG)
|
|
& * ( 1d3 / 16d0 ) / ( AD(II,JJ,LG) * 1d3 / 28.96 )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
|
|
|
|
! need to update this in order to do i/o with this loop parallel
|
|
!! ! Now do a parallel loop for analyzing data
|
|
!!$OMP PARALLEL DO
|
|
!!$OMP+DEFAULT( SHARED )
|
|
!!$OMP+PRIVATE( NT, MAP, LLNT, IIJJ, I, J, L, LL )
|
|
!!$OMP+PRIVATE( GC_PRES, GC_PSURF, GC_CH4, DIFF )
|
|
!!$OMP+PRIVATE( GC_CH4_NATIVE, CH4_PERT, CH4_HAT, FORCE )
|
|
!!$OMP+PRIVATE( ADJ_GC_CH4_NATIVE, ADJ_GC_CH4 )
|
|
!!$OMP+PRIVATE( ADJ_CH4_PERT, ADJ_CH4_HAT )
|
|
!!$OMP+PRIVATE( ADJ_DIFF )
|
|
|
|
! If new day of observations initialize count
|
|
IF ( GET_NHMS() .EQ. 230000 ) THEN
|
|
NT = 0 ! initialize counter of total observations processed today
|
|
NB = 0 ! initialize counter of total boxes processed today
|
|
|
|
! ------ Random Numbers ------
|
|
! Read error values for this day
|
|
XTAU = GET_TAU0( GET_MONTH(), GET_DAY(), GET_YEAR() )
|
|
FILENAME = '/home/kjw/new_satellites/mem/data/randnums/'
|
|
& // 'random.YYYYMMDD.' // GET_RES_EXT() // '.bpch'
|
|
CALL EXPAND_DATE( FILENAME, GET_NYMD(), 0 )
|
|
CALL READ_BPCH2( TRIM(FILENAME), 'IJ-AVG-$', 1,
|
|
& XTAU, IGLOB, JGLOB,
|
|
& 1, DUMMY_RAND , QUIET=.TRUE.)
|
|
RANDOM_GRID(:,:) = DUMMY_RAND(:,:,1)
|
|
|
|
ENDIF
|
|
|
|
! Get grid offsets for use with nested grid
|
|
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
|
|
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
|
|
|
|
|
|
! Begin counter for
|
|
NTh = 0 ! number of observations processed this hour
|
|
NB = 0 ! number of grid boxes processed this hour
|
|
|
|
! Clear satellite diagnostic information to be safe
|
|
IF ( LDCOSAT .EQ. .TRUE. ) THEN
|
|
hourly_nobs(:,:) = 0d0
|
|
hourly_xch4_sat(:,:) = 0d0
|
|
hourly_xch4_model(:,:) = 0d0
|
|
ENDIF
|
|
|
|
! Information for spatial criteria for observations
|
|
latmin = 40.0
|
|
|
|
! Determine minimum JJ index over which to look for observations
|
|
DO JJ=1, JJPAR-1
|
|
IF ( ( GET_YEDGE(JJ) .LE. latmin ) .AND.
|
|
& ( GET_YEDGE(JJ+1) .GT. latmin ) ) THEN
|
|
JMIN = JJ
|
|
Jfrac_min = ( GET_YEDGE(JJ+1) - latmin ) /
|
|
& ( GET_YEDGE(JJ+1) - GET_YEDGE(JJ) )
|
|
ENDIF
|
|
ENDDO
|
|
|
|
print*, ' - CALC_MEM_CH4_FORCE ', GET_NYMD(), GET_NHMS()
|
|
|
|
|
|
! Loop over each grid box north of the minimum latitude
|
|
! 1. Determine number of observations in the current grid box
|
|
! 2. Make "super-observation" in current grid box
|
|
! "super-observation" is one observation with error and
|
|
! associated error covariance matrix scaled to sqrt(N)
|
|
! where N is the number of regular observations in box
|
|
DO II = 1, IIPAR
|
|
|
|
! If not 1400 <= local time < 1500, cycle to next II value
|
|
IF ( ( GET_LOCALTIME( II ) .LT. 14.00 ) .OR.
|
|
& ( GET_LOCALTIME( II ) .GE. 15.00 ) ) CYCLE
|
|
|
|
! It is 1400-1500 local time, so let's make observations!
|
|
DO JJ = JMIN, JJPAR
|
|
|
|
! For safety, initilize these variables
|
|
nobs = 0
|
|
cloud_frac = 0.
|
|
box_area = 0.
|
|
GC_PCENTER(:) = 0d0
|
|
GC_PEDGE(:) = 0d0
|
|
GC_AD(:) = 0d0
|
|
GC_CH4_NATIVE(:) = 0d0
|
|
GC_CH4_onMEM(:) = 0d0
|
|
GC_CH4_onMEM_OB(:) = 0d0
|
|
|
|
|
|
! Fraction of grid box above minimum latitude
|
|
Jfrac = 1.
|
|
IF ( JJ .EQ. JMIN ) Jfrac = Jfrac_min
|
|
|
|
! Determine number of observations in this grid box
|
|
! # obs = box_area * (1-cloud_fraction) * Jfrac / 100
|
|
! divide by 100 because each observation takes up 100 km2
|
|
box_area = GET_AREA_M2( JJ ) * 1d-6 ! [m2] --> [km2]
|
|
cloud_frac = CLDFRC( II, JJ )
|
|
nobs = NINT( ( (1-cloud_frac) * box_area * Jfrac ) / 100. )
|
|
nobs = 10
|
|
IF ( nobs .LT. 1 ) CYCLE
|
|
|
|
|
|
! Get GEOS-Chem pressure and CH4 column corresponding to this grid box.
|
|
! CH4 in [kg/box] and pressure in [hPa]
|
|
! Get column of pressure centers and CH4 values
|
|
DO LG=1,LLPAR
|
|
|
|
! Pressure centers [hPa]
|
|
GC_PCENTER(LG) = GET_PCENTER(II,JJ,LG)
|
|
|
|
! Pressure edges [hPa]
|
|
GC_PEDGE(LG) = GET_PEDGE(II,JJ,LG)
|
|
|
|
! mass per box [kg]
|
|
GC_AD(LG) = AD(II,JJ,LG)
|
|
|
|
! CH4 values [kg/box] --> [v/v]
|
|
GC_CH4_NATIVE(LG) = ( CHK_STT(II,JJ,LG,1 )
|
|
& * XNUMOL(1) ) / ( GC_AD(LG) * XNUMOLAIR )
|
|
|
|
ENDDO
|
|
|
|
|
|
! Number of vertical levels to use in these observations
|
|
! Chop off lowermost levels if
|
|
! GEOS-Chem surface pressure < MEM pressure levels
|
|
nlev = count( PRESSURE_EDGE .LT. GC_PEDGE(1) )
|
|
!IF ( nlev .LT. 13 ) nlev = nlev + 1
|
|
lind = LLMEM + 1 - nlev ! minimum vertical index on MEM grid
|
|
|
|
! Get interpolation matrix that maps GEOS-Chem to MEM grid
|
|
GRIDMAP(1:LLPAR, 1:LLMEM) =
|
|
& GET_INTMAP( GC_PEDGE, PRESSURE_EDGE, nlev )
|
|
|
|
! Get GEOS-Chem column from "truth" run to make pseudo-observations
|
|
GC_CH4_NATIVE_OB(:) = 0d0
|
|
GC_CH4_NATIVE_OB(:) = GC_CH4_TRUE_ARRAY(II,JJ,:)
|
|
|
|
! Interpolate GEOS-Chem CH4 column and observation to MEM grid
|
|
! Column in [v/v]
|
|
DO LN = lind, LLMEM
|
|
GC_CH4_onMEM(LN) = 0d0
|
|
GC_CH4_onMEM_OB(LN) = 0d0
|
|
DO LG = 1, LLPAR
|
|
GC_CH4_onMEM(LN) = GC_CH4_onMEM(LN)
|
|
& + GRIDMAP(LG,LN) * GC_CH4_NATIVE(LG)
|
|
GC_CH4_onMEM_OB(LN) = GC_CH4_onMEM_OB(LN)
|
|
& + GRIDMAP(LG,LN) * GC_CH4_NATIVE_OB(LG)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!--------------------------------------------------------------
|
|
! Apply MEM observation operator
|
|
!
|
|
! x_hat = x_a + A_k ( x_m - x_a )
|
|
!
|
|
! where
|
|
! x_hat = GC modeled column as seen by MEM [ln(vmr)]
|
|
! x_a = MEM apriori column [ln(vmr)]
|
|
! x_m = GC modeled column on MEM grid [ln(vmr)]
|
|
! A = MEM averaging kernel
|
|
!--------------------------------------------------------------
|
|
|
|
! x_m - x_a for model and "observation"
|
|
! [v/v] --> ln( v/v ) happens here
|
|
DO LN = lind, LLMEM
|
|
GC_CH4_onMEM(LN) =MAX(GC_CH4_onMEM(LN), 1d-10)
|
|
GC_CH4_onMEM_OB(LN)=MAX(GC_CH4_onMEM_OB(LN),1d-10)
|
|
CH4_PERT(LN) =LOG( GC_CH4_onMEM(LN) ) -
|
|
& LOG( CH4_PRIOR(II,JJ,LN) )
|
|
CH4_PERT_OB(LN) =LOG( GC_CH4_onMEM_OB(LN) ) -
|
|
& LOG( CH4_PRIOR(II,JJ,LN) )
|
|
ENDDO
|
|
|
|
! x_a + A_k * ( x_m - x_a ) for model and "observation"
|
|
DO LN = lind, LLMEM
|
|
CH4_HAT(LN) = 0d0
|
|
CH4_HAT_OB(LN) = 0d0
|
|
|
|
DO LLN = lind, LLMEM
|
|
CH4_HAT(LN) = CH4_HAT(LN)
|
|
& + AVGKERNEL(LN,LLN) * CH4_PERT(LLN)
|
|
CH4_HAT_OB(LN) = CH4_HAT_OB(LN)
|
|
& + AVGKERNEL(LN,LLN) * CH4_PERT_OB(LLN)
|
|
ENDDO
|
|
CH4_HAT(LN) = CH4_HAT(LN) +LOG( CH4_PRIOR(II,JJ,LN) )
|
|
CH4_HAT_OB(LN)= CH4_HAT_OB(LN)+LOG( CH4_PRIOR(II,JJ,LN) )
|
|
|
|
ENDDO
|
|
|
|
|
|
! Convert vertical profiles from [ln(vmr)] --> [vmr] before
|
|
! calculating XCH4
|
|
CH4_HAT_EXP = EXP(CH4_HAT)
|
|
CH4_HAT_OB_EXP = EXP(CH4_HAT_OB)
|
|
|
|
|
|
! ---- Calculate XCH4 [v/v] from CH4_HAT [v/v] and CH4_HAT_OB [v/v]
|
|
XCH4_HAT = 0d0
|
|
XCH4_HAT_OB = 0d0
|
|
|
|
! Calculate weight of each vertical level on MEM grid for averaging
|
|
! levels to get XCH4. Weight by # molecules / verical level, which is
|
|
! proportional to pressure difference between upper and lower bounds
|
|
! of each box.
|
|
DO LN=lind, LLMEM
|
|
|
|
! If ground level, average with same weight as if it were 1st atm level
|
|
IF ( LN .EQ. lind ) THEN
|
|
PUP = PRESSURE_EDGE(LN+1)
|
|
PLO = PRESSURE_EDGE(LN )
|
|
ELSE
|
|
PUP = PRESSURE_EDGE(LN )
|
|
PLO = PRESSURE_EDGE(LN-1)
|
|
ENDIF
|
|
|
|
Xweight(LN) = PLO - PUP
|
|
ENDDO
|
|
|
|
!Normalize so that SUM(Xweight) = 1
|
|
sumxweight = SUM( Xweight(:) )
|
|
DO LN=lind,LLMEM
|
|
Xweight(LN) = Xweight(LN) / sumxweight
|
|
ENDDO
|
|
|
|
! Calculate weighted average of CH4_HAT and CH4_HAT_OB
|
|
DO LN=lind, LLMEM
|
|
XCH4_HAT = XCH4_HAT + Xweight(LN) * CH4_HAT_EXP(LN)
|
|
XCH4_HAT_OB = XCH4_HAT_OB +
|
|
& Xweight(LN) * CH4_HAT_OB_EXP(LN)
|
|
ENDDO
|
|
|
|
! if (( II .eq. 11 ) .AND. (JJ .eq. 39)) then
|
|
! print*,'lind = ',lind
|
|
! DO LN=lind,LLMEM
|
|
! print*, LN, xweight(LN),
|
|
! & GC_CH4_onMEM(LN), ch4_hat_exp(LN)
|
|
! ENDDO
|
|
! print*,'---------------------------------------'
|
|
! WRITE(6,'(14F16.8)') 0d0, PRESSURE_EDGE(:)
|
|
! DO LG=1,LLPAR
|
|
! WRITE(6,'(14F16.8)') GC_PEDGE(LG), GRIDMAP(LG,:)
|
|
! ENDDO
|
|
! print*,'---------------------------------------'
|
|
! endif
|
|
|
|
! Create super observation by adding random error
|
|
! to XCH4_HAT_OB
|
|
! SUPER_ERR is 1d-9 * XCH4_ERR[ppb] * N(0,1) / sqrt(nobs) [v/v]
|
|
! where 8ppb is expected error on a single XCH4 measurement
|
|
! N(0,1) is a random number of mean 0, standard deviation 1
|
|
! nobs is the number of observations merged to form super obs
|
|
! Expected error of super-observation XCH4
|
|
SUPER_ERR_EXPECTED = 1d-9 * XCH4_ERR / SQRT( REAL(nobs) )
|
|
|
|
! Multiply expected error of super-observation by
|
|
! prescribed random number with mean 0, standard deviation 1
|
|
SUPER_ERR = SUPER_ERR_EXPECTED * RANDOM_GRID( II+I0, JJ+J0 )
|
|
|
|
! Add random error to super-observation
|
|
XCH4_HAT_OB = XCH4_HAT_OB + SUPER_ERR ! add error [v/v]
|
|
|
|
|
|
!--------------------------------------------------------------
|
|
! Calculate cost function, given S is observation error
|
|
! covariance matrix.
|
|
! Sobs = 1x1 array [ ln(vmr)^2 ]
|
|
! J = [ model - obs ]^T S_{obs}^{-1} [ model - obs ]
|
|
!--------------------------------------------------------------
|
|
|
|
! Initialize values to be safe
|
|
DIFF = 0d0
|
|
FORCE = 0d0
|
|
|
|
! Calculate difference between modeled and observed profile
|
|
DIFF = XCH4_HAT - XCH4_HAT_OB
|
|
|
|
! Calculate adjoint forcing: 2 * DIFF^T * S_{obs}^{-1}
|
|
! and cost function: DIFF^T * S_{obs}^{-1} * DIFF
|
|
! Inverse observation error covariance matrix of super-obs
|
|
S_obs_inv = 1d0 / (SUPER_ERR_EXPECTED**2)
|
|
FORCE = 2 * DIFF * S_obs_inv
|
|
NEW_COST(NB) = 0.5d0 * DIFF * FORCE
|
|
|
|
! print*,'DIFF, XCH4_HAT, XCH4_HAT_OB',
|
|
! & DIFF, XCH4_HAT, XCH4_HAT_OB
|
|
! print*,'DIFF, FORCE, S_obs_inv',
|
|
! & DIFF, FORCE, S_obs_inv
|
|
! print*,'NB, NEW_COST(NB) = ',NB, NEW_COST(NB)
|
|
|
|
!--------------------------------------------------------------
|
|
! Begin adjoint calculations
|
|
!--------------------------------------------------------------
|
|
|
|
! Initialize to be safe
|
|
DIFF_ADJ = 0d0
|
|
|
|
! The adjoint forcing is 2 * S_{obs}^{-1} * DIFF = FORCE
|
|
DIFF_ADJ = FORCE
|
|
|
|
! Adjoint of GEOS-Chem - Observation difference
|
|
XCH4_HAT_ADJ = DIFF_ADJ
|
|
|
|
|
|
! Adjoint of CH4_HAT_EXP --> XCH4_HAT
|
|
DO LN=lind, LLMEM
|
|
CH4_HAT_EXP_ADJ(LN) = XCH4_HAT_ADJ * Xweight(LN)
|
|
ENDDO
|
|
|
|
! Adjoint of CH4_HAT --> CH4_HAT_EXP
|
|
DO LN=lind, LLMEM
|
|
CH4_HAT_ADJ(LN) = CH4_HAT_EXP_ADJ(LN) * CH4_HAT_EXP(LN)
|
|
ENDDO
|
|
|
|
! Adjoint of MEM observation operator
|
|
CH4_PERT_ADJ(:) = 0D0
|
|
DO LN=lind,LLMEM
|
|
DO LLN=lind,LLMEM
|
|
CH4_PERT_ADJ(LN) = CH4_PERT_ADJ(LN) +
|
|
& AVGKERNEL(LLN,LN) * CH4_HAT_ADJ(LLN)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Adjoint of x_m - x_a
|
|
DO LN = lind, LLMEM
|
|
! fwd code:
|
|
!GC_CH4(LN) = MAX(GC_CH4(LN), 1d-10)
|
|
!CH4_PERT(LN) = LOG(GC_CH4(LN)) - LOG(PRIOR(LN))
|
|
! adj code:
|
|
IF ( GC_CH4_onMEM(LN) > 1d-10 ) THEN
|
|
GC_CH4_onMEM_ADJ(LN) = 1d0 / GC_CH4_onMEM(LN) *
|
|
& CH4_PERT_ADJ(LN)
|
|
ELSE
|
|
GC_CH4_onMEM_ADJ(LN) = 1d0 / 1d-10 * CH4_PERT_ADJ(LN)
|
|
ENDIF
|
|
ENDDO
|
|
|
|
|
|
! Adjoint of interpolation
|
|
DO LN=lind,LLMEM
|
|
DO LG=1,LLPAR
|
|
GC_CH4_NATIVE_ADJ(LG) = GC_CH4_NATIVE_ADJ(LG) +
|
|
& GRIDMAP(LG,LN) * GC_CH4_onMEM_ADJ(LN)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
|
|
! Adjoint of unit conversion [kg/box] --> [v/v]
|
|
DO LG=1,LLPAR
|
|
GC_CH4_NATIVE_ADJ(LG) = GC_CH4_NATIVE_ADJ(LG)
|
|
& * XNUMOL(1) / ( XNUMOLAIR * GC_AD(LG) )
|
|
ENDDO
|
|
|
|
|
|
! Pass adjoing forcing back to adjoint tracer array
|
|
DO LG=1,LLPAR
|
|
STT_ADJ(II,JJ,LG,1) = STT_ADJ(II,JJ,LG,1) +
|
|
& GC_CH4_NATIVE_ADJ(LG)
|
|
ENDDO
|
|
|
|
|
|
! Update cost function
|
|
COST_FUNC = COST_FUNC + NEW_COST(NB)
|
|
print*,'--------------------------------'
|
|
print*,'I,J = ',II,JJ
|
|
CALL CHECK_STT_ADJ( 'Inside CALC_MEM_CH4_FORCE' )
|
|
print*,' COST_FUNC, NEW_COST(NB) = ',COST_FUNC, NEW_COST(NB)
|
|
|
|
|
|
! Record information for satellite diagnostics
|
|
IF ( LDCOSAT .EQ. .TRUE. ) THEN
|
|
hourly_nobs(II,JJ) = hourly_nobs(II,JJ) + nobs
|
|
hourly_xch4_sat(II,JJ) =hourly_xch4_sat(II,JJ) + XCH4_HAT_OB
|
|
hourly_xch4_model(II,JJ)=hourly_xch4_model(II,JJ) + XCH4_HAT
|
|
ENDIF
|
|
|
|
|
|
! Increment counters
|
|
NTh = NTh + nobs ! # obs processed this hour4
|
|
NT = NT + nobs ! # obs processed today
|
|
NTT = NTT + nobs ! # obs processed total
|
|
NB = NB + 1 ! # boxes processed this hour
|
|
|
|
ENDDO ! End looping over each grid box JJ
|
|
ENDDO ! End looping over each grid box II
|
|
|
|
! Save satellite diagnostic information to file
|
|
IF ( LDCOSAT .EQ. .TRUE. ) THEN
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // 'sat.diagnostic.mem.' //
|
|
& 'YYYYMMDD.hhmm.NN'
|
|
TITLE = 'Satellite Observation Diagnostic File'
|
|
UNIT = '[v/v]'
|
|
CATEGORY = 'IJ-AVG-$'
|
|
MODELNAME = GET_MODELNAME()
|
|
LONRES = DISIZE
|
|
LATRES = DJSIZE
|
|
|
|
CALL EXPAND_DATE( FILENAME, GET_NYMD(), GET_NHMS() )
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
|
|
! Open BPCH file for writing
|
|
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
|
|
|
|
! Write values to bpch
|
|
TRACER = 1
|
|
DATA_FIELD(:,:) = hourly_nobs
|
|
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
|
|
& HALFPOLAR, CENTER180, CATEGORY, TRACER,
|
|
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
|
|
& IIPAR, JJPAR, 1, I0+1,
|
|
& J0+1, 1, DATA_FIELD )
|
|
TRACER = 2
|
|
DATA_FIELD(:,:) = hourly_xch4_sat
|
|
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
|
|
& HALFPOLAR, CENTER180, CATEGORY, TRACER,
|
|
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
|
|
& IIPAR, JJPAR, 1, I0+1,
|
|
& J0+1, 1, DATA_FIELD )
|
|
TRACER = 3
|
|
DATA_FIELD(:,:) = hourly_xch4_model
|
|
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
|
|
& HALFPOLAR, CENTER180, CATEGORY, TRACER,
|
|
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
|
|
& IIPAR, JJPAR, 1, I0+1,
|
|
& J0+1, 1, DATA_FIELD )
|
|
|
|
! Close file
|
|
CLOSE( IU_RST )
|
|
|
|
ENDIF
|
|
|
|
|
|
! Check that we haven't added any NaN to the STT_ADJ array
|
|
CALL CHECK_STT_ADJ( 'End of CALC_MEM_CH4_FORCE' )
|
|
|
|
|
|
!!$OMP END PARALLEL DO
|
|
|
|
|
|
! -----------------------------------------------------------------------
|
|
! Use this section to test the adjoint of the MEM_CH4 operator by
|
|
! slightly perturbing model [CH4] and recording resultant change
|
|
! in calculated contribution to the cost function.
|
|
!
|
|
! This routine will write the following information for each observation
|
|
! to rundir/diagadj/test_adjoint_obs.NN.m
|
|
!
|
|
! The adjoint of the observation operator has been tested and validated
|
|
! as of 7/20/10, kjw.
|
|
!
|
|
IF ( DO_FDTEST ) THEN
|
|
WRITE(116,210) ' LG' , ' TROP', ' GC_PRES',
|
|
& ' FD_POS', ' FD_NEG', ' FD_CEN',
|
|
& ' ADJ', ' COST_POS', ' COST_NEG',
|
|
& ' FD_POS/ADJ', ' FD_NEG/ADJ', ' FD_CEN/ADJ'
|
|
PERT(:) = 0D0
|
|
|
|
COST_FUNC_0 = 0d0
|
|
CALL CALC_MEM_CH4_FORCE_FD( COST_FUNC_0, PERT, ADJ )
|
|
ADJ_SAVE(:) = ADJ(:)
|
|
|
|
!DO LN=lind,LLMEM
|
|
! DOFS = DOFS + AVGKERNEL(LN,LN)
|
|
!ENDDO
|
|
|
|
! Write identifying information to top of satellite diagnostic file
|
|
WRITE(116,212) 'COST_FUNC_0: ',( COST_FUNC_0 )
|
|
|
|
|
|
! Perform finite difference testing at each vertical level
|
|
DO LG = 1, 47
|
|
|
|
! Positive perturbation to GEOS-Chem CH4 columns
|
|
PERT(:) = 0.0
|
|
PERT(LG) = 0.001
|
|
COST_FUNC_pos = 0D0
|
|
CALL CALC_MEM_CH4_FORCE_FD( COST_FUNC_pos, PERT, ADJ )
|
|
|
|
! Negative perturbation to GEOS-Chem CH4 columns
|
|
PERT(:) = 0.0
|
|
PERT(LG) = -0.001
|
|
COST_FUNC_neg = 0D0
|
|
CALL CALC_MEM_CH4_FORCE_FD( COST_FUNC_neg, PERT, ADJ )
|
|
|
|
! Calculate dJ/dCH4 from perturbations
|
|
FD_CEN(LG) =(COST_FUNC_pos - COST_FUNC_neg) / (2*abs(PERT(LG)))
|
|
FD_POS(LG) = ( COST_FUNC_pos - COST_FUNC_0 ) / abs(PERT(LG))
|
|
FD_NEG(LG) = ( COST_FUNC_0 - COST_FUNC_neg ) / abs(PERT(LG))
|
|
|
|
! Write information to satellite diagnostic file
|
|
WRITE(116, 211) LG, GC_PCENTER(LG),
|
|
& FD_POS(LG), FD_NEG(LG),
|
|
& FD_CEN(LG), ADJ_SAVE(LG),
|
|
& COST_FUNC_pos, COST_FUNC_neg,
|
|
& FD_POS(LG)/ADJ_SAVE(LG),
|
|
& FD_NEG(LG)/ADJ_SAVE(LG),
|
|
& FD_CEN(LG)/ADJ_SAVE(LG)
|
|
ENDDO
|
|
|
|
|
|
WRITE(116,'(a)') '----------------------------------------------'
|
|
|
|
210 FORMAT(A4,2x,A6,2x,A12,2x,A12,2x,A12,2x,A12,2x,A12,2x,A12,2x,
|
|
& A12,2x,A12,2x,A12,2x,A12,2x)
|
|
211 FORMAT(I4,2x,D12.6,2x,D12.6,2x,D12.6,2x,D12.6,2x,D12.6,
|
|
& 2x,D12.6,2x,D12.6,2x,D12.6,2x,D12.6,2x,D12.6)
|
|
212 FORMAT(A12,F22.6)
|
|
213 FORMAT(A12,I4)
|
|
214 FORMAT(I4,2x,F18.6,2x,F18.6)
|
|
! -----------------------------------------------------------------------
|
|
DO_FDTEST = .FALSE.
|
|
ENDIF ! IF ( DO_FDTEST )
|
|
|
|
|
|
|
|
! Update cost function
|
|
!COST_FUNC = COST_FUNC + SUM(NEW_COST(:))
|
|
|
|
print*, ' Updated value of COST_FUNC = ', COST_FUNC
|
|
print*, ' MEM contribution this hour = ', COST_FUNC - OLD_COST
|
|
print*, ' # Obs analyzed this hour = ', NTh
|
|
print*, ' # Obs analyzed today = ', NT
|
|
print*, ' # Obs analyzed total = ', NTT
|
|
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CALC_MEM_CH4_FORCE
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
SUBROUTINE CALC_MEM_CH4_FORCE_FD( COST_FUNC_A, PERT, ADJ )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CALC_MEM_CH4_FORCE calculates the adjoint forcing from the MEM
|
|
! CH4 observations and updates the cost function. (kjw, 07/20/11)
|
|
!
|
|
!
|
|
! Arguments as Input/Output:
|
|
! ============================================================================
|
|
! (1 ) COST_FUNC_A (REAL*8) : Cost funciton (INOUT) [unitless]
|
|
! (2 ) PERT (Real*8) : Array of perturbations to CH4 column (+/- 0.1, for ex.)
|
|
! (5 ) ADJ (REAL*8) : Array of adjoint forcings (OUT)
|
|
!
|
|
! NOTES:
|
|
! (1 )
|
|
!******************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT, GET_TAU0
|
|
USE BPCH2_MOD, ONLY : READ_BPCH2
|
|
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
|
|
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
|
|
USE CHECKPT_MOD, ONLY : CHK_STT
|
|
USE DAO_MOD, ONLY : AD, CLDFRC
|
|
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR, ADJTMP_DIR
|
|
USE GRID_MOD, ONLY : GET_YEDGE, GET_AREA_M2
|
|
USE PRESSURE_MOD, ONLY : GET_PCENTER, GET_PEDGE
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
USE TIME_MOD, ONLY : GET_TAU
|
|
USE TIME_MOD, ONLY : GET_LOCALTIME, EXPAND_DATE
|
|
USE TRACER_MOD, ONLY : STT
|
|
USE TRACER_MOD, ONLY : XNUMOL, XNUMOLAIR
|
|
USE TRACER_MOD, ONLY : TCVV
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
# include "CMN_SIZE" ! Size params
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(INOUT) :: COST_FUNC_A
|
|
REAL*8, INTENT(OUT) :: ADJ(LLPAR)
|
|
REAL*8, INTENT(IN) :: PERT(LLPAR)
|
|
|
|
|
|
! Local variables
|
|
INTEGER, SAVE :: NT ! # observations processed this day
|
|
INTEGER :: LG, LN, LLN, II, JJ, JMIN, OB
|
|
INTEGER :: nlev, lind, IU_IN
|
|
INTEGER :: nboxes, nobs
|
|
INTEGER :: NTSTART, NTSTOP, NTh, NB
|
|
INTEGER, SAVE :: NTT
|
|
REAL*8 :: GC_CH4_TRUE_ARRAY(IIPAR,JJPAR,LLPAR)
|
|
REAL*4 :: DUMMY_PRIOR(IIPAR,JJPAR,LLMEM)
|
|
REAL*4 :: DUMMY_TRUE(IIPAR,JJPAR,LLPAR)
|
|
REAL*4 :: RANDOM_GRID(IGLOB,JGLOB)
|
|
REAL*8 :: GC_PCENTER(LLPAR)
|
|
REAL*8 :: GC_PEDGE(LLPAR)
|
|
REAL*8 :: GC_AD(LLPAR)
|
|
REAL*8 :: GC_CH4_NATIVE(LLPAR)
|
|
REAL*8 :: GC_CH4_NATIVE_OB(LLPAR)
|
|
REAL*8 :: GC_CH4_onMEM(LLMEM)
|
|
REAL*8 :: GC_CH4_onMEM_OB(LLMEM)
|
|
REAL*8 :: GRIDMAP(LLPAR,LLMEM)
|
|
REAL*8 :: OBSERROR_INV_SUPER(LLMEM,LLMEM)
|
|
REAL*8 :: SIGN(LLMEM,LLMEM)
|
|
REAL*8 :: OBSERROR_SQRT(LLMEM,LLMEM)
|
|
REAL*8 :: CH4_HAT(LLMEM)
|
|
REAL*8 :: CH4_HAT_EXP(LLMEM)
|
|
REAL*8 :: CH4_HAT_OB(LLMEM)
|
|
REAL*8 :: CH4_HAT_OB_EXP(LLMEM)
|
|
REAL*8 :: CH4_HAT_ADJ(LLMEM)
|
|
REAL*8 :: CH4_HAT_EXP_ADJ(LLMEM)
|
|
REAL*8 :: CH4_PERT(LLMEM)
|
|
REAL*8 :: CH4_PERT_OB(LLMEM)
|
|
REAL*8 :: CH4_PERT_ADJ(LLMEM)
|
|
REAL*8 :: frac, frac_total
|
|
REAL*8 :: latmin, Jfrac_min, Jfrac
|
|
REAL*8 :: box_area, cloud_frac
|
|
REAL*8 :: mass_air, mole_air, mole_ch4
|
|
REAL*8 :: LHS, RHS, GC_XCH4, XTAU
|
|
REAL*8 :: PUP, PLO
|
|
REAL*8 :: XCH4_HAT, XCH4_HAT_OB
|
|
REAL*8 :: XCH4_HAT_ADJ, XCH4_HAT_OB_ADJ
|
|
REAL*8 :: SUPER_ERR, S_obs_inv
|
|
REAL*8 :: SUPER_ERR_EXPECTED
|
|
REAL*8 :: XWEIGHT(LLMEM)
|
|
REAL*8 :: DIFF, FORCE
|
|
REAL*8 :: sumxweight
|
|
REAL*8 :: DIFF_ADJ
|
|
REAL*8 :: GC_CH4_onMEM_ADJ(LLMEM)
|
|
REAL*8 :: GC_CH4_NATIVE_ADJ(LLPAR)
|
|
REAL*8 :: NEW_COST(IIPAR*JJPAR*LLPAR)
|
|
REAL*8 :: OLD_COST
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
LOGICAL, SAVE :: DO_FDTEST = .TRUE.
|
|
LOGICAL, SAVE :: LDEBUG = .FALSE.
|
|
INTEGER :: IOS
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
CHARACTER(LEN=255) :: FILENAME_OBS
|
|
|
|
! Parameters
|
|
REAL*8, PARAMETER :: XCH4_ERR = 8d0
|
|
|
|
|
|
!=================================================================
|
|
! CALC_MEM_CH4_FORCE_FD begins here!
|
|
!=================================================================
|
|
|
|
print*, ' - CALC_MEM_CH4_FORCE_FD '
|
|
|
|
NEW_COST(:) = 0d0
|
|
|
|
|
|
! ---- Read "TRUE" state for this time step ----
|
|
GC_CH4_TRUE_ARRAY(:,:,:) = 0d0
|
|
! FILENAME_OBS = '/home/kjw/GEOS-Chem/gcadj_std/runs/v8-02-01/' //
|
|
! & 'ch4/mem/' // GET_RES_EXT() // '/adjtmp/' //
|
|
! & 'gctm.obs.YYYYMMDD.hhmm'
|
|
FILENAME_OBS = 'gctm.obs.YYYYMMDD.hhmm'
|
|
CALL EXPAND_DATE( FILENAME_OBS, GET_NYMD(), GET_NHMS() )
|
|
FILENAME_OBS = TRIM( ADJTMP_DIR ) // TRIM( FILENAME_OBS )
|
|
XTAU = GET_TAU()
|
|
CALL READ_BPCH2( TRIM(FILENAME_OBS), 'IJ-OBS-$', 1,
|
|
& XTAU, IIPAR, JJPAR,
|
|
& LLPAR, DUMMY_TRUE, QUIET=.TRUE.)
|
|
GC_CH4_TRUE_ARRAY(:,:,:) = DUMMY_TRUE(:,:,:)
|
|
|
|
! Convert from [kg] --> [v/v]
|
|
DO II=1,IIPAR
|
|
DO JJ=1,JJPAR
|
|
DO LG=1,LLPAR
|
|
GC_CH4_TRUE_ARRAY(II,JJ,LG) = GC_CH4_TRUE_ARRAY(II,JJ,LG)
|
|
& * ( 1d3 / 16d0 ) / ( AD(II,JJ,LG) * 1d3 / 28.96 )
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
|
|
! Select arbitrary II, JJ and NT value
|
|
II=40
|
|
JJ=JJPAR-10
|
|
NB=100
|
|
RANDOM_GRID(:,:) = 0d0
|
|
RANDOM_GRID(II,JJ) = 1.00
|
|
|
|
! Initialize variables
|
|
GC_PCENTER(:) = 0d0
|
|
GC_PEDGE(:) = 0d0
|
|
GC_AD(:) = 0d0
|
|
GC_CH4_NATIVE(:) = 0d0
|
|
GC_CH4_onMEM(:) = 0d0
|
|
GC_CH4_onMEM_OB(:) = 0d0
|
|
DIFF = 0d0
|
|
FORCE = 0d0
|
|
|
|
|
|
! Fraction of grid box above minimum latitude
|
|
Jfrac = 1.
|
|
IF ( JJ .EQ. JMIN ) Jfrac = Jfrac_min
|
|
|
|
! Determine number of observations in this grid box
|
|
! # obs = box_area * (1-cloud_fraction) * Jfrac / 100
|
|
! divide by 100 because each observation takes up 100 km2
|
|
box_area = GET_AREA_M2( JJ ) * 1d-6 ! [m2] --> [km2]
|
|
cloud_frac = CLDFRC( II, JJ )
|
|
nobs = NINT( ( (1-cloud_frac) * box_area * Jfrac ) / 100. )
|
|
|
|
! Get GEOS-Chem pressure and CH4 column corresponding to this grid box.
|
|
! CH4 in [kg/box] and pressure in [hPa]
|
|
! Get column of pressure centers and CH4 values
|
|
DO LG=1,LLPAR
|
|
|
|
! Pressure centers [hPa]
|
|
GC_PCENTER(LG) = GET_PCENTER(II,JJ,LG)
|
|
|
|
! Pressure edges [hPa]
|
|
GC_PEDGE(LG) = GET_PEDGE(II,JJ,LG)
|
|
|
|
! mass per box [kg]
|
|
GC_AD(LG) = AD(II,JJ,LG)
|
|
|
|
! CH4 values [kg/box] --> [v/v]
|
|
GC_CH4_NATIVE(LG) = ( CHK_STT(II,JJ,LG,1)
|
|
& * (1+PERT(LG)) * XNUMOL(1) ) / ( GC_AD(LG) * XNUMOLAIR )
|
|
|
|
ENDDO
|
|
|
|
|
|
! Number of vertical levels to use in these observations
|
|
! Chop off lowermost levels if
|
|
! GEOS-Chem surface pressure < MEM pressure levels
|
|
nlev = count( PRESSURE_EDGE .LT. GC_PEDGE(1) )
|
|
IF ( nlev .LT. 13 ) nlev = nlev + 1
|
|
lind = LLMEM + 1 - nlev ! minimum vertical index on MEM grid
|
|
|
|
! Get interpolation matrix that maps GEOS-Chem to MEM grid
|
|
GRIDMAP(1:LLPAR, 1:LLMEM) =
|
|
& GET_INTMAP( GC_PEDGE, PRESSURE_EDGE, nlev )
|
|
|
|
if ( LDEBUG ) THEN
|
|
print*,'kjw MAP_GC2MEM, debug'
|
|
print*,'---------------------------------------'
|
|
WRITE(6,'(14F16.8)') 0d0, PRESSURE_EDGE(:)
|
|
DO LG=1,LLPAR
|
|
WRITE(6,'(14F16.8)') GC_PEDGE(LG), GRIDMAP(LG,:)
|
|
ENDDO
|
|
print*,'---------------------------------------'
|
|
endif
|
|
|
|
! Get GEOS-Chem column from "truth" run to make pseudo-observations
|
|
GC_CH4_NATIVE_OB(:) = 0d0
|
|
GC_CH4_NATIVE_OB(:) = GC_CH4_TRUE_ARRAY(II,JJ,:)
|
|
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LG = 1, LLPAR
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'L, GC_PCENTER, GC_CH4_NATIVE,' //
|
|
& 'GC_CH4_NATIVE_OB',
|
|
& LG, GC_PCENTER(LG), GC_CH4_NATIVE(LG),
|
|
& GC_CH4_NATIVE_OB(LG)
|
|
ENDDO
|
|
ENDIF
|
|
299 FORMAT(A50,I3,3F30.12)
|
|
|
|
|
|
! Interpolate GEOS-Chem CH4 column and observation to MEM grid
|
|
! Column in [v/v]
|
|
DO LN = lind, LLMEM
|
|
GC_CH4_onMEM(LN) = 0d0
|
|
GC_CH4_onMEM_OB(LN) = 0d0
|
|
DO LG = 1, LLPAR
|
|
GC_CH4_onMEM(LN) = GC_CH4_onMEM(LN)
|
|
& + GRIDMAP(LG,LN) * GC_CH4_NATIVE(LG)
|
|
GC_CH4_onMEM_OB(LN) = GC_CH4_onMEM_OB(LN)
|
|
& + GRIDMAP(LG,LN) * GC_CH4_NATIVE_OB(LG)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LN = lind, LLMEM
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'LN, PRESSURE, GC_CH4,GC_CH4_OB',
|
|
& LN, PRESSURE(LN), GC_CH4_onMEM(LN),
|
|
& GC_CH4_onMEM_OB(LN)
|
|
ENDDO
|
|
ENDIF
|
|
|
|
!--------------------------------------------------------------
|
|
! Apply MEM observation operator
|
|
!
|
|
! x_hat = x_a + A_k ( x_m - x_a )
|
|
!
|
|
! where
|
|
! x_hat = GC modeled column as seen by MEM [molec/cm2]
|
|
! x_a = MEM apriori column [molec/cm2]
|
|
! x_m = GC modeled column on MEM grid [molec/cm2]
|
|
! A = MEM averaging kernel
|
|
!--------------------------------------------------------------
|
|
|
|
! x_m - x_a for model and "observation"
|
|
! [v/v] --> ln( v/v ) happens here
|
|
DO LN = lind, LLMEM
|
|
GC_CH4_onMEM(LN) =MAX(GC_CH4_onMEM(LN), 1d-10)
|
|
GC_CH4_onMEM_OB(LN)=MAX(GC_CH4_onMEM_OB(LN),1d-10)
|
|
CH4_PERT(LN) =LOG( GC_CH4_onMEM(LN) ) -
|
|
& LOG( CH4_PRIOR(II,JJ,LN) )
|
|
CH4_PERT_OB(LN) =LOG( GC_CH4_onMEM_OB(LN) ) -
|
|
& LOG( CH4_PRIOR(II,JJ,LN) )
|
|
ENDDO
|
|
|
|
! x_a + A_k * ( x_m - x_a ) for model and "observation"
|
|
CH4_HAT(:)=CH4_PERT(:)
|
|
DO LN = lind, LLMEM
|
|
CH4_HAT(LN) = 0d0
|
|
CH4_HAT_OB(LN) = 0d0
|
|
|
|
DO LLN = lind, LLMEM
|
|
CH4_HAT(LN) = CH4_HAT(LN)
|
|
& + AVGKERNEL(LN,LLN) * CH4_PERT(LLN)
|
|
CH4_HAT_OB(LN) = CH4_HAT_OB(LN)
|
|
& + AVGKERNEL(LN,LLN) * CH4_PERT_OB(LLN)
|
|
ENDDO
|
|
CH4_HAT(LN) = CH4_HAT(LN) + LOG( CH4_PRIOR(II,JJ,LN) )
|
|
CH4_HAT_OB(LN) = CH4_HAT_OB(LN) + LOG( CH4_PRIOR(II,JJ,LN) )
|
|
|
|
ENDDO
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LN = lind, LLMEM
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'LN, PRESSURE, CH4_HAT,CH4_HAT_OB',
|
|
& LN, PRESSURE(LN), exp(CH4_HAT(LN)),
|
|
& exp(CH4_HAT_OB(LN))
|
|
WRITE(6,299) 'LN, CH4_HAT,GC_CH4_onMEM,CH4_PRIOR',
|
|
& LN, exp(CH4_HAT(LN)),
|
|
& GC_CH4_onMEM(LN), CH4_PRIOR(II,JJ,LN)
|
|
ENDDO
|
|
ENDIF
|
|
|
|
|
|
! Convert vertical profiles from [ln(vmr)] --> [vmr] before
|
|
! calculating XCH4
|
|
CH4_HAT_EXP = EXP(CH4_HAT)
|
|
CH4_HAT_OB_EXP = EXP(CH4_HAT_OB)
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LN = lind, LLMEM
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'CH4_HAT_EXP, CH4_HAT_EXP, CH4_HAT_OB_EXP',
|
|
& LN, CH4_HAT_EXP(LN), CH4_HAT_EXP(LN), CH4_HAT_OB_EXP(LN)
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! ---- Calculate XCH4 [v/v] from CH4_HAT [v/v] and CH4_HAT_OB [v/v]
|
|
XCH4_HAT = 0d0
|
|
XCH4_HAT_OB = 0d0
|
|
|
|
! Calculate weight of each vertical level on MEM grid for averaging
|
|
! levels to get XCH4. Weight by # molecules / verical level, which is
|
|
! proportional to pressure difference between upper and lower bounds
|
|
! of each box.
|
|
DO LN=lind, LLMEM
|
|
|
|
! If ground level, average with same weight as if it were 1st atm level
|
|
IF ( LN .EQ. lind ) THEN
|
|
PUP = PRESSURE_EDGE(LN+1)
|
|
PLO = PRESSURE_EDGE(LN )
|
|
ELSE
|
|
PUP = PRESSURE_EDGE(LN )
|
|
PLO = PRESSURE_EDGE(LN-1)
|
|
ENDIF
|
|
|
|
Xweight(LN) = PLO - PUP
|
|
ENDDO
|
|
|
|
!Normalize so that SUM(Xweight) = 1
|
|
sumxweight = SUM( Xweight(:) )
|
|
DO LN=lind,LLMEM
|
|
Xweight(LN) = Xweight(LN) / sumxweight
|
|
ENDDO
|
|
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LN=lind,LLMEM
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'Xweight',
|
|
& LN, Xweight(LN), Xweight(LN), Xweight(LN)
|
|
ENDDO
|
|
ENDIF
|
|
|
|
|
|
! Calculate weighted average of CH4_HAT and CH4_HAT_OB
|
|
DO LN=lind, LLMEM
|
|
XCH4_HAT = XCH4_HAT + Xweight(LN) * CH4_HAT_EXP(LN)
|
|
XCH4_HAT_OB = XCH4_HAT_OB + Xweight(LN) * CH4_HAT_OB_EXP(LN)
|
|
ENDDO
|
|
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'XCH4_HAT, XCH4_HAT, XCH4_HAT_OB',
|
|
& 1, XCH4_HAT, XCH4_HAT, XCH4_HAT_OB
|
|
ENDIF
|
|
|
|
|
|
! Create super observation by adding random error
|
|
! to XCH4_HAT_OB
|
|
! SUPER_ERR is 1d-9 * 8ppb * N(0,1) / sqrt(nobs) [v/v]
|
|
! where 8ppb is expected error on a single XCH4 measurement
|
|
! N(0,1) is a random number of mean 0, standard deviation 1
|
|
! nobs is the number of observations merged to form super obs
|
|
! Add error of each observation that makes up super-obs. Do this to
|
|
! preserve error structure across different resolutions.
|
|
SUPER_ERR_EXPECTED = 1d-9 * XCH4_ERR / SQRT( REAL(nobs) )
|
|
|
|
! Multiply expected error of super-observation by
|
|
! prescribed random number with mean 0, standard deviation 1
|
|
SUPER_ERR = SUPER_ERR_EXPECTED * RANDOM_GRID( II, JJ )
|
|
|
|
! Add random error to super-observation
|
|
XCH4_HAT_OB = XCH4_HAT_OB + SUPER_ERR ! add error [v/v]
|
|
|
|
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'XCH4_ERR, SUPER_ERR, nobs',
|
|
& 1, XCH4_ERR, SUPER_ERR, REAL(nobs)
|
|
ENDIF
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'XCH4_HAT_OB, XCH4_HAT_OB, XCH4_HAT_OB',
|
|
& 1, XCH4_HAT_OB, XCH4_HAT_OB, XCH4_HAT_OB
|
|
ENDIF
|
|
|
|
|
|
! ! Add error to create super-observation
|
|
! ! nobs - number observations in this grid box
|
|
! ! boxno - box number processed during this day
|
|
! ! Magnitude of error in super observation
|
|
! SUPER_ERR = 1d0 / SQRT( REAL(nobs) ) * RANDNUM( NB )
|
|
!
|
|
! ! Print information about this grid box to file
|
|
! IF ( SUM(PERT(:)) .EQ. 0. ) THEN
|
|
! WRITE(116,212) 'II = ', REAL(40)
|
|
! WRITE(116,212) 'JJ = ', REAL(JJPAR-10)
|
|
! WRITE(116,212) 'nobs = ', REAL(nobs)
|
|
! WRITE(116,212) 'RANDOM(NB) = ', RANDNUM( NB )
|
|
! WRITE(116,212) 'SUPER_ERR = ', SUPER_ERR
|
|
! ENDIF
|
|
! 212 FORMAT(A12,F22.6)
|
|
!
|
|
! ! Calculate sqrt( obserror ) <-- magnitude of error in 1 observation
|
|
! DO LN = lind, LLMEM
|
|
! DO LLN = lind, LLMEM
|
|
! SIGN(LN,LLN) = OBSERROR(LN,LLN) / ABS( OBSERROR(LN,LLN) )
|
|
! OBSERROR_SQRT(LN,LLN) = SIGN( LN, LLN ) *
|
|
! & SQRT( ABS( OBSERROR(LN,LLN) ) )
|
|
! ENDDO
|
|
! ENDDO
|
|
! print*,'maxval/minval( SIGN ) ', maxval(sign),minval(sign)
|
|
!
|
|
! ! Create super observation
|
|
! CH4_HAT_OB_werr(:) = 0d0
|
|
! DO LN = lind, LLMEM
|
|
! CH4_HAT_OB_werr(LN) = CH4_HAT_OB(LN)
|
|
! DO LLN = lind, LLMEM
|
|
! CH4_HAT_OB_werr(LN) = CH4_HAT_OB_werr(LN) +
|
|
! & CH4_HAT_OB(LN) * SUPER_ERR * OBSERROR_SQRT(LN,LLN)
|
|
! ENDDO
|
|
! ENDDO
|
|
!
|
|
! IF ( LDEBUG ) THEN
|
|
! DO LN = lind, LLMEM
|
|
! DO LLN = lind, LLMEM
|
|
! dummyerr(LN) = CH4_HAT_OB(LN) * OBSERROR_SQRT(LN,LN)
|
|
! ENDDO
|
|
! ENDDO
|
|
! WRITE(6,'(A16,13F18.9)') ,'dummyerr = ', dummyerr(:)
|
|
! WRITE(6,'(A16,13F18.9)') ,'CH4_HAT_OB = ',exp(CH4_HAT_OB(:))
|
|
! WRITE(6,'(A16,13F18.9)') ,'PERT = ',
|
|
! & exp(CH4_HAT_OB(:)+dummyerr(:))
|
|
! ENDIF
|
|
!
|
|
!
|
|
!
|
|
! ! Scale observation error covariance matrix to nobs
|
|
! DO LN = lind, LLMEM
|
|
! DO LLN = lind, LLMEM
|
|
! OBSERROR_INV_SUPER(LN,LLN) =
|
|
! & OBSERROR_INV(LN,LLN) * REAL(nobs)
|
|
! ENDDO
|
|
! ENDDO
|
|
!
|
|
! IF ( LDEBUG ) THEN
|
|
! DO LN = lind, LLMEM
|
|
! WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
! WRITE(6,299) 'LN, PRESSURE, CH4_HAT_OB, CH4_HAT_OB_werr',
|
|
! & LN, PRESSURE(LN),
|
|
! & exp(CH4_HAT_OB(LN)), exp(CH4_HAT_OB_werr(LN))
|
|
! ENDDO
|
|
! ENDIF
|
|
!
|
|
!-------------------------------------------------------------
|
|
! Calculate cost function, given S is observation error covariance matrix
|
|
! Sobs = 1x1 array [ ln(vmr)^2 ]
|
|
! J = [ model - obs ]^T S_{obs}^{-1} [ model - obs ]
|
|
!--------------------------------------------------------------
|
|
|
|
! Initialize values to be safe
|
|
DIFF = 0d0
|
|
FORCE = 0d0
|
|
|
|
! Calculate difference between modeled and observed profile
|
|
DIFF = XCH4_HAT - XCH4_HAT_OB
|
|
|
|
! Calculate adjoint forcing: 2 * DIFF^T * S_{obs}^{-1}
|
|
! and cost function: DIFF^T * S_{obs}^{-1} * DIFF
|
|
S_obs_inv = 1d0 / (SUPER_ERR**2)
|
|
FORCE = 2 * DIFF * S_obs_inv
|
|
NEW_COST(NB) = 0.5d0 * DIFF * FORCE
|
|
|
|
|
|
IF ( LDEBUG ) THEN
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'DIFF, FORCE, NEW_COST(NB)',
|
|
& 1, 1d9*DIFF, 1d9*FORCE, NEW_COST(NB)
|
|
ENDIF
|
|
|
|
! ! Initialize values to be safe
|
|
! DIFF(:) = 0d0
|
|
! FORCE(:) = 0d0
|
|
!
|
|
! ! Calculate difference between modeled and observed profile
|
|
! DO LN = lind, LLMEM
|
|
! DIFF(LN) = CH4_HAT(LN) - CH4_HAT_OB_werr(LN)
|
|
! ENDDO
|
|
!
|
|
! ! Print information about this grid box to file
|
|
! DO LN=lind,LLMEM
|
|
! IF ( LDEBUG ) THEN
|
|
! WRITE(116,213) 'PRESSURE(LN),CH4_HAT(LN),' //
|
|
! & 'CH4_HAT_OB(LN),CH4_PRIOR(LN)',
|
|
! & PRESSURE( LN ), 1d9 * exp(CH4_HAT(LN)),
|
|
! & 1d9 * exp(CH4_HAT_OB_werr(LN)), 1d9 * CH4_PRIOR(II,JJ,LN)
|
|
! ENDIF
|
|
! ENDDO
|
|
! 213 FORMAT(A60,4F22.6)
|
|
!
|
|
!
|
|
! ! Calculate adjoint forcing: 2 * DIFF^T * S_{obs}^{-1}
|
|
! ! and cost function: DIFF^T * S_{obs}^{-1} * DIFF
|
|
! DO LN = lind, LLMEM
|
|
! DO LLN = lind, LLMEM
|
|
! FORCE(LN) = FORCE(LN) +
|
|
! & 2d0 * OBSERROR_INV_SUPER(LN,LLN) * DIFF(LLN)
|
|
! ENDDO
|
|
! NEW_COST(NB) = NEW_COST(NB) + 0.5*DIFF(LN)*FORCE(LN)
|
|
! ENDDO
|
|
!
|
|
!
|
|
!--------------------------------------------------------------
|
|
! Begin adjoint calculations
|
|
!--------------------------------------------------------------
|
|
|
|
|
|
! ! The adjoint forcing is 2 * S_{obs}^{-1} * DIFF = FORCE
|
|
! DIFF_ADJ(:) = FORCE(:)
|
|
!
|
|
! ! Adjoint of GEOS-Chem - Observation difference
|
|
! CH4_HAT_ADJ(:) = DIFF_ADJ(:)
|
|
!
|
|
! ! Adjoint of adding random error to observation
|
|
! DO LN=lind,LLMEM
|
|
! CH4_HAT_ADJ(LN) = 0d0
|
|
!
|
|
! DO LLN=lind,LLMEM
|
|
! CH4_HAT_ADJ(LN) = CH4_HAT_ADJ(LN) +
|
|
! & CH4_HAT_ADJ(LLN) * SUPER_ERR * OBSERROR(LLN,LN)
|
|
! ENDDO
|
|
! ENDDO
|
|
|
|
! The adjoint forcing is 2 * S_{obs}^{-1} * DIFF = FORCE
|
|
DIFF_ADJ = FORCE
|
|
|
|
! Adjoint of GEOS-Chem - Observation difference
|
|
XCH4_HAT_ADJ = DIFF_ADJ
|
|
|
|
! Adjoint of CH4_HAT_EXP --> XCH4_HAT
|
|
DO LN=lind, LLMEM
|
|
CH4_HAT_EXP_ADJ(LN) = XCH4_HAT_ADJ * Xweight(LN)
|
|
ENDDO
|
|
|
|
! Adjoint of CH4_HAT --> CH4_HAT_EXP
|
|
DO LN=lind, LLMEM
|
|
CH4_HAT_ADJ(LN) = CH4_HAT_EXP_ADJ(LN) * CH4_HAT_EXP(LN)
|
|
ENDDO
|
|
|
|
|
|
! Adjoint of MEM observation operator
|
|
CH4_PERT_ADJ(:) = 0D0
|
|
DO LN=lind,LLMEM
|
|
DO LLN=lind,LLMEM
|
|
CH4_PERT_ADJ(LN) = CH4_PERT_ADJ(LN) +
|
|
& AVGKERNEL(LLN,LN) * CH4_HAT_ADJ(LLN)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Adjoint of x_m - x_a
|
|
DO LN = lind, LLMEM
|
|
! fwd code:
|
|
!GC_CH4(LN) = MAX(GC_CH4(LN), 1d-10)
|
|
!CH4_PERT(LN) = LOG(GC_CH4(LN)) - LOG(PRIOR(LN))
|
|
! adj code:
|
|
IF ( GC_CH4_onMEM(LN) > 1d-10 ) THEN
|
|
GC_CH4_onMEM_ADJ(LN) = 1d0 / GC_CH4_onMEM(LN) *
|
|
& CH4_PERT_ADJ(LN)
|
|
ELSE
|
|
GC_CH4_onMEM_ADJ(LN) = 1d0 / 1d-10 * CH4_PERT_ADJ(LN)
|
|
ENDIF
|
|
ENDDO
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LN=lind,LLMEM
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'GC_CH4_onMEM_ADJ, CH4_PERT_ADJ, CH4_HAT_ADJ',
|
|
& LN, GC_CH4_onMEM_ADJ(LN), CH4_PERT_ADJ(LN),
|
|
& CH4_HAT_ADJ(LN)
|
|
ENDDO
|
|
ENDIF
|
|
|
|
|
|
! Adjoint of interpolation
|
|
DO LN=lind,LLMEM
|
|
DO LG=1,LLPAR
|
|
GC_CH4_NATIVE_ADJ(LG) = GC_CH4_NATIVE_ADJ(LG) +
|
|
& GRIDMAP(LG,LN) * GC_CH4_onMEM_ADJ(LN)
|
|
ENDDO
|
|
ENDDO
|
|
|
|
|
|
! Adjoint of unit conversion
|
|
DO LG=1,LLPAR
|
|
GC_CH4_NATIVE_ADJ(LG) = GC_CH4_NATIVE_ADJ(LG)
|
|
& * XNUMOL(1) / ( XNUMOLAIR * GC_AD(LG) )
|
|
ENDDO
|
|
|
|
|
|
! Pass adjoing forcing back to adjoint tracer array
|
|
DO LG=1,LLPAR
|
|
ADJ(LG) = GC_CH4_NATIVE_ADJ(LG) * CHK_STT(II,JJ,LG,1)
|
|
ENDDO
|
|
|
|
IF ( LDEBUG ) THEN
|
|
DO LG=1,LLPAR
|
|
WRITE(6,*) 'kjw DEBUG IN CALC_MEM_FORCE'
|
|
WRITE(6,299) 'GC_CH4_NATIVE_ADJ, ADJ(LG)',
|
|
& LN, GC_CH4_NATIVE_ADJ(LG), ADJ(LG),1
|
|
ENDDO
|
|
ENDIF
|
|
|
|
! Update cost function
|
|
COST_FUNC_A = COST_FUNC_A + NEW_COST(NB)
|
|
|
|
! Only debug on first pass through routine
|
|
LDEBUG = .FALSE.
|
|
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CALC_MEM_CH4_FORCE_FD
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION GET_INTMAP( GC_PEDGE, MEM_PEDGE, nlev )
|
|
& RESULT ( M )
|
|
!
|
|
!******************************************************************************
|
|
! Function GET_INTMAP creates the matrix that places GEOS-Chem column methane
|
|
! [molec/cm2] onto the 13-level pressure grid used by theoretical instrument, M.
|
|
! GC[1x47] * M[47x13] = MEM[1x13] (kjw, 7/21/11)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) GC_PEDGE (REAL*8) : LLPAR bottom pressure edges of GEOS-Chem column
|
|
! (2 ) SCIA_PEDGE (REAL*8) : LLMEM upper pressure edges of MEM column (except
|
|
! first entry, which is surface pressure)
|
|
! (3 ) nlev (REAL*8) : Number of MEM pressure levels to use
|
|
!
|
|
! Arguments as Output:
|
|
! ============================================================================
|
|
! (1 ) M (REAL*8) : Interpolation matrix that maps GEOS-Chem to MEM grid
|
|
!
|
|
! NOTES:
|
|
! (1 ) Based on GET_INTMAP in scia_ch4_mod.f
|
|
!
|
|
!******************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE PRESSURE_MOD, ONLY : GET_BP
|
|
|
|
# include "CMN_SIZE" ! Size params
|
|
|
|
! Arguments
|
|
REAL*8 :: GC_PEDGE(LLPAR)
|
|
REAL*8 :: MEM_PEDGE(LLMEM)
|
|
INTEGER :: nlev
|
|
|
|
! Return value
|
|
REAL*8 :: M(LLPAR,LLMEM)
|
|
|
|
! Local variables
|
|
INTEGER :: LGC, LTM, LS, LG, LN, LIND
|
|
REAL*8 :: DIFF, DELTA_SURFP
|
|
REAL*8 :: GUP, GLO, NUP, NLO
|
|
REAL*8 :: column_total(LLMEM)
|
|
LOGICAL, SAVE :: LDEBUG = .TRUE.
|
|
|
|
!=================================================================
|
|
! GET_INTMAP begins here!
|
|
!=================================================================
|
|
|
|
! Initialize output
|
|
M(:,:) = 0D0
|
|
|
|
! Minimum MEM vertical level to use
|
|
lind = LLMEM + 1 - nlev
|
|
|
|
! Loop over each pressure level of GEOS-Chem and MEM grids
|
|
DO LG=1,LLPAR
|
|
|
|
! Get upper and lower pressure edges of GEOS-Chem box
|
|
IF ( LG .EQ. LLPAR ) THEN
|
|
GUP = 0d0
|
|
GLO = GC_PEDGE( LG )
|
|
ELSE
|
|
GUP = GC_PEDGE( LG+1 )
|
|
GLO = GC_PEDGE( LG )
|
|
ENDIF
|
|
|
|
DO LN=lind,LLMEM
|
|
|
|
! Get top and bottom pressures of MEM box
|
|
! If processing first MEM level, this is surface level, so
|
|
! bottom and top of box are same level. Set "bottom" of
|
|
! MEM box to GEOS-Chem surface pressure so that MEM surface
|
|
! box avgs GEOS-Chem values between GEOS-Chem surface and
|
|
! MEM surface pressures.
|
|
! GC surface pressure is always > MEM surface pressure because
|
|
! we chop off lowermost MEM levels if it is not
|
|
IF ( LN .EQ. lind ) THEN
|
|
NUP = MEM_PEDGE( LN )
|
|
NLO = GC_PEDGE( LG )
|
|
ELSE
|
|
NUP = MEM_PEDGE( LN )
|
|
NLO = MEM_PEDGE( LN-1 )
|
|
ENDIF
|
|
|
|
! If both GEOS-Chem edges are within the MEM box, map value = 1
|
|
IF ( ( GUP .gt. NUP ) .AND. ( GLO .lt. NLO ) ) THEN
|
|
M(LG,LN) = 1
|
|
ENDIF
|
|
|
|
! If both GEOS-Chem stradles a MEM pressure level, interpolate
|
|
IF ( ( GUP .lt. NUP ) .AND. ( GLO .gt. NUP ) ) THEN
|
|
DIFF = GLO - GUP
|
|
M(LG,LN+1) = ( NUP - GUP ) / DIFF
|
|
M(LG,LN ) = ( GLO - NUP ) / DIFF
|
|
ENDIF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Add value for uppermost GEOS-Chem grid box
|
|
M(LLPAR,LLMEM) = 1
|
|
|
|
|
|
! Correct for case in which GEOS-Chem pressure is higher than MEM
|
|
IF ( GC_PEDGE(1) .GT. MEM_PEDGE(1) ) THEN
|
|
|
|
! If any part of GEOS-Chem box are under MEM_PEDGE(1), let
|
|
! this GEOS-Chem grid box contribute to the observation because
|
|
! MEM and GEOS-Chem should have same surface pressure. map value = 1
|
|
DO LG=1,LLPAR-1
|
|
|
|
! If GEOS-Chem box entirely below MEM surface pressure
|
|
IF ( ( GC_PEDGE(LG) .GT. MEM_PEDGE(1) ) .AND.
|
|
& ( GC_PEDGE(LG+1) .GT. MEM_PEDGE(1) ) ) THEN
|
|
M(LG,1) = 1
|
|
ENDIF
|
|
|
|
! If GEOS-Chem box straddles MEM surface pressure
|
|
IF ( ( GC_PEDGE(LG) .GT. MEM_PEDGE(1) ) .AND.
|
|
& ( GC_PEDGE(LG+1) .LT. MEM_PEDGE(1) ) ) THEN
|
|
DIFF = GC_PEDGE(LG) - GC_PEDGE( LG+1 )
|
|
M(LG,1) = ( MEM_PEDGE(1) - GC_PEDGE(LG+1) ) / DIFF
|
|
ENDIF
|
|
|
|
ENDDO
|
|
ENDIF
|
|
|
|
|
|
! Correct for case in which GEOS-Chem surface pressure is within 2nd MEM
|
|
! pressure level.
|
|
IF ( GC_PEDGE(1) .LT. MEM_PEDGE(2) ) THEN
|
|
M(1,1) = 0.
|
|
ENDIF
|
|
! Correct for case in which GEOS-Chem surface pressure is within 3rd MEM
|
|
! pressure level.
|
|
IF ( GC_PEDGE(1) .LT. MEM_PEDGE(3) ) THEN
|
|
M(1,2) = 0.
|
|
ENDIF
|
|
! Correct for case in which GEOS-Chem surface pressure is within 4th MEM
|
|
! pressure level.
|
|
IF ( GC_PEDGE(1) .LT. MEM_PEDGE(4) ) THEN
|
|
M(1,3) = 0.
|
|
ENDIF
|
|
! Correct for case in which GEOS-Chem surface pressure is within 5th MEM
|
|
! pressure level.
|
|
IF ( GC_PEDGE(1) .LT. MEM_PEDGE(5) ) THEN
|
|
M(1,4) = 0.
|
|
ENDIF
|
|
! Correct for case in which GEOS-Chem surface pressure is within 6th MEM
|
|
! pressure level.
|
|
IF ( GC_PEDGE(1) .LT. MEM_PEDGE(6) ) THEN
|
|
M(1,5) = 0.
|
|
ENDIF
|
|
|
|
! Normalize each column of M to 1 so that we are not creating any molecules
|
|
! when mapping from GEOS-Chem to MEM grids.
|
|
|
|
! DO NOT do this since we are mapping molc/cm2, not
|
|
! Initialize to be safe and calculate column total
|
|
column_total(:) = 0d0
|
|
column_total(:) = SUM( M, DIM=1 )
|
|
|
|
! Normalize columns to column_total
|
|
DO LN=1,LLMEM
|
|
IF ( column_total(LN) .EQ. 0. ) CYCLE
|
|
M(:,LN) = M(:,LN) / column_total(LN)
|
|
ENDDO
|
|
|
|
|
|
!if ( LDEBUG ) THEN
|
|
! print*,'kjw GET_INTMAP, debug'
|
|
! print*,'---------------------------------------'
|
|
! WRITE(6,'(14F16.8)') 0d0, MEM_PEDGE(:)
|
|
! DO LG=1,LLPAR
|
|
! WRITE(6,'(14F16.8)') GC_PEDGE(LG), M(LG,:)
|
|
! ENDDO
|
|
! print*,'---------------------------------------'
|
|
! LDEBUG = .FALSE.
|
|
!endif
|
|
|
|
! Return to calling program
|
|
END FUNCTION GET_INTMAP
|
|
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
|
|
|
|
END MODULE MEM_CH4_MOD
|