!$Id: geocape_ch4_mod.f,v 1.1 2012/03/01 22:00:27 daven Exp $ MODULE GEOCAPE_CH4_MOD ! !****************************************************************************** ! Module GEOCAPE_CH4_MOD for GEO-CAPE CH4 observations. ! By kjw, added adj32_023 (dkh, 02/12/12) ! !****************************************************************************** ! IMPLICIT NONE !================================================================= ! MODULE VARIABLES !================================================================= ! Parameters INTEGER, PARAMETER :: LLGEOCAPE = 13 ! 卫星观测的垂直层数 INTEGER, PARAMETER :: MAXGEOCAPE = 639059 ! Record to store information about the new instrument REAL*8 :: AVGKERNEL( LLGEOCAPE, LLGEOCAPE ) REAL*8 :: OBSERROR( LLGEOCAPE, LLGEOCAPE ) REAL*8 :: OBSERROR_INV( LLGEOCAPE, LLGEOCAPE ) REAL*8 :: TOTERROR_INV( LLGEOCAPE, LLGEOCAPE ) REAL*8 :: PRESSURE( LLGEOCAPE ) REAL*8 :: PRESSURE_EDGE( LLGEOCAPE ) REAL*8 :: RANDNUM( MAXGEOCAPE ) ! 保存了随机数的数组 CONTAINS !------------------------------------------------------------------------------ SUBROUTINE READ_GEOCAPE_INFO ! !****************************************************************************** ! Subroutine READ_GEOCAPE_INFO reads and stores information about the new ! instrument, specifically AK, pressure levels and error covariance matrices. ! (kjw, 07/24/11) ! 用于读取卫星观测的数据，保存 AK、气压以及误差协方差矩阵（没有观测值么），应该有观测值 ! Arguments as Input: ! ============================================================================ ! (1 ) FILENAME (CHAR) : GEOCAPE filename to read ! ! ! NOTES: ! (1 ) !****************************************************************************** ! ! Reference to f90 modules USE FILE_MOD, ONLY : IOERROR USE TIME_MOD, ONLY : GET_NYMD ! 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 ! Loop indexes, and error handling. INTEGER :: IOS, IU_IN !================================================================= ! READ_GEOCAPE_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/geocape/' ) // & 'data/' // TRIM( 'geocape_AK.txt' ) WRITE(6,*) ' - READ_GEOCAPE_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,LLGEOCAPE READ( IU_IN, '(13F12.6)', IOSTAT=IOS ) AVGKERNEL(LN,:) ! IO status IF ( IOS < 0 ) THEN WRITE( 6, '(a)' ) 'Unexpected end of file encountered!' WRITE( 6, '(a)' ) 'STOP in READ_GEOCAPE_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/geocape/' ) // & 'data/' // TRIM( 'geocape_obs_error.txt' ) WRITE(6,*) ' - READ_GEOCAPE_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,LLGEOCAPE READ( IU_IN, '(13F18.12)', IOSTAT=IOS ) OBSERROR(LN,:) ! IO status IF ( IOS < 0 ) THEN WRITE( 6, '(a)' ) 'Unexpected end of file encountered!' WRITE( 6, '(a)' ) 'STOP in READ_GEOCAPE_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/geocape/' ) // & 'data/' // TRIM( 'geocape_obs_error_inv.txt' ) WRITE(6,*) ' - READ_GEOCAPE_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,LLGEOCAPE READ( IU_IN, '(13F18.6)', IOSTAT=IOS ) OBSERROR_INV(LN,:) ! IO status IF ( IOS < 0 ) THEN WRITE( 6, '(a)' ) 'Unexpected end of file encountered!' WRITE( 6, '(a)' ) 'STOP in READ_GEOCAPE_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/geocape/' ) // ! & 'data/' // TRIM( 'geocape_total_error_inv.txt' ) ! WRITE(6,*) ' - READ_GEOCAPE_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,LLGEOCAPE ! 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_GEOCAPE_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/geocape/' ) // & 'data/' // TRIM( 'geocape_pressure.txt' ) WRITE(6,*) ' - READ_GEOCAPE_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_GEOCAPE_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(LLGEOCAPE) = 0. DO LN=2,LLGEOCAPE-1 PRESSURE_EDGE(LN) = exp( log(pressure(LN+1)) + & ( log(PRESSURE(LN)) - log(PRESSURE(LN+1)) ) / 2. ) ENDDO ! Return to calling program 还真没有直接读取观测值 END SUBROUTINE READ_GEOCAPE_INFO !------------------------------------------------------------------------------ SUBROUTINE CALC_GEOCAPE_CH4_FORCE( COST_FUNC ) ! !****************************************************************************** ! Subroutine CALC_GEOCAPE_CH4_FORCE calculates the adjoint forcing from the GEOCAPE ! 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 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 ! Local variables INTEGER, SAVE :: NT ! # observations processed this day INTEGER :: LG, LN, LLN, II, JJ, NB, JMIN, OB INTEGER :: nlev, lind, IU_IN INTEGER :: nboxes, nobs INTEGER :: NTSTART, NTSTOP, NTh INTEGER, SAVE :: NTT REAL*8 :: GC_CH4_TRUE_ARRAY(IIPAR,JJPAR,LLPAR) REAL*8 :: CH4_PRIOR(IIPAR,JJPAR,LLGEOCAPE) REAL*4 :: DUMMY_PRIOR(IIPAR,JJPAR,LLGEOCAPE) REAL*4 :: DUMMY_TRUE(IIPAR,JJPAR,LLPAR) 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 :: thispcen(LLPAR) REAL*8 :: thispedg(LLPAR) REAL*8 :: thisad(LLPAR) REAL*8 :: thisch4(LLPAR) REAL*8 :: GC_CH4_onGEOCAPE(LLGEOCAPE) REAL*8 :: GC_CH4_onGEOCAPE_OB(LLGEOCAPE) REAL*8 :: GRIDMAP(LLPAR,LLGEOCAPE) REAL*8 :: CH4_HAT(LLGEOCAPE) REAL*8 :: CH4_HAT_OB(LLGEOCAPE) REAL*8 :: CH4_HAT_ADJ(LLGEOCAPE) REAL*8 :: CH4_HAT_werr(LLGEOCAPE) REAL*8 :: CH4_HAT_werr_ADJ(LLGEOCAPE) REAL*8 :: CH4_PERT(LLGEOCAPE) REAL*8 :: CH4_PERT_OB(LLGEOCAPE) REAL*8 :: CH4_PERT_ADJ(LLGEOCAPE) 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 :: DIFF(LLGEOCAPE) REAL*8 :: FORCE(LLGEOCAPE) REAL*8 :: DIFF_ADJ(LLGEOCAPE) REAL*8 :: thisforce(LLPAR) REAL*8 :: GC_CH4_onGEOCAPE_ADJ(LLGEOCAPE) REAL*8 :: GC_CH4_NATIVE_ADJ(LLPAR) REAL*8 :: NEW_COST(MAXGEOCAPE) REAL*8 :: OLD_COST LOGICAL, SAVE :: FIRST = .TRUE. LOGICAL, SAVE :: DO_FDTEST = .TRUE. INTEGER :: IOS CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=255) :: FILENAME_OBS ! 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_GEOCAPE_CH4_FORCE begins here! !================================================================= NEW_COST(:) = 0d0 ! Open files for output 在第一次运行时会打开相关文件用于输出（？） IF ( FIRST ) THEN FILENAME = 'pres.NN.m' CALL EXPAND_NAME( FILENAME, N_CALC ) ! 替换文件名中的 NN 为迭代次数 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_GEOCAPE_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' ) ! 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/geocape/' // GET_RES_EXT() // '/adjtmp/' // & '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, ! II, JJ, LL 都是维度大小而非坐标 & LLPAR, DUMMY_TRUE , QUIET=.TRUE.) ! DUMMY_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 ! Read a priori vertical profiles from file FILENAME = '/home/kjw/new_satellites/geocape/data/' // & 'geocape_prior.' // GET_RES_EXT() // '.bpch' XTAU = GET_TAU0( 1, 1, 1985 ) CALL READ_BPCH2( FILENAME, 'IJ-AVG-$', 1, & XTAU, IIPAR, JJPAR, & LLGEOCAPE, DUMMY_PRIOR, QUIET=.TRUE. ) CH4_PRIOR(:,:,:) = DUMMY_PRIOR(:,:,:) ! 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 ! ------ Random Numbers ------ ! Open and read random number file. mean = 0, stddev = 1 FILENAME = '/home/kjw/new_satellites/geocape/data/' // & 'randnums/random.YYYYMMDD.txt' CALL EXPAND_DATE( FILENAME, GET_NYMD(), 0 ) OPEN( IU_IN, FILE=TRIM( FILENAME ), STATUS='UNKNOWN', & IOSTAT=IOS, FORM='FORMATTED', ACCESS='SEQUENTIAL' ) DO LG=1,MAXGEOCAPE READ(IU_IN,'(F13.6)') RANDNUM(LG) ENDDO CLOSE(IU_IN) ENDIF ! Begin counter for number of observations processed this hour NTh = 0 ! 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_GEOCAPE_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 obseravations 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_onGEOCAPE(:) = 0d0 GC_CH4_onGEOCAPE_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. ) ! 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 < GEOCAPE pressure levels nlev = count( PRESSURE_EDGE .LT. GC_PEDGE(1) ) IF ( nlev .LT. 13 ) nlev = nlev + 1 lind = LLGEOCAPE + 1 - nlev ! minimum vertical index on GEOCAPE grid 最小气压层的索引 ! Get interpolation matrix that maps GEOS-Chem to GEOCAPE grid GRIDMAP(1:LLPAR, 1:LLGEOCAPE) = & 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 GEOCAPE grid ! Column in [v/v] DO LN = lind, LLGEOCAPE GC_CH4_onGEOCAPE(LN) = 0d0 GC_CH4_onGEOCAPE_OB(LN) = 0d0 DO LG = 1, LLPAR GC_CH4_onGEOCAPE(LN) = GC_CH4_onGEOCAPE(LN) & + GRIDMAP(LG,LN) * GC_CH4_NATIVE(LG) GC_CH4_onGEOCAPE_OB(LN) = GC_CH4_onGEOCAPE_OB(LN) & + GRIDMAP(LG,LN) * GC_CH4_NATIVE_OB(LG) ENDDO ENDDO !-------------------------------------------------------------- ! Apply GEOCAPE observation operator ! ! x_hat = x_a + A_k ( x_m - x_a ) ! ! where ! x_hat = GC modeled column as seen by GEOCAPE [molec/cm2] ! x_a = GEOCAPE apriori column [molec/cm2] ! x_m = GC modeled column on GEOCAPE grid [molec/cm2] ! A = GEOCAPE averaging kernel !-------------------------------------------------------------- ! x_m - x_a for model and "observation" ! [v/v] --> ln( v/v ) happens here DO LN = lind, LLGEOCAPE GC_CH4_onGEOCAPE(LN) =MAX(GC_CH4_onGEOCAPE(LN), 1d-10) GC_CH4_onGEOCAPE_OB(LN)=MAX(GC_CH4_onGEOCAPE_OB(LN),1d-10) CH4_PERT(LN) =LOG( GC_CH4_onGEOCAPE(LN) ) - & LOG( CH4_PRIOR(II,JJ,LN) ) CH4_PERT_OB(LN) =LOG( GC_CH4_onGEOCAPE_OB(LN) ) - & LOG( CH4_PRIOR(II,JJ,LN) ) ENDDO ! x_a + A_k * ( x_m - x_a ) for model and "observation" DO LN = lind, LLGEOCAPE CH4_HAT(LN) = 0d0 CH4_HAT_OB(LN) = 0d0 DO LLN = lind, LLGEOCAPE 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 ! Loop over number of observations in this grid box DO OB=1,NOBS ! Increment number of observations NTh = NTh + 1 ! processed this hour NT = NT + 1 ! processed today NTT = NTT + 1 ! processed total !print*, ' - CALC_GEOCAPE_CH4_FORCE ', OB, ' of ',NOBS ! For safety, initialize these up to LLGEOCAPE CH4_HAT_werr(:) = 0d0 DIFF(:) = 0d0 FORCE(:) = 0d0 NEW_COST(:) = 0d0 ! Add random error to this observation DO LN = lind, LLGEOCAPE CH4_HAT_werr(LN) = CH4_HAT(LN) DO LLN = lind, LLGEOCAPE CH4_HAT_werr(LN) = CH4_HAT_werr(LN) + & CH4_HAT(LN) * RANDNUM(NT) * OBSERROR(LN,LLN) ENDDO ENDDO !-------------------------------------------------------------- ! Calculate cost function, given S is observation error covariance matrix ! Sobs = 1x1 array [ (molec/cm2) ^2 ] ! J = [ model - obs ]^T S_{obs}^{-1} [ model - obs ] !-------------------------------------------------------------- ! Calculate difference between modeled and observed profile DO LN = lind, LLGEOCAPE DIFF(LN) = CH4_HAT_werr(LN) - CH4_HAT_OB(LN) ENDDO ! Calculate adjoint forcing: 2 * DIFF^T * S_{obs}^{-1} ! and cost function: DIFF^T * S_{obs}^{-1} * DIFF DO LN = lind, LLGEOCAPE DO LLN = lind, LLGEOCAPE FORCE(LN) = FORCE(LN) + & 2d0 * OBSERROR_INV(LN,LLN) * DIFF(LLN) ENDDO NEW_COST(LN) = NEW_COST(LN) + 0.5*DIFF(LN)*FORCE(LN) ENDDO !-------------------------------------------------------------- ! Begin adjoint calculations !-------------------------------------------------------------- ! dkh debug ! print*, 'DIFF , FORCE, Sobs ' ! WRITE(6,102) (DIFF, FORCE, Sobs) ! 102 FORMAT(1X,d14.6,1X,d14.6) ! The adjoint forcing is 2 * S_{obs}^{-1} * DIFF = FORCE DIFF_ADJ(:) = 2. * FORCE(:) ! Adjoint of GEOS-Chem - Observation difference CH4_HAT_werr_ADJ(:) = DIFF_ADJ(:) ! Adjoint of adding random error to observation DO LN=lind,LLGEOCAPE CH4_HAT_ADJ(LN) = 0d0 DO LLN=lind,LLGEOCAPE CH4_HAT_ADJ(LN) = CH4_HAT_ADJ(LN) + & CH4_HAT_ADJ(LLN) * RANDNUM(NT) * OBSERROR(LLN,LN) ENDDO ENDDO ! Adjoint of GEOCAPE observation operator DO LN=lind,LLGEOCAPE CH4_PERT_ADJ(LN) = 0D0 DO LLN=lind,LLGEOCAPE 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, LLGEOCAPE ! 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_onGEOCAPE(LN) > 1d-10 ) THEN GC_CH4_onGEOCAPE_ADJ(LN) = 1d0 / GC_CH4_onGEOCAPE(LN) * & CH4_PERT_ADJ(LN) ELSE GC_CH4_onGEOCAPE_ADJ(LN) = 1d0 / 1d-10 * CH4_PERT_ADJ(LN) ENDIF ENDDO ! Adjoint of interpolation DO LN=lind,LLGEOCAPE DO LG=1,LLPAR GC_CH4_NATIVE_ADJ(LG) = GC_CH4_NATIVE_ADJ(LG) + & GRIDMAP(LG,LN) * GC_CH4_onGEOCAPE_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 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 + SUM(NEW_COST(:)) ENDDO ! End looping over each observation in this grid box ENDDO ! End looping over each grid box JJ ENDDO ! End looping over each grid box II !!$OMP END PARALLEL DO ! ----------------------------------------------------------------------- ! Use this section to test the adjoint of the GEOCAPE_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_GEOCAPE_CH4_FORCE_FD( COST_FUNC_0, PERT, ADJ ) ADJ_SAVE(:) = ADJ(:) DO LN=lind,LLGEOCAPE DOFS = DOFS + AVGKERNEL(LN,LN) ENDDO ! Write identifying information to top of satellite diagnostic file WRITE(116,212) 'COST_FUNC_0:',( COST_FUNC_0 ) WRITE(116,212) 'RANDOM ERROR',RANDNUM(NT) WRITE(116,212) 'DOFS ',DOFS !WRITE(116,*) (AVGKERNEL(1,LN),LN=1,13) !WRITE(116,*) (OBSERROR(1,LN),LN=1,13) ! 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_GEOCAPE_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_GEOCAPE_CH4_FORCE_FD( COST_FUNC_neg, PERT, ADJ ) ! Calculate dJ/dCH4 from perturbations FD_CEN(LG) = ( COST_FUNC_pos - COST_FUNC_neg ) / 0.2d0 FD_POS(LG) = ( COST_FUNC_pos - COST_FUNC_0 ) / 0.1d0 FD_NEG(LG) = ( COST_FUNC_0 - COST_FUNC_neg ) / 0.1d0 ! 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*, ' GEOCAPE 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_GEOCAPE_CH4_FORCE !------------------------------------------------------------------------------ SUBROUTINE CALC_GEOCAPE_CH4_FORCE_FD( COST_FUNC_A, PERT, ADJ ) ! !****************************************************************************** ! Subroutine CALC_GEOCAPE_CH4_FORCE calculates the adjoint forcing from the GEOCAPE ! 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 :: NT INTEGER :: LG, LN, LLN, II, JJ, NB, JMIN, OB INTEGER :: nlev, lind, IU_IN INTEGER :: nboxes, nobs INTEGER :: NTSTART, NTSTOP REAL*8 :: GC_CH4_TRUE_ARRAY(IIPAR,JJPAR,LLPAR) REAL*8 :: CH4_PRIOR(IIPAR,JJPAR,LLGEOCAPE) REAL*4 :: DUMMY_PRIOR(IIPAR,JJPAR,LLGEOCAPE) REAL*4 :: DUMMY_TRUE(IIPAR,JJPAR,LLPAR) 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 :: thispcen(LLPAR) REAL*8 :: thispedg(LLPAR) REAL*8 :: thisad(LLPAR) REAL*8 :: thisch4(LLPAR) REAL*8 :: GC_CH4_onGEOCAPE(LLGEOCAPE) REAL*8 :: GC_CH4_onGEOCAPE_OB(LLGEOCAPE) REAL*8 :: GRIDMAP(LLPAR,LLGEOCAPE) REAL*8 :: CH4_HAT(LLGEOCAPE) REAL*8 :: CH4_HAT_OB(LLGEOCAPE) REAL*8 :: CH4_HAT_ADJ(LLGEOCAPE) REAL*8 :: CH4_HAT_werr(LLGEOCAPE) REAL*8 :: CH4_HAT_werr_ADJ(LLGEOCAPE) REAL*8 :: CH4_PERT(LLGEOCAPE) REAL*8 :: CH4_PERT_OB(LLGEOCAPE) REAL*8 :: CH4_PERT_ADJ(LLGEOCAPE) 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 :: DIFF(LLGEOCAPE) REAL*8 :: FORCE(LLGEOCAPE) REAL*8 :: DIFF_ADJ(LLGEOCAPE) REAL*8 :: thisforce(LLPAR) REAL*8 :: GC_CH4_onGEOCAPE_ADJ(LLGEOCAPE) REAL*8 :: GC_CH4_NATIVE_ADJ(LLPAR) REAL*8 :: NEW_COST(MAXGEOCAPE) REAL*8 :: OLD_COST LOGICAL, SAVE :: FIRST = .TRUE. LOGICAL, SAVE :: DO_FDTEST = .TRUE. INTEGER :: IOS CHARACTER(LEN=255) :: FILENAME CHARACTER(LEN=255) :: FILENAME_OBS !================================================================= ! CALC_GEOCAPE_CH4_FORCE_FD begins here! !================================================================= print*, ' - CALC_GEOCAPE_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/geocape/' // 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 ! Read a priori vertical profiles from file 读取先验廓线 FILENAME = '/home/kjw/new_satellites/geocape/data/' // & 'geocape_prior.' // GET_RES_EXT() // '.bpch' XTAU = GET_TAU0( 1, 1, 1985 ) CALL READ_BPCH2( FILENAME, 'IJ-AVG-$', 1, & XTAU, IGLOB, JGLOB, & LLGEOCAPE, DUMMY_PRIOR, QUIET=.TRUE. ) CH4_PRIOR(:,:,:) = DUMMY_PRIOR(:,:,:) ! 给先验廓线赋值 ! Select arbitrary II, JJ and NT value 为什么这里的数值都直接给定了 II=40 JJ=JJPAR-10 NT=100 ! Initialize variables 初始化相关的数组 GC_PCENTER(:) = 0d0 GC_PEDGE(:) = 0d0 GC_AD(:) = 0d0 GC_CH4_NATIVE(:) = 0d0 GC_CH4_onGEOCAPE(:) = 0d0 GC_CH4_onGEOCAPE_OB(:) = 0d0 CH4_HAT_werr(:) = 0d0 DIFF(:) = 0d0 FORCE(:) = 0d0 ! 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 < GEOCAPE pressure levels nlev = count( PRESSURE_EDGE .LT. GC_PEDGE(1) ) IF ( nlev .LT. 13 ) nlev = nlev + 1 lind = LLGEOCAPE + 1 - nlev ! minimum vertical index on GEOCAPE grid 垂直层相关 ! Get interpolation matrix that maps GEOS-Chem to GEOCAPE grid GRIDMAP(1:LLPAR, 1:LLGEOCAPE) = & 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 GEOCAPE grid ! Column in [v/v] 在垂直上进行循环, 进行插值 DO LN = lind, LLGEOCAPE GC_CH4_onGEOCAPE(LN) = 0d0 GC_CH4_onGEOCAPE_OB(LN) = 0d0 DO LG = 1, LLPAR GC_CH4_onGEOCAPE(LN) = GC_CH4_onGEOCAPE(LN) & + GRIDMAP(LG,LN) * GC_CH4_NATIVE(LG) GC_CH4_onGEOCAPE_OB(LN) = GC_CH4_onGEOCAPE_OB(LN) & + GRIDMAP(LG,LN) * GC_CH4_NATIVE_OB(LG) ENDDO ENDDO !-------------------------------------------------------------- ! Apply GEOCAPE observation operator ! ! x_hat = x_a + A_k ( x_m - x_a ) ! ! where ! x_hat = GC modeled column as seen by GEOCAPE [molec/cm2] ! x_a = GEOCAPE apriori column [molec/cm2] ! x_m = GC modeled column on GEOCAPE grid [molec/cm2] ! A = GEOCAPE averaging kernel !-------------------------------------------------------------- ! x_m - x_a for model and "observation" 以下部分似乎是在计算模式柱浓度 ! [v/v] --> ln( v/v ) happens here 这部分是在观测垂直层上计算的 DO LN = lind, LLGEOCAPE GC_CH4_onGEOCAPE(LN) =MAX(GC_CH4_onGEOCAPE(LN), 1d-10) GC_CH4_onGEOCAPE_OB(LN)=MAX(GC_CH4_onGEOCAPE_OB(LN),1d-10) CH4_PERT(LN) =LOG( GC_CH4_onGEOCAPE(LN) ) - & LOG( CH4_PRIOR(II,JJ,LN) ) CH4_PERT_OB(LN) =LOG( GC_CH4_onGEOCAPE_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, LLGEOCAPE CH4_HAT(LN) = 0d0 CH4_HAT_OB(LN) = 0d0 DO LLN = lind, LLGEOCAPE 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 ! For safety, initialize these up to LLGEOCAPE ! Add random error to this observation 给观测增加随机误差 CH4_HAT_werr(:) = CH4_HAT(:) DO LN = lind, LLGEOCAPE CH4_HAT_werr(LN) = CH4_HAT(LN) DO LLN = lind, LLGEOCAPE CH4_HAT_werr(LN) = CH4_HAT_werr(LN) + & CH4_HAT(LN) * RANDNUM(NT) * OBSERROR(LN,LLN) ENDDO ENDDO !------------------------------------------------------------- ! Calculate cost function, given S is observation error covariance matrix ! Sobs = 1x1 array [ (molec/cm2) ^2 ] ! J = [ model - obs ]^T S_{obs}^{-1} [ model - obs ] !-------------------------------------------------------------- ! Calculate difference between modeled and observed profile 计算差分部分 DO LN = lind, LLGEOCAPE DIFF(LN) = CH4_HAT_werr(LN) - CH4_HAT_OB(LN) ENDDO ! 因为卫星垂直上各层的误差存在相关性, 所以最终每层都要处理与其他各层之间的关联 ! Calculate adjoint forcing: 2 * DIFF^T * S_{obs}^{-1} 计算伴随强迫 ! and cost function: DIFF^T * S_{obs}^{-1} * DIFF 代价函数就是距离 DO LN = lind, LLGEOCAPE ! 在垂直上进行循环 DO LLN = lind, LLGEOCAPE ! 继续在垂直上进行循环? FORCE(LN) = FORCE(LN) + ! 伴随强迫的每一层都加上了该层与其他层之间的协方差 & 2d0 * OBSERROR_INV(LN,LLN) * DIFF(LLN) ENDDO NEW_COST(LN) = NEW_COST(LN) + 0.5*DIFF(LN)*FORCE(LN) ENDDO ! 也就是说, 这部分是将有限差分作为切线性算子的替代, 计算相关参数 !-------------------------------------------------------------- ! Begin adjoint calculations 开始计算伴随部分 !-------------------------------------------------------------- ! 整理以下这部分就是: FORCE = DIFF = CH4_HAT_werr_ADJ = CH4_HAT_ADJ ! The adjoint forcing is 2 * S_{obs}^{-1} * DIFF = FORCE DIFF_ADJ(:) = FORCE(:) ! 差分的伴随就是伴随强迫 ! Adjoint of GEOS-Chem - Observation difference CH4_HAT_werr_ADJ(:) = DIFF_ADJ(:) ! 观测模拟差的伴随 ! Adjoint of adding random error to observation 随机观测误差的伴随 DO LN=lind,LLGEOCAPE CH4_HAT_ADJ(LN) = 0d0 ! 初始化为 0 DO LLN=lind,LLGEOCAPE ! 考虑协方差, 计算最终误差 CH4_HAT_ADJ(LN) = CH4_HAT_ADJ(LN) + & CH4_HAT_werr_ADJ(LLN) * RANDNUM(NT) * OBSERROR(LLN,LN) ENDDO ENDDO CH4_HAT_ADJ(:) = CH4_HAT_werr_ADJ(:) ! 那你这上面计算的有什么意义 ! Adjoint of GEOCAPE observation operator 观测算子的伴随 CH4_PERT_ADJ(:) = CH4_HAT_ADJ(:) DO LN=lind,LLGEOCAPE CH4_PERT_ADJ(LN) = 0D0 ! 又给初始化了, 那上面的赋值有啥意义 DO LLN=lind,LLGEOCAPE ! 反正和协方差计算相关, 累积 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, LLGEOCAPE ! 对于观测垂直层进行循环 ! fwd code: 看上去这边是针对正向模拟写的, 因为正向模拟这边存在范围限制 !GC_CH4(LN) = MAX(GC_CH4(LN), 1d-10) 限制了最小值为 1e-10 !CH4_PERT(LN) = LOG(GC_CH4(LN)) - LOG(PRIOR(LN)) ! adj code: IF ( GC_CH4_onGEOCAPE(LN) > 1d-10 ) THEN GC_CH4_onGEOCAPE_ADJ(LN) = 1d0 / GC_CH4_onGEOCAPE(LN) * & CH4_PERT_ADJ(LN) ELSE GC_CH4_onGEOCAPE_ADJ(LN) = 1d0 / 1d-10 * CH4_PERT_ADJ(LN) ENDIF ENDDO ! Adjoint of interpolation 插值还需要伴随的么 DO LN=lind,LLGEOCAPE ! LN 是观测的垂直层 DO LG=1,LLPAR ! LG 是模式的垂直层 GC_CH4_NATIVE_ADJ(LG) = GC_CH4_NATIVE_ADJ(LG) + & GRIDMAP(LG,LN) * GC_CH4_onGEOCAPE_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 ! Update cost function 更新代价函数 COST_FUNC_A = COST_FUNC_A + SUM(NEW_COST(:)) ! Return to calling program END SUBROUTINE CALC_GEOCAPE_CH4_FORCE_FD !------------------------------------------------------------------------------ FUNCTION GET_INTMAP( GC_PEDGE, GEOCAPE_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] = GEOCAPE[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) : LLGEOCAPE pressure edges of GEOCAPE column ! (3 ) nlev (REAL*8) : Number of GEOCAPE pressure levels to use ! ! Arguments as Output: ! ============================================================================ ! (1 ) M (REAL*8) : Interpolation matrix that maps GEOS-Chem to GEOCAPE 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 :: GEOCAPE_PEDGE(LLGEOCAPE) INTEGER :: nlev ! Return value REAL*8 :: M(LLPAR,LLGEOCAPE) ! Local variables INTEGER :: LGC, LTM, LS, LG, LN, LIND REAL*8 :: DIFF, DELTA_SURFP REAL*8 :: GUP, GLO, NUP, NLO REAL*8 :: column_total(LLGEOCAPE) !================================================================= ! GET_INTMAP begins here! !================================================================= ! Initialize output M(:,:) = 0D0 ! Minimum GEOCAPE vertical level to use lind = LLGEOCAPE + 1 - nlev ! Loop over each pressure level of GEOS-Chem and GEOCAPE grids DO LG=1,LLPAR-1 ! Get upper and lower pressure edges of GEOS-Chem box GUP = GC_PEDGE( LG+1 ) GLO = GC_PEDGE( LG ) DO LN=lind,LLGEOCAPE-1 ! Get top and bottom pressures of GEOCAPE box NUP = GEOCAPE_PEDGE( LN+1 ) NLO = GEOCAPE_PEDGE( LN ) ! If both GEOS-Chem edges are within the GEOCAPE box, map value = 1 IF ( ( GUP .gt. NUP ) .AND. ( GLO .lt. NLO ) ) THEN M(LG,LN) = 1 ENDIF ! If both GEOS-Chem stradles a GEOCAPE 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,LLGEOCAPE) = 1 ! Correct for case in which GEOS-Chem pressure is higher than GEOCAPE IF ( GC_PEDGE(1) .GT. GEOCAPE_PEDGE(1) ) THEN ! If any part of GEOS-Chem box are under GEOCAPE_PEDGE(1), let ! this GEOS-Chem grid box contribute to the observation because ! GEOCAPE and GEOS-Chem should have same surface pressure. map value = 1 DO LG=1,LLPAR-1 ! If GEOS-Chem box entirely below GEOCAPE surface pressure IF ( ( GC_PEDGE(LG) .GT. GEOCAPE_PEDGE(1) ) .AND. & ( GC_PEDGE(LG+1) .GT. GEOCAPE_PEDGE(1) ) ) THEN M(LG,1) = 1 ENDIF ! If GEOS-Chem box straddles GEOCAPE surface pressure IF ( ( GC_PEDGE(LG) .GT. GEOCAPE_PEDGE(1) ) .AND. & ( GC_PEDGE(LG+1) .LT. GEOCAPE_PEDGE(1) ) ) THEN DIFF = GC_PEDGE(LG) - GC_PEDGE( LG+1 ) M(LG,1) = ( GEOCAPE_PEDGE(1) - GC_PEDGE(LG+1) ) / DIFF ENDIF ENDDO ENDIF ! Correct for case in which GEOS-Chem surface pressure is within 2nd GEOCAPE ! pressure level. IF ( GC_PEDGE(1) .LT. GEOCAPE_PEDGE(2) ) THEN M(1,1) = 0. ENDIF ! Correct for case in which GEOS-Chem surface pressure is within 3rd GEOCAPE ! pressure level. IF ( GC_PEDGE(1) .LT. GEOCAPE_PEDGE(3) ) THEN M(1,2) = 0. ENDIF ! Correct for case in which GEOS-Chem surface pressure is within 4th GEOCAPE ! pressure level. IF ( GC_PEDGE(1) .LT. GEOCAPE_PEDGE(4) ) THEN M(1,3) = 0. ENDIF ! Correct for case in which GEOS-Chem surface pressure is within 5th GEOCAPE ! pressure level. IF ( GC_PEDGE(1) .LT. GEOCAPE_PEDGE(5) ) THEN M(1,4) = 0. ENDIF ! Correct for case in which GEOS-Chem surface pressure is within 6th GEOCAPE ! pressure level. IF ( GC_PEDGE(1) .LT. GEOCAPE_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 GEOCAPE 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,LLGEOCAPE IF ( column_total(LN) .EQ. 0. ) CYCLE M(:,LN) = M(:,LN) / column_total(LN) ENDDO ! Return to calling program END FUNCTION GET_INTMAP !----------------------------------------------------------------------------- END MODULE GEOCAPE_CH4_MOD