1707 lines
57 KiB
Fortran
1707 lines
57 KiB
Fortran
! $Id: omi_so2_obs_mod.f
|
|
MODULE OMI_SO2_OBS_MOD
|
|
!
|
|
!*****************************************************************************
|
|
! MODULE OMI_SO2_OBS_MOD contians subroutines necessary to
|
|
! 1. Read OMI L3 SO2 observations
|
|
! 2. Compute OMI-GEOS-Chem difference, cost function, and adjoint
|
|
! forcing
|
|
!
|
|
! (ywang (yi.wang@huskers.unl.edu), 07/16/04)
|
|
!
|
|
! Module Variables:
|
|
! ===========================================================================
|
|
!
|
|
! Module Routines:
|
|
! ===========================================================================
|
|
! ( 1) CALC_OMI_SO2_FORCE
|
|
! ( 2) CHECK : Check status for calling netCDF
|
|
! ( 1) INIT_OMI_SO2_OBS : Initialize OMI SO2 observation operator
|
|
! ( 3) WRITE_GC_OMI_SO2_OBS
|
|
! ( 4) READ_GC_OMI_SO2_OBS
|
|
! ( 5) MAKE_CURRENT_OMI_SO2 :
|
|
! ( ) MAKE_AVERAGE_OMI_SO2 :
|
|
!
|
|
! ===========================================================================
|
|
! NOTES:
|
|
! ( 1) The original OMI L3 SO2 HDFEOS5 data are preprocessed by
|
|
! IDL code OMI_SO2_L3_preprocess.pro. Quality control is done through
|
|
! the IDL code.
|
|
! ( 2) OMI L3 SO2 contains ColumnAmountSO2_PBL (Center Mass of
|
|
! Alitude = 0.9km), ColumnAmountSO2_TRL (CMA = 2.5km), ColumnAmountSO2_TRM
|
|
! (CMA = 7.5km), and ColumnAmountSO2_STL (CMA = 17km). Only the first
|
|
! three are used in the observation operatpor. The prior GEOS-Chem CMA
|
|
! (where SO2 peaks in the vertical column) is calculated. We choose the
|
|
! observation whose CMA is closest to GEOS-Chem CMA to be assimilated.
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
! Header files
|
|
# include "define.h"
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
!=================================================================
|
|
! MODULE PRIVATE DECLARATIONS -- keep centain internal variables
|
|
! and routines from being seen outside "omi_so2_obs_mod.f"
|
|
!=================================================================
|
|
|
|
! Make everything PRIVATE...
|
|
PRIVATE
|
|
|
|
! ... except these routines
|
|
PUBLIC :: CALC_OMI_SO2_FORCE
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
|
|
! Parameters
|
|
CHARACTER(LEN=255) :: FILENAME = 'OMI_L3_SO2_grid_YYYYMMDD.nc'
|
|
INTEGER, PARAMETER :: TIME_WINDOW = 60 ! (units: min)
|
|
|
|
! Variables
|
|
|
|
! Recored to store OMI SO2 observations
|
|
TYPE OMI_SO2_OBS
|
|
REAL :: LON ! Latitude (units: degree)
|
|
REAL :: LAT ! Longitude (units: dgeree)
|
|
REAL*8 :: TIME ! Time at start of scan (TAI93) (units: s)
|
|
REAL*8 :: SO2_PBL ! ColumnAmountSO2_PBL (units: DU)
|
|
REAL*8 :: SO2_TRL ! ColumnAmountSO2_TRL (units: DU)
|
|
REAL*8 :: SO2_TRM ! ColumnAmountSO2_TRM (units: DU)
|
|
REAL*8 :: SO2 ! OMI SO2 whose CMA is closest to GEOS-Chem CMA (units: DU)
|
|
REAL*8 :: ERR_PBL ! SO2_PBL error (units: DU)
|
|
REAL*8 :: ERR_TRL ! SO2_TRL error (units: DU)
|
|
REAL*8 :: ERR_TRM ! SO2_TRM error (units: DU)
|
|
REAL*8 :: ERR ! SO2 error (units: DU)
|
|
! INTEGER :: MARK ! Mark of which observation is expected. 0: No observation, 1: PBL, 2: TRL, 3: TRM
|
|
INTEGER :: OPT ! Mark of which observation whose CMA is close to GEOS-Chem CMA, though the observation may not exists
|
|
INTEGER :: FLAG ! Does the observation expected really exits?
|
|
ENDTYPE OMI_SO2_OBS
|
|
|
|
TYPE(OMI_SO2_OBS), ALLOCATABLE :: OMI_SO2(:)
|
|
|
|
LOGICAL, ALLOCATABLE :: FLAGS(:)
|
|
|
|
REAL*8 :: CURR_GC_SO2(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_PBL_SO2(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_TRL_SO2(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_TRM_SO2(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_SO2(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_DIFF_SO2(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_FORCING(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_COST(IIPAR, JJPAR)
|
|
REAL*8 :: CURR_CMA(IIPAR, JJPAR)
|
|
INTEGER :: CURR_COUNT(IIPAR, JJPAR) ! number of observations in current time window
|
|
INTEGER :: CURR_PBL_C(IIPAR, JJPAR) ! number of PBL observations used in current time window
|
|
INTEGER :: CURR_TRL_C(IIPAR, JJPAR) ! number of TRL observations used in current time window
|
|
INTEGER :: CURR_TRM_C(IIPAR, JJPAR) ! numberof TRM observations used in current time window
|
|
INTEGER :: CURR_OPT(IIPAR, JJPAR) !
|
|
|
|
REAL*8 :: ALL_GC_SO2(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_PBL_SO2(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_TRL_SO2(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_TRM_SO2(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_SO2(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_DIFF_SO2(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_FORCING(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_COST(IIPAR, JJPAR) = 0D0
|
|
REAL*8 :: ALL_CMA(IIPAR, JJPAR) = 0D0
|
|
INTEGER :: ALL_COUNT(IIPAR, JJPAR) = 0 ! number of observations in simulation time
|
|
INTEGER :: ALL_PBL_C(IIPAR, JJPAR) = 0
|
|
INTEGER :: ALL_TRL_C(IIPAR, JJPAR) = 0
|
|
INTEGER :: ALL_TRM_C(IIPAR, JJPAR) = 0
|
|
INTEGER :: ALL_OPT(IIPAR, JJPAR) = 0 ! number of "best" observations used
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAIN" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE INIT_OMI_SO2_OBS
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine INIT_OMI_SO2_OBS initialize the OMI SO2 observation
|
|
! ( 1) Check if SO2 observation is specified by the adjoint input
|
|
! files
|
|
! (ywang, 07/16/14)
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE TRACER_MOD, ONLY : TRACER_NAME
|
|
USE TRACERID_MOD, ONLY : IDTSO2
|
|
USE ADJ_ARRAYS_MOD, ONLY : OBS_THIS_TRACER
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
|
|
!=================================================================
|
|
! INIT_OMI_SO2_OBS begins here!
|
|
!=================================================================
|
|
|
|
IF ( OBS_THIS_TRACER(IDTSO2) ) THEN
|
|
|
|
WRITE( 6, 100 ) IDTSO2, TRACER_NAME(IDTSO2)
|
|
|
|
ELSE
|
|
|
|
CALL ERROR_STOP( 'Error: Obs SO2 tracer is not specified in
|
|
&OBSERVATION MENU in input.gcadj',
|
|
& 'INIT_OMI_SO2_OBS (omi_so2_obs_mod.f)' )
|
|
|
|
END IF
|
|
|
|
100 FORMAT( 3X, 'Tracer ID: ', I4, 'Use OMI L3 ', A6 )
|
|
|
|
! Return to the calling routine
|
|
END SUBROUTINE INIT_OMI_SO2_OBS
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE READ_GC_OMI_SO2_OBS( YYYYMMDD, N_SO2 )
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine READ_OMI_SO2_OBS read OMI SO2 data preprocessed by
|
|
! OMI_SO2_L3_preprocess.pro if N_CALC > 1 (ref: note 1) or
|
|
! observations whose CMA are close to GEOS-Chem CMA if N_CALC == 1
|
|
! (ref: note 2)
|
|
! (ywang, 07/16/14)
|
|
!
|
|
! Arguements as Input:
|
|
! ===========================================================================
|
|
! ( 1) YYYYMMDD (INTEGER) : Current year-month-day
|
|
! Arguements as Output:
|
|
! ===========================================================================
|
|
! ( 1) N_SO2 (INTEGER) : Number of OMI SO2 observations for
|
|
! current day
|
|
!
|
|
! Module variable as Output:
|
|
! ===========================================================================
|
|
! ( 1) OMI_SO2 (OMI_SO2_OBS) : OMI SO2 observations
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
|
|
USE NETCDF
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_NYMD
|
|
|
|
! Arguements
|
|
INTEGER, INTENT( IN) :: YYYYMMDD
|
|
INTEGER, INTENT(OUT) :: N_SO2
|
|
|
|
! Local variables
|
|
INTEGER :: FID, N_ID
|
|
INTEGER :: LON_ID, LAT_ID, TIME_ID
|
|
INTEGER :: SO2_PBL_ID, SO2_TRL_ID, SO2_TRM_ID
|
|
INTEGER :: SO2_ID
|
|
INTEGER :: ERR_PBL_ID, ERR_TRL_ID, ERR_TRM_ID
|
|
INTEGER :: ERR_ID
|
|
! INTEGER :: MARK_ID
|
|
INTEGER :: OPT_ID ! (ywang, 09/12/14)
|
|
INTEGER :: FLAG_ID ! (ywang, 09/12/14)
|
|
CHARACTER(LEN=255) :: DIR
|
|
CHARACTER(LEN=255) :: READ_FILENAME
|
|
CHARACTER(LEN=4) :: TMP
|
|
INTEGER, ALLOCATABLE :: TMPINT(:)
|
|
REAL*4, ALLOCATABLE :: TMP4(:)
|
|
REAL*8, ALLOCATABLE :: TMP8(:)
|
|
LOGICAL :: LF
|
|
|
|
!=================================================================
|
|
! READ_OMI_SO2_OBS begins here!
|
|
!=================================================================
|
|
|
|
! Filename root
|
|
IF (N_CALC ==1 ) THEN
|
|
|
|
READ_FILENAME = TRIM( FILENAME )
|
|
|
|
ELSE IF (N_CALC > 1) THEN
|
|
|
|
READ_FILENAME = 'GC_' // TRIM( FILENAME )
|
|
|
|
ELSE
|
|
|
|
STOP
|
|
|
|
END IF
|
|
|
|
! Expand date tokens in filename
|
|
CALL EXPAND_DATE( READ_FILENAME, YYYYMMDD, 9999 )
|
|
|
|
! Construct complete filename
|
|
DIR = './data/OMI_SO2/'
|
|
READ_FILENAME = TRIM( DIR ) // TRIM( READ_FILENAME )
|
|
|
|
! Does data file exist? If not, it means no data in the day.
|
|
! (ywang, 09/23/2014)
|
|
INQUIRE( FILE = TRIM( READ_FILENAME ), EXIST = LF )
|
|
IF ( .NOT. LF ) THEN
|
|
|
|
! No data
|
|
N_SO2 = 0
|
|
|
|
PRINT*, ' - READ_GC_OMI_SO2_OBS: No data file (warning)'
|
|
|
|
RETURN
|
|
|
|
END IF
|
|
|
|
|
|
|
|
! Print to screen
|
|
WRITE(6, 100) TRIM( READ_FILENAME )
|
|
100 FORMAT(' - READ_GC_OMI_SO2_OBS: reading file: ', A)
|
|
|
|
! PRINT*, 'N_CALC:', N_CALC
|
|
|
|
! Open file and assign file id (FID)
|
|
CALL CHECK( NF90_OPEN( READ_FILENAME, NF90_NOWRITE, FID ), 0 )
|
|
|
|
!-----------------------------------
|
|
! Get data record IDs
|
|
!-----------------------------------
|
|
CALL CHECK( NF90_INQ_DIMID( FID, "time", N_ID ), 100 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "lon", LON_ID ), 101 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "lat", LAT_ID ), 102 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "time", TIME_ID ), 103 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "SO2_PBL", SO2_PBL_ID ), 104 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "SO2_TRL", SO2_TRL_ID ), 105 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "SO2_TRM", SO2_TRM_ID ), 106 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "ERR_PBL", ERR_PBL_ID ), 108 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "ERR_TRL", ERR_TRL_ID ), 109 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "ERR_TRM", ERR_TRM_ID ), 110 )
|
|
|
|
IF ( N_CALC > 1 ) THEN
|
|
|
|
CALL CHECK( NF90_INQ_VARID( FID, "SO2", SO2_ID ), 107 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "ERR", ERR_ID ), 111 )
|
|
! CALL CHECK( NF90_INQ_VARID( FID, "MARK", MARK_ID ), 112 )
|
|
CALL CHECK( NF90_INQ_VARID( FID, "OPT", OPT_ID ), 113 )
|
|
! (ywang, 09/12/14)
|
|
CALL CHECK( NF90_INQ_VARID( FID, "FLAG", FLAG_ID ), 114 )
|
|
|
|
END IF
|
|
|
|
!------------------------------------
|
|
! Read dimensions
|
|
!------------------------------------
|
|
|
|
! Read number of observations, N_SO2
|
|
CALL CHECK( NF90_INQUIRE_DIMENSION( FID, N_ID, TMP, N_SO2 ), 200 )
|
|
|
|
! Print to screen
|
|
WRITE(6, 110) N_SO2, GET_NYMD()
|
|
110 FORMAT(' Number of OMI SO2 observations: ' I10, ' in ' I10)
|
|
|
|
!-------------------------------------
|
|
! Read 1D data
|
|
!-------------------------------------
|
|
|
|
! Allocate temporal arrays for 1D data
|
|
ALLOCATE( TMPINT(N_SO2) )
|
|
ALLOCATE( TMP4(N_SO2) )
|
|
ALLOCATE( TMP8(N_SO2) )
|
|
TMPINT = 0
|
|
TMP4 = 0E0
|
|
TMP8 = 0D0
|
|
|
|
! Allocate OMI SO2 observations array
|
|
IF ( ALLOCATED( OMI_SO2 ) ) DEALLOCATE( OMI_SO2 )
|
|
ALLOCATE( OMI_SO2(N_SO2) )
|
|
|
|
IF ( ALLOCATED( FLAGS) ) DEALLOCATE( FLAGS )
|
|
ALLOCATE( FLAGS(N_SO2) )
|
|
|
|
|
|
! Read longitude
|
|
CALL CHECK( NF90_GET_VAR( FID, LON_ID, TMP4 ), 301 )
|
|
OMI_SO2(1:N_SO2)%LON = TMP4(1:N_SO2)
|
|
|
|
! Read latitude
|
|
CALL CHECK( NF90_GET_VAR( FID, LAT_ID, TMP4 ), 302 )
|
|
OMI_SO2(1:N_SO2)%LAT = TMP4(1:N_SO2)
|
|
|
|
! Read time
|
|
CALL CHECK( NF90_GET_VAR( FID, TIME_ID, TMP8 ), 303 )
|
|
OMI_SO2(1:N_SO2)%TIME = TMP8(1:N_SO2)
|
|
|
|
! Read ColumnAmountSO2_PBL
|
|
CALL CHECK( NF90_GET_VAR( FID, SO2_PBL_ID, TMP4 ), 304 )
|
|
OMI_SO2(1:N_SO2)%SO2_PBL = TMP4(1:N_SO2)
|
|
|
|
! Read ColumnAmountSO2_TRL
|
|
CALL CHECK( NF90_GET_VAR( FID, SO2_TRL_ID, TMP4 ), 305 )
|
|
OMI_SO2(1:N_SO2)%SO2_TRL = TMP4(1:N_SO2)
|
|
|
|
! Read ColumnAmountSO2_TRM
|
|
CALL CHECK( NF90_GET_VAR( FID, SO2_TRM_ID, TMP4 ), 306 )
|
|
OMI_SO2(1:N_SO2)%SO2_TRM = TMP4(1:N_SO2)
|
|
|
|
! Read ColumnAmountSO2_PBL error
|
|
CALL CHECK( NF90_GET_VAR( FID, ERR_PBL_ID, TMP4 ), 308 )
|
|
OMI_SO2(1:N_SO2)%ERR_PBL = TMP4(1:N_SO2)
|
|
|
|
! Read ColumnAmountSO2_TRL error
|
|
CALL CHECK( NF90_GET_VAR( FID, ERR_TRL_ID, TMP4 ), 309 )
|
|
OMI_SO2(1:N_SO2)%ERR_TRL = TMP4(1:N_SO2)
|
|
|
|
! Read ColumnAmountSO2_TRM error
|
|
CALL CHECK( NF90_GET_VAR( FID, ERR_TRM_ID, TMP4 ), 310 )
|
|
OMI_SO2(1:N_SO2)%ERR_TRM = TMP4(1:N_SO2)
|
|
|
|
IF ( N_CALC > 1 ) THEN
|
|
|
|
! Read SO2 Whose CMA is closest to GEOS-Chem CMA
|
|
CALL CHECK( NF90_GET_VAR( FID, SO2_ID, TMP4 ), 307 )
|
|
OMI_SO2(1:N_SO2)%SO2 = TMP4(1:N_SO2)
|
|
|
|
! Read SO2 error
|
|
CALL CHECK( NF90_GET_VAR( FID, ERR_ID, TMP4 ), 311 )
|
|
OMI_SO2(1:N_SO2)%ERR = TMP4(1:N_SO2)
|
|
|
|
! ! Read MARK
|
|
! CALL CHECK( NF90_GET_VAR( FID, MARK_ID, TMPINT ), 312 )
|
|
! OMI_SO2(1:N_SO2)%MARK = TMPINT(1:N_SO2)
|
|
|
|
! Read OPT
|
|
CALL CHECK( NF90_GET_VAR( FID, OPT_ID, TMPINT ), 313 )
|
|
OMI_SO2(1:N_SO2)%OPT = TMPINT(1:N_SO2)
|
|
|
|
! Read FLAG
|
|
CALL CHECK( NF90_GET_VAR( FID, FLAG_ID, TMPINT ), 314 )
|
|
OMI_SO2(1:N_SO2)%FLAG = TMPINT(1:N_SO2)
|
|
|
|
END IF
|
|
|
|
! Close the file
|
|
CALL CHECK( NF90_CLOSE( FID ), 9999 )
|
|
|
|
DEALLOCATE( TMPINT )
|
|
DEALLOCATE( TMP4 )
|
|
DEALLOCATE( TMP8 )
|
|
|
|
! IF ( N_CALC > 1 ) THEN
|
|
! WRITE(*,*) '-----------SO2-----------'
|
|
! WRITE(*,*) OMI_SO2(1:N_SO2)%SO2
|
|
! WRITE(*,*) '-----------SO2-----------'
|
|
! WRITE(*,*) '-----------ERR-----------'
|
|
! WRITE(*,*) OMI_SO2(1:N_SO2)%ERR
|
|
! WRITE(*,*) '-----------ERR-----------'
|
|
! WRITE(*,*) '-----------MARK-----------'
|
|
! WRITE(*,*) OMI_SO2(1:N_SO2)%MARK
|
|
! WRITE(*,*) '-----------MARK-----------'
|
|
! WRITE(*,*) '-----------OPT-----------'
|
|
! WRITE(*,*) OMI_SO2(1:N_SO2)%OPT
|
|
! WRITE(*,*) '-----------OPT-----------'
|
|
! END IF
|
|
|
|
! Return to the calling routines
|
|
END SUBROUTINE READ_GC_OMI_SO2_OBS
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE WRITE_GC_OMI_SO2_OBS
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine WRITE_GC_OMI_SO2_OBS write observations whose CMA are
|
|
! close to GEOS-Chem CMA
|
|
! (ywang, 07/19/14)
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE NETCDF
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_NYMD
|
|
|
|
! Local variables
|
|
INTEGER :: FID, N_ID
|
|
INTEGER :: LON_ID, LAT_ID, TIME_ID
|
|
INTEGER :: SO2_PBL_ID, SO2_TRL_ID, SO2_TRM_ID
|
|
INTEGER :: SO2_ID
|
|
INTEGER :: ERR_PBL_ID, ERR_TRL_ID, ERR_TRM_ID
|
|
INTEGER :: ERR_ID
|
|
! INTEGER :: MARK_ID
|
|
INTEGER :: OPT_ID
|
|
INTEGER :: FLAG_ID
|
|
CHARACTER(LEN=255) :: DIR
|
|
CHARACTER(LEN=255) :: WRITE_FILENAME
|
|
INTEGER :: ICOUNT
|
|
REAL*4, ALLOCATABLE :: TMP4(:)
|
|
REAL*8, ALLOCATABLE :: TMP8(:)
|
|
|
|
!=================================================================
|
|
! WRITE_GC_OMI_SO2_OBS begins here!
|
|
!=================================================================
|
|
|
|
! Filename root
|
|
WRITE_FILENAME = 'GC_' // TRIM( FILENAME )
|
|
|
|
! Expand date tokens in filename
|
|
CALL EXPAND_DATE( WRITE_FILENAME, GET_NYMD(), 9999 )
|
|
|
|
! Construct complete filename
|
|
DIR = './data/OMI_SO2/'
|
|
WRITE_FILENAME = TRIM( DIR ) // TRIM( WRITE_FILENAME )
|
|
|
|
! Print to screen
|
|
WRITE(6, 100) TRIM( WRITE_FILENAME )
|
|
100 FORMAT(' - WRITE_GC_OMI_SO2_OBS: reading file: ', A)
|
|
|
|
! Create the netCDF file
|
|
CALL CHECK( NF90_CREATE( WRITE_FILENAME, 0, FID ), 0 )
|
|
|
|
! Define time dimension
|
|
CALL CHECK( NF90_DEF_DIM( FID, 'time', NF90_UNLIMITED, N_ID ),
|
|
& 100 )
|
|
|
|
CALL CHECK( NF90_ENDDEF( FID ), 99 )
|
|
|
|
ICOUNT = SIZE( OMI_SO2 )
|
|
|
|
ALLOCATE( TMP4(ICOUNT) )
|
|
ALLOCATE( TMP8(ICOUNT) )
|
|
|
|
! put variable longitude
|
|
TMP4(:) = OMI_SO2(:)%LON
|
|
CALL NCIO_1D( FID, TMP4, 'lon', 'longitude',
|
|
& 'degree', N_ID, ICOUNT, 101 )
|
|
|
|
! put variable latitude
|
|
TMP4(:) = OMI_SO2(:)%LAT
|
|
CALL NCIO_1D( FID, TMP4, 'lat', 'latitude',
|
|
& 'degree', N_ID, ICOUNT, 102 )
|
|
|
|
! put variable time
|
|
TMP8(:) = OMI_SO2(:)%TIME
|
|
CALL NCIO_1D_DBL( FID, TMP8, 'time',
|
|
& 'time at start of scan (TAI93)',
|
|
& 's', N_ID, ICOUNT, 103 )
|
|
|
|
! put variable ColumnAmountSO2_PBL
|
|
TMP4(:) = OMI_SO2(:)%SO2_PBL
|
|
CALL NCIO_1D( FID, TMP4, 'SO2_PBL',
|
|
& 'ColumnAmountSO2_PBL',
|
|
& 'DU', N_ID, ICOUNT, 104 )
|
|
|
|
! put variable ColumnAmountSO2_TRL
|
|
TMP4(:) = OMI_SO2(:)%SO2_TRL
|
|
CALL NCIO_1D( FID, TMP4, 'SO2_TRL',
|
|
& 'ColumnAmountSO2_TRL',
|
|
& 'DU', N_ID, ICOUNT, 105 )
|
|
|
|
! put variable ColumnAmountSO2_TRM
|
|
TMP4(:) = OMI_SO2(:)%SO2_TRM
|
|
CALL NCIO_1D( FID, TMP4, 'SO2_TRM',
|
|
& 'ColumnAmountSO2_TRM',
|
|
& 'DU', N_ID, ICOUNT, 106 )
|
|
|
|
! put variable SO2 Whose CMA is closest to GEOS-Chem CMA
|
|
TMP4(:) = OMI_SO2(:)%SO2
|
|
CALL NCIO_1D( FID, TMP4, 'SO2',
|
|
& 'GC_OMI_SO2',
|
|
& 'DU', N_ID, ICOUNT, 107 )
|
|
|
|
! put variable ColumnAmountSO2_PBL error
|
|
TMP4(:) = OMI_SO2(:)%ERR_PBL
|
|
CALL NCIO_1D( FID, TMP4, 'ERR_PBL',
|
|
& 'ColumnAmountSO2_PBL error',
|
|
& 'DU', N_ID, ICOUNT, 108 )
|
|
|
|
! put variable ColumnAmountSO2_TRL error
|
|
TMP4(:) = OMI_SO2(:)%ERR_TRL
|
|
CALL NCIO_1D( FID, TMP4, 'ERR_TRL',
|
|
& 'ColumnAmountSO2_TRL error',
|
|
& 'DU', N_ID, ICOUNT, 109 )
|
|
|
|
! put variable ColumnAmountSO2_TRM error
|
|
TMP4(:) = OMI_SO2(:)%ERR_TRM
|
|
CALL NCIO_1D( FID, TMP4, 'ERR_TRM',
|
|
& 'ColumnAmountSO2_TRM error',
|
|
& 'DU', N_ID, ICOUNT, 110 )
|
|
|
|
! put variable GC_OMI_SO2 error
|
|
TMP4(:) = OMI_SO2(:)%ERR
|
|
CALL NCIO_1D( FID, TMP4, 'ERR',
|
|
& 'GC_OMI_SO2 error',
|
|
& 'DU', N_ID, ICOUNT, 111 )
|
|
|
|
! ! put variable MARK
|
|
! CALL NCIO_1D_INT( FID, OMI_SO2(:)%MARK, 'MARK',
|
|
! & 'MARK',
|
|
! & 'unitless', N_ID, ICOUNT, 112 )
|
|
|
|
! put variable OPT
|
|
CALL NCIO_1D_INT( FID, OMI_SO2(:)%OPT, 'OPT',
|
|
& 'OPT',
|
|
& 'unitless', N_ID, ICOUNT, 113 )
|
|
|
|
! put variable FLAG (ywang, 09/12/14)
|
|
CALL NCIO_1D_INT( FID, OMI_SO2(:)%FLAG, 'FLAG',
|
|
& 'FLAG',
|
|
& 'unitless', N_ID, ICOUNT, 114 )
|
|
|
|
! close netCDF file
|
|
CALL CHECK( NF90_CLOSE( FID ), 999 )
|
|
|
|
DEALLOCATE( TMP4 )
|
|
DEALLOCATE( TMP8 )
|
|
|
|
! Return to the calling routines
|
|
END SUBROUTINE WRITE_GC_OMI_SO2_OBS
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE CALC_OMI_SO2_FORCE( COST_FUNC )
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine CALC_OMI_SO2_FORCE calculate the adjoint forcing from OMI
|
|
! L3 SO2 observation and updates the cost function.
|
|
! (ywang, 07/16/14)
|
|
!
|
|
! Arguments as Input/Output:
|
|
! ===========================================================================
|
|
! ( 1) COST_FUNC (REAL*8) : Cost funtion [unitless]
|
|
!
|
|
! NOTES:
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
|
|
USE ADJ_ARRAYS_MOD, ONLY : OBS_FREQ, N_CALC
|
|
USE CHECKPT_MOD, ONLY : CHK_STT
|
|
USE DAO_MOD, ONLY : AIRVOL
|
|
USE DAO_MOD, ONLY : BXHEIGHT
|
|
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
|
|
USE GRID_MOD, ONLY : GET_IJ
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
USE TIME_MOD, ONLY : GET_TAUb, GET_TAU, GET_TAUe
|
|
USE TRACER_MOD, ONLY : XNUMOL
|
|
USE TRACERID_MOD, ONLY : IDTSO2
|
|
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_TROP
|
|
|
|
! Arguements
|
|
REAL*8, INTENT(INOUT) :: COST_FUNC
|
|
|
|
! Parameters
|
|
REAL*8, PARAMETER :: M2DU = 2.69D20 ! 1 DU = 2.69D20 molec/m2
|
|
|
|
! Local variables
|
|
INTEGER, SAVE :: N_SO2 = 0
|
|
INTEGER :: N_CURR
|
|
INTEGER :: NT
|
|
INTEGER :: NC
|
|
INTEGER :: IIJJ(2), I, J, L
|
|
|
|
REAL*8 :: OLD_COST
|
|
REAL*8 :: TMP_COST
|
|
REAL*8, ALLOCATABLE :: NEW_COST(:)
|
|
|
|
REAL*8 :: GC_CMA ! GEOS-Chem Center Mass of Alitude. (units: km)
|
|
REAL*8 :: GC_SO2_CONC(LLPAR) ! GEOS-Chem SO2 at each layer (units: kg/m3)
|
|
REAL*8 :: LAYER_GC_SO2(LLPAR) ! GEOS-Chem SO2 at each layer (units: DU)
|
|
REAL*8 :: COLUMN_GC_SO2 ! GEOS-Chem column SO2 (units: DU)
|
|
REAL*8 :: DIFF
|
|
REAL*8 :: FORCING
|
|
|
|
|
|
|
|
!=================================================================
|
|
! CALC_OMI_SO2_FORCE begins here!
|
|
!=================================================================
|
|
|
|
PRINT*, ' - CALC_OMI_SO2_FORCE: OMI SO2 forcing '
|
|
|
|
! Initialize
|
|
CALL INIT_OMI_SO2_OBS
|
|
|
|
! Save a value of the cost function first
|
|
OLD_COST = COST_FUNC
|
|
! PRINT*, 'OLD_COST', OLD_COST, COST_FUNC
|
|
|
|
! Check if it is the last time of a day
|
|
IF ( OBS_FREQ > 60 ) THEN
|
|
PRINT*, '236000 - OBS_FREQ * 100 is not valid'
|
|
STOP
|
|
END IF
|
|
IF ( GET_NHMS() == 236000 - OBS_FREQ * 100 ) THEN
|
|
! IF ( (GET_NHMS() == 236000 - OBS_FREQ * 100) .OR.
|
|
! & ( ABS(GET_TAU() -GET_TAUe()) < 1e-6 ) ) THEN
|
|
|
|
CALL READ_GC_OMI_SO2_OBS( GET_NYMD(), N_SO2 )
|
|
|
|
END IF
|
|
|
|
! No observations for current day
|
|
IF ( N_SO2 == 0 ) THEN
|
|
|
|
PRINT*, ' - CALC_OMI_SO2_FORCE: No OMI SO2 obsevations for
|
|
¤t day'
|
|
|
|
IF ( ABS( GET_TAUb() - GET_TAU() ) < 1E-6) THEN
|
|
|
|
CALL MAKE_AVERAGE_OMI_SO2
|
|
|
|
END IF
|
|
|
|
! The start time of one day
|
|
IF ( GET_NHMS() == 0 ) THEN
|
|
|
|
CALL WRITE_GC_OMI_SO2_OBS
|
|
|
|
END IF
|
|
|
|
|
|
RETURN
|
|
|
|
END IF
|
|
|
|
|
|
! GET observations in time window
|
|
CALL GET_OBS( N_SO2, N_CURR )
|
|
|
|
! No observations for time window
|
|
IF ( N_CURR == 0 ) THEN
|
|
|
|
PRINT*, ' - CALC_OMI_SO2_FORCE: No OMI SO2 obsevations for
|
|
¤t time window'
|
|
|
|
IF ( ABS( GET_TAUb() - GET_TAU() ) < 1E-6) THEN
|
|
|
|
CALL MAKE_AVERAGE_OMI_SO2
|
|
|
|
END IF
|
|
|
|
! The start time of one day
|
|
IF ( GET_NHMS() == 0 ) THEN
|
|
|
|
CALL WRITE_GC_OMI_SO2_OBS
|
|
|
|
END IF
|
|
|
|
RETURN
|
|
|
|
END IF
|
|
|
|
! Reset
|
|
CURR_GC_SO2 = 0D0
|
|
CURR_PBL_SO2 = 0D0
|
|
CURR_TRL_SO2 = 0D0
|
|
CURR_TRM_SO2 = 0D0
|
|
CURR_SO2 = 0D0
|
|
CURR_DIFF_SO2 = 0D0
|
|
CURR_FORCING = 0D0
|
|
CURR_COST = 0D0
|
|
CURR_CMA = 0D0
|
|
CURR_COUNT = 0
|
|
CURR_PBL_C = 0
|
|
CURR_TRL_C = 0
|
|
CURR_TRM_C = 0
|
|
CURR_OPT = 0
|
|
|
|
! Reset
|
|
IF ( ALLOCATED( NEW_COST ) ) DEALLOCATE( NEW_COST )
|
|
ALLOCATE ( NEW_COST(N_CURR) )
|
|
NEW_COST = 0D0
|
|
|
|
NC = 0
|
|
! Loop for all observations
|
|
DO NT = 1, N_SO2, 1
|
|
|
|
! Observations in time window and simulation area
|
|
IF ( FLAGS(NT) ) THEN
|
|
|
|
! Get grid box of current record
|
|
IIJJ = GET_IJ( REAL(OMI_SO2(NT)%LON ,4),
|
|
& REAL(OMI_SO2(NT)%LAT ,4) )
|
|
|
|
I = IIJJ(1)
|
|
J = IIJJ(2)
|
|
|
|
! These code is moved below
|
|
! ! Count observations in gridbox
|
|
! CURR_COUNT(I,J) = CURR_COUNT(I,J) + 1
|
|
! ALL_COUNT(I,J) = ALL_COUNT(I,J) + 1
|
|
|
|
! SO2 outside troposphere is set to 0
|
|
GC_SO2_CONC = 0D0
|
|
LAYER_GC_SO2 = 0D0
|
|
DO L = 1, LLPAR, 1
|
|
|
|
IF ( ITS_IN_THE_TROP(I,J,L) ) THEN
|
|
|
|
! Units conversion [ kg/gridbox => DU ]
|
|
! Units of LAYER_GC_SO2: DU
|
|
! GC_SO2_CONC: kg/m3
|
|
! CHK_STT : kg/gridbox
|
|
! AIRVOL : m3/gridbox
|
|
! BXHEIGHT : m
|
|
! XNUMOL : molec/kg
|
|
! M2DU = 2.69D20 , 1 DU = 2.69D20 molec/m2
|
|
|
|
GC_SO2_CONC(L) = CHK_STT(I,J,L,IDTSO2) /
|
|
& AIRVOL(I,J,L)
|
|
|
|
LAYER_GC_SO2(L) = GC_SO2_CONC(L) *
|
|
& BXHEIGHT(I,J,L) *
|
|
& XNUMOL(IDTSO2) /
|
|
& M2DU
|
|
|
|
END IF
|
|
|
|
END DO
|
|
|
|
COLUMN_GC_SO2 = SUM( LAYER_GC_SO2 )
|
|
|
|
! These code is moved below
|
|
! CURR_GC_SO2(I,J) = CURR_GC_SO2(I,J) + COLUMN_GC_SO2
|
|
! ALL_GC_SO2(I,J) = ALL_GC_SO2(I,J) + COLUMN_GC_SO2
|
|
|
|
! Get GEOS-Chem CMA
|
|
CALL CALC_CMA( I, J, GC_SO2_CONC, GC_CMA )
|
|
|
|
! These code is moved below
|
|
! CURR_CMA(I,J) = CURR_CMA(I,J) + GC_CMA
|
|
! ALL_CMA(I,J) = ALL_CMA(I,J) + GC_CMA
|
|
|
|
! Determine SO2 observations whoes CMA is closest to GEOS-Chem CMA
|
|
! DETERMINE_OBS is modified (ywang, 09/12/14)
|
|
IF ( N_CALC == 1 ) CALL DETERMINE_OBS(GC_CMA, NT)
|
|
|
|
|
|
IF ( OMI_SO2(NT)%FLAG == 1 ) THEN ! expected observation exist
|
|
|
|
! Count observations in gridbox
|
|
CURR_COUNT(I,J) = CURR_COUNT(I,J) + 1
|
|
ALL_COUNT(I,J) = ALL_COUNT(I,J) + 1
|
|
|
|
CURR_GC_SO2(I,J) = CURR_GC_SO2(I,J) + COLUMN_GC_SO2
|
|
ALL_GC_SO2(I,J) = ALL_GC_SO2(I,J) + COLUMN_GC_SO2
|
|
|
|
CURR_CMA(I,J) = CURR_CMA(I,J) + GC_CMA
|
|
ALL_CMA(I,J) = ALL_CMA(I,J) + GC_CMA
|
|
|
|
CURR_OPT(I,J) = CURR_OPT(I,J) + 1
|
|
ALL_OPT(I,J) = ALL_OPT(I,J) + 1
|
|
|
|
! Calculate sum here. In the end, average will be calculated
|
|
CURR_SO2(I,J) = CURR_SO2(I,J) + OMI_SO2(NT)%SO2
|
|
ALL_SO2(I,J) = ALL_SO2(I,J) + OMI_SO2(NT)%SO2
|
|
|
|
! The code is moved below
|
|
! IF ( OMI_SO2(NT)%SO2_PBL > 0.0 ) THEN
|
|
!
|
|
! CURR_PBL_SO2(I,J) = CURR_PBL_SO2(I,J) +
|
|
! & OMI_SO2(NT)%SO2_PBL
|
|
! CURR_PBL_C(I,J) = CURR_PBL_C(I,J) + 1
|
|
!
|
|
! ALL_PBL_SO2(I,J) = ALL_PBL_SO2(I,J) +
|
|
! & OMI_SO2(NT)%SO2_PBL
|
|
! ALL_PBL_C(I,J) = ALL_PBL_C(I,J) + 1
|
|
!
|
|
! END IF
|
|
!
|
|
! IF ( OMI_SO2(NT)%SO2_TRL > 0.0 ) THEN
|
|
!
|
|
! CURR_TRL_SO2(I,J) = CURR_TRL_SO2(I,J) +
|
|
! & OMI_SO2(NT)%SO2_TRL
|
|
! CURR_TRL_C(I,J) = CURR_TRL_C(I,J) + 1
|
|
!
|
|
! ALL_TRL_SO2(I,J) = ALL_TRL_SO2(I,J) +
|
|
! & OMI_SO2(NT)%SO2_TRL
|
|
! ALL_TRL_C(I,J) = ALL_TRL_C(I,J) + 1
|
|
!
|
|
! END IF
|
|
!
|
|
! IF ( OMI_SO2(NT)%SO2_TRM > 0.0 ) THEN
|
|
!
|
|
! CURR_TRM_SO2(I,J) = CURR_TRM_SO2(I,J) +
|
|
! & OMI_SO2(NT)%SO2_TRM
|
|
! CURR_TRM_C(I,J) = CURR_TRM_C(I,J) + 1
|
|
!
|
|
! ALL_TRM_SO2(I,J) = ALL_TRM_SO2(I,J) +
|
|
! & OMI_SO2(NT)%SO2_TRM
|
|
! ALL_TRM_C(I,J) = ALL_TRM_C(I,J) + 1
|
|
!
|
|
! END IF
|
|
|
|
!-----------------------------
|
|
! Calculate adjoint forcing
|
|
!-----------------------------
|
|
|
|
! The difference between GEOS-Chem SO2 and OMI SO2
|
|
DIFF = COLUMN_GC_SO2 - OMI_SO2(NT)%SO2
|
|
CURR_DIFF_SO2(I,J) = CURR_DIFF_SO2(I,J) + DIFF
|
|
ALL_DIFF_SO2(I,J) = ALL_DIFF_SO2(I,J) + DIFF
|
|
|
|
! S_{obs}^{-1} * DIFF
|
|
FORCING = DIFF / (OMI_SO2(NT)%ERR ** 2)
|
|
CURR_FORCING(I,J) = CURR_FORCING(I,J) + FORCING
|
|
ALL_FORCING(I,J) = ALL_FORCING(I,J) + FORCING
|
|
|
|
! Contribution to the cost function
|
|
TMP_COST = 0.5D0 * DIFF * FORCING
|
|
NC = NC + 1
|
|
NEW_COST(NC) = NEW_COST(NC) + TMP_COST
|
|
CURR_COST(I,J) = CURR_COST(I,J) + TMP_COST
|
|
ALL_COST(I,J) = ALL_COST(I,J) + TMP_COST
|
|
|
|
|
|
! Now pass the adjoint back to the adjoint tracer array
|
|
DO L = 1, LLPAR, 1
|
|
|
|
IF ( ITS_IN_THE_TROP(I,J,L) ) THEN
|
|
|
|
STT_ADJ(I,J,L,IDTSO2) = STT_ADJ(I,J,L,IDTSO2) +
|
|
& FORCING / AIRVOL(I,J,L) *
|
|
& BXHEIGHT(I,J,L) *
|
|
& XNUMOL(IDTSO2) / M2DU
|
|
|
|
END IF
|
|
|
|
END DO
|
|
|
|
END IF !OMI_SO2(NT)%FLAG == 1
|
|
|
|
IF ( OMI_SO2(NT)%SO2_PBL > 0.0 ) THEN
|
|
|
|
CURR_PBL_SO2(I,J) = CURR_PBL_SO2(I,J) +
|
|
& OMI_SO2(NT)%SO2_PBL
|
|
CURR_PBL_C(I,J) = CURR_PBL_C(I,J) + 1
|
|
|
|
ALL_PBL_SO2(I,J) = ALL_PBL_SO2(I,J) +
|
|
& OMI_SO2(NT)%SO2_PBL
|
|
ALL_PBL_C(I,J) = ALL_PBL_C(I,J) + 1
|
|
|
|
END IF
|
|
|
|
IF ( OMI_SO2(NT)%SO2_TRL > 0.0 ) THEN
|
|
|
|
CURR_TRL_SO2(I,J) = CURR_TRL_SO2(I,J) +
|
|
& OMI_SO2(NT)%SO2_TRL
|
|
CURR_TRL_C(I,J) = CURR_TRL_C(I,J) + 1
|
|
|
|
ALL_TRL_SO2(I,J) = ALL_TRL_SO2(I,J) +
|
|
& OMI_SO2(NT)%SO2_TRL
|
|
ALL_TRL_C(I,J) = ALL_TRL_C(I,J) + 1
|
|
|
|
END IF
|
|
|
|
IF ( OMI_SO2(NT)%SO2_TRM > 0.0 ) THEN
|
|
|
|
CURR_TRM_SO2(I,J) = CURR_TRM_SO2(I,J) +
|
|
& OMI_SO2(NT)%SO2_TRM
|
|
CURR_TRM_C(I,J) = CURR_TRM_C(I,J) + 1
|
|
|
|
ALL_TRM_SO2(I,J) = ALL_TRM_SO2(I,J) +
|
|
& OMI_SO2(NT)%SO2_TRM
|
|
ALL_TRM_C(I,J) = ALL_TRM_C(I,J) + 1
|
|
|
|
END IF
|
|
|
|
END IF ! FLAGS(NT)
|
|
|
|
END DO ! NT
|
|
|
|
|
|
! Update cost function
|
|
COST_FUNC = COST_FUNC + SUM( NEW_COST )
|
|
PRINT*, ' Update value of COST_FUNC = ', COST_FUNC
|
|
PRINT*, ' OMI SO2 contribution = ', COST_FUNC - OLD_COST
|
|
|
|
PRINT*, ' MIN/MAX STT_ADJ = ', MINVAL(STT_ADJ), MAXVAL(STT_ADJ)
|
|
PRINT*, ' MIN/MAX in = ', MINLOC(STT_ADJ), MAXLOC(STT_ADJ)
|
|
PRINT*, ' MIN/MAX NEW_COST = ', MINVAL(NEW_COST), MAXVAL(NEW_COST)
|
|
PRINT*, ' MIN/MAX cost in = ', MINLOC(NEW_COST),MAXLOC(NEW_COST)
|
|
|
|
|
|
CALL MAKE_CURRENT_OMI_SO2
|
|
|
|
|
|
IF ( ABS( GET_TAUb() - GET_TAU() ) < 1E-6) THEN
|
|
|
|
CALL MAKE_AVERAGE_OMI_SO2
|
|
|
|
END IF
|
|
|
|
! The start time of one day
|
|
IF ( ( GET_NHMS() == 0 ) .AND. ( N_CALC == 1 ) ) THEN
|
|
|
|
CALL WRITE_GC_OMI_SO2_OBS
|
|
|
|
END IF
|
|
|
|
! Return to the calling routines
|
|
END SUBROUTINE CALC_OMI_SO2_FORCE
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE MAKE_CURRENT_OMI_SO2
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine MAKE_CURRENT_OMI_SO2 output some dignostic data for
|
|
! current assimilation time window
|
|
! (ywang, 07/19/14)
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 module
|
|
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
|
|
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
|
|
USE BPCH2_MOD
|
|
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
|
|
USE FILE_MOD, ONLY : IU_RST, IOERROR
|
|
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
|
|
USE TIME_MOD, ONLY : EXPAND_DATE
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
USE TIME_MOD, ONLY : GET_TAU
|
|
|
|
REAL*4, PARAMETER :: UNDEF = -999.0
|
|
|
|
! Local Variables
|
|
INTEGER :: I, I0, J, J0, L
|
|
REAL*4 :: SO2(IIPAR,JJPAR,14)
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! For binary punch file, version 2.0
|
|
REAL*4 :: LONRES, LATRES
|
|
INTEGER, PARAMETER :: HALFPOLAR = 1
|
|
INTEGER, PARAMETER :: CENTER180 = 1
|
|
|
|
CHARACTER(LEN=255) :: OUTPUT_FILE
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED = ''
|
|
CHARACTER(LEN=80) :: TITLE
|
|
|
|
!=================================================================
|
|
! MAKE_CURRENT_OMI_SO2 begins here!
|
|
!=================================================================
|
|
|
|
! Hardwire output file for now
|
|
OUTPUT_FILE = 'gctm.omi.so2.YYYYMMDD.hhmm.NN'
|
|
|
|
! Define variables for BINARY PUNCH FILE OUTPUT
|
|
TITLE = 'GEOS-CHEM diag File: ' //
|
|
& 'OMI SO2'
|
|
UNIT = 'DU'
|
|
CATEGORY = 'IJ-AVG-$'
|
|
LONRES = DISIZE
|
|
LATRES = DJSIZE
|
|
|
|
! Call GET_MODELNAME to return the proper model name for
|
|
! the given met data being used
|
|
MODELNAME = GET_MODELNAME()
|
|
|
|
! Get the nested-grid offsets
|
|
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
|
|
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
|
|
|
|
! Copy the output observation file name into a local variable
|
|
FILENAME = TRIM( OUTPUT_FILE )
|
|
|
|
! Replace YYMMDD and hhmmss token w/ actucl value
|
|
CALL EXPAND_DATE( FILENAME, GET_NYMD(), GET_NHMS() )
|
|
|
|
! Replace NN token w/ actual value
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
|
|
! Add DIAGADJ_DIR prefix to FILENAME
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - MAKE_CURRENT_OMI_SO2: Writing ', a )
|
|
|
|
! Open file for output
|
|
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
|
|
|
|
SO2 = 0.0
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
IF ( CURR_COUNT(I,J) > 0 ) THEN
|
|
SO2(I,J, 1) = REAL(CURR_GC_SO2(I,J)) / CURR_COUNT(I,J)
|
|
SO2(I,J, 5) = REAL(CURR_SO2(I,J)) / CURR_COUNT(I,J)
|
|
SO2(I,J, 6) = REAL(CURR_DIFF_SO2(I,J)) / CURR_COUNT(I,J)
|
|
SO2(I,J, 7) = REAL(CURR_FORCING(I,J))
|
|
SO2(I,J, 8) = REAL(CURR_COST(I,J))
|
|
SO2(I,J, 9) = REAL(CURR_CMA(I,J)) / CURR_COUNT(I,J)
|
|
SO2(I,J,10) = REAL(CURR_COUNT(I,J))
|
|
SO2(I,J,11) = REAL(CURR_PBL_C(I,J))
|
|
SO2(I,J,12) = REAL(CURR_TRL_C(I,J))
|
|
SO2(I,J,13) = REAL(CURR_TRM_C(I,J))
|
|
SO2(I,J,14) = REAL(CURR_OPT(I,J))
|
|
END IF
|
|
|
|
IF ( CURR_PBL_C(I,J) > 0 ) THEN
|
|
SO2(I,J,2) = REAL(CURR_PBL_SO2(I,J)) / CURR_PBL_C(I,J)
|
|
END IF
|
|
|
|
IF ( CURR_TRL_C(I,J) > 0 ) THEN
|
|
SO2(I,J,3) = REAL(CURR_TRL_SO2(I,J)) / CURR_TRL_C(I,J)
|
|
END IF
|
|
|
|
IF ( CURR_TRM_C(I,J) > 0 ) THEN
|
|
SO2(I,J,4) = REAL(CURR_TRM_SO2(I,J)) / CURR_TRM_C(I,J)
|
|
END IF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!$OMP END PARALLEL DO
|
|
|
|
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
|
|
& HALFPOLAR, CENTER180, CATEGORY, 26,
|
|
& UNIT, GET_TAU(), GET_TAU(), RESERVED,
|
|
& IIPAR, JJPAR, 14, I0+1,
|
|
& J0+1, 1, SO2 )
|
|
|
|
! Close file
|
|
CLOSE( IU_RST )
|
|
|
|
! Return to the calling routines
|
|
END SUBROUTINE MAKE_CURRENT_OMI_SO2
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE MAKE_AVERAGE_OMI_SO2
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine MAKE_AVERAGE_OMI_SO2 output some dignostic data for
|
|
! simulation time
|
|
! (ywang, 07/19/14)
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 module
|
|
USE ADJ_ARRAYS_MOD, ONLY : N_CALC
|
|
USE ADJ_ARRAYS_MOD, ONLY : EXPAND_NAME
|
|
USE BPCH2_MOD
|
|
USE DIRECTORY_ADJ_MOD, ONLY : DIAGADJ_DIR
|
|
USE FILE_MOD, ONLY : IU_RST, IOERROR
|
|
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
|
|
USE TIME_MOD, ONLY : EXPAND_DATE
|
|
USE TIME_MOD, ONLY : GET_NYMD
|
|
USE TIME_MOD, ONLY : GET_TAUb, GET_TAUe
|
|
|
|
REAL*4, PARAMETER :: UNDEF = -999.0
|
|
|
|
! Local Variables
|
|
INTEGER :: I, I0, J, J0, L
|
|
REAL*4 :: SO2(IIPAR,JJPAR,14)
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
! For binary punch file, version 2.0
|
|
REAL*4 :: LONRES, LATRES
|
|
INTEGER, PARAMETER :: HALFPOLAR = 1
|
|
INTEGER, PARAMETER :: CENTER180 = 1
|
|
|
|
CHARACTER(LEN=255) :: OUTPUT_FILE
|
|
CHARACTER(LEN=20) :: MODELNAME
|
|
CHARACTER(LEN=40) :: CATEGORY
|
|
CHARACTER(LEN=40) :: UNIT
|
|
CHARACTER(LEN=40) :: RESERVED = ''
|
|
CHARACTER(LEN=80) :: TITLE
|
|
|
|
!=================================================================
|
|
! MAKE_AVERAGE_OMI_SO2 begins here!
|
|
!=================================================================
|
|
|
|
! Hardwire output file for now
|
|
OUTPUT_FILE = 'gctm.omi.so2.ave.YYYYMMDD.NN'
|
|
|
|
! Define variables for BINARY PUNCH FILE OUTPUT
|
|
TITLE = 'GEOS-CHEM diag File: ' //
|
|
& 'OMI SO2'
|
|
UNIT = 'DU'
|
|
CATEGORY = 'IJ-AVG-$'
|
|
LONRES = DISIZE
|
|
LATRES = DJSIZE
|
|
|
|
! Call GET_MODELNAME to return the proper model name for
|
|
! the given met data being used
|
|
MODELNAME = GET_MODELNAME()
|
|
|
|
! Get the nested-grid offsets
|
|
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
|
|
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
|
|
|
|
! Copy the output observation file name into a local variable
|
|
FILENAME = TRIM( OUTPUT_FILE )
|
|
|
|
! Replace YYMMDD token w/ actucl value
|
|
CALL EXPAND_DATE( FILENAME, GET_NYMD(), 9999 )
|
|
|
|
! Replace NN token w/ actual value
|
|
CALL EXPAND_NAME( FILENAME, N_CALC )
|
|
|
|
! Add DIAGADJ_DIR prefix to FILENAME
|
|
FILENAME = TRIM( DIAGADJ_DIR ) // TRIM( FILENAME )
|
|
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - MAKE_AVERAGE_OMI_SO2: Writing ', a )
|
|
|
|
! Open file for output
|
|
CALL OPEN_BPCH2_FOR_WRITE( IU_RST, FILENAME, TITLE )
|
|
|
|
SO2 = 0.0
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
IF ( ALL_COUNT(I,J) > 0 ) THEN
|
|
SO2(I,J, 1) = REAL(ALL_GC_SO2(I,J)) / ALL_COUNT(I,J)
|
|
SO2(I,J, 5) = REAL(ALL_SO2(I,J)) / ALL_COUNT(I,J)
|
|
SO2(I,J, 6) = REAL(ALL_DIFF_SO2(I,J)) / ALL_COUNT(I,J)
|
|
SO2(I,J, 7) = REAL(ALL_FORCING(I,J))
|
|
SO2(I,J, 8) = REAL(ALL_COST(I,J))
|
|
SO2(I,J, 9) = REAL(ALL_CMA(I,J)) / ALL_COUNT(I,J)
|
|
SO2(I,J,10) = REAL(ALL_COUNT(I,J))
|
|
SO2(I,J,11) = REAL(ALL_PBL_C(I,J))
|
|
SO2(I,J,12) = REAL(ALL_TRL_C(I,J))
|
|
SO2(I,J,13) = REAL(ALL_TRM_C(I,J))
|
|
SO2(I,J,14) = REAL(ALL_OPT(I,J))
|
|
END IF
|
|
|
|
IF ( ALL_PBL_C(I,J) > 0 ) THEN
|
|
SO2(I,J,2) = REAL(ALL_PBL_SO2(I,J)) / ALL_PBL_C(I,J)
|
|
END IF
|
|
|
|
IF ( ALL_TRL_C(I,J) > 0 ) THEN
|
|
SO2(I,J,3) = REAL(ALL_TRL_SO2(I,J)) / ALL_TRL_C(I,J)
|
|
END IF
|
|
|
|
IF ( ALL_TRM_C(I,J) > 0 ) THEN
|
|
SO2(I,J,4) = REAL(ALL_TRM_SO2(I,J)) / ALL_TRM_C(I,J)
|
|
END IF
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!$OMP END PARALLEL DO
|
|
|
|
CALL BPCH2( IU_RST, MODELNAME, LONRES, LATRES,
|
|
& HALFPOLAR, CENTER180, CATEGORY, 26,
|
|
& UNIT, GET_TAUb(), GET_TAUe(), RESERVED,
|
|
& IIPAR, JJPAR, 14, I0+1,
|
|
& J0+1, 1, SO2 )
|
|
|
|
! Close file
|
|
CLOSE( IU_RST )
|
|
|
|
! Return to the calling routines
|
|
END SUBROUTINE MAKE_AVERAGE_OMI_SO2
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE GET_OBS( N_SO2, N_CURR )
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine GET_OBS finds all obsevations in the current time window
|
|
! and simulation area.
|
|
! (ywang, 07/17/14)
|
|
!
|
|
! Arguements as Input:
|
|
! ===========================================================================
|
|
! ( 1) N_SO2 (INTEGER) : Number of observation in current day
|
|
! Arguements as Output:
|
|
! ===========================================================================
|
|
! ( 2) N_CURR (INTEGER) : Number of obsevations in the current time
|
|
! window and simulation area.
|
|
!
|
|
! Module variable as Output:
|
|
! ===========================================================================
|
|
! ( 1) FLAGS (LOGICAL) : Whether or not a speicific obsevation is
|
|
! in current time window and simulation area.
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 module
|
|
USE GRID_MOD, ONLY : GET_XEDGE, GET_YEDGE
|
|
USE TIME_MOD, ONLY : GET_JD, GET_TAU
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
|
|
! Arguemens
|
|
INTEGER, INTENT( IN) :: N_SO2
|
|
INTEGER, INTENT(OUT) :: N_CURR
|
|
|
|
! Local variables
|
|
REAL*8 :: HALF_TIME_WINDOW
|
|
REAL*8 :: WINDOW_BEGIN, WINDOW_END
|
|
REAL*8 :: JD85, JD93, JD93_85
|
|
REAL*8 :: CURRENT_TAU
|
|
INTEGER :: NT
|
|
|
|
#if defined( NESTED_CH ) || defined( NESTED_NA ) || defined( NESTED_SD )
|
|
REAL*8, SAVE :: XEDGE_MIN, XEDGE_MAX
|
|
REAL*8, SAVE :: YEDGE_MIN, YEDGE_MAX
|
|
#endif
|
|
|
|
!=================================================================
|
|
! GET_OBS begins here!
|
|
!=================================================================
|
|
|
|
! Get the difference between JD93 and JD85
|
|
! In GEOS-Chem, it is since 1/1/1985, while in OMI, it is since
|
|
! 1/1/1993
|
|
JD85 = GET_JD( 19850000, 000000 )
|
|
JD93 = GET_JD( 19930000, 000000 )
|
|
JD93_85 = JD93 - JD85
|
|
JD93_85 = JD93_85 * 24D0 ! days => hours
|
|
|
|
! write(*, '(A15, f30.15)' ) 'JD85', JD85
|
|
! write(*, '(A15, f30.15)' ) 'JD93', JD93
|
|
! write(*, '(A15, f30.15)' ) 'JD93_85', JD93_85
|
|
|
|
! Get current GEOS-Chem TAU
|
|
CURRENT_TAU = GET_TAU()
|
|
! write(*,'(A15, f30.15)') 'CURRENT_TAU',CURRENT_TAU
|
|
|
|
! Change current GEOS-Chem TAU into OMI TAU
|
|
CURRENT_TAU = CURRENT_TAU - JD93_85
|
|
! write(*,'(A15, f30.15)') 'CURRENT_TAU',CURRENT_TAU
|
|
|
|
! Change TAU units ( hours => second )
|
|
CURRENT_TAU = CURRENT_TAU * 3600D0
|
|
! write(*,'(A15, f30.15)') 'CURRENT_TAU',CURRENT_TAU
|
|
|
|
! Get half time window
|
|
HALF_TIME_WINDOW = TIME_WINDOW / 2D0
|
|
HALF_TIME_WINDOW = HALF_TIME_WINDOW * 60D0 ! ( minute => second )
|
|
! write(*, '(A15, f30.15)') 'HALF_TIME_WINDOW',HALF_TIME_WINDOW
|
|
|
|
! Get current time window
|
|
WINDOW_BEGIN = CURRENT_TAU - HALF_TIME_WINDOW
|
|
WINDOW_END = CURRENT_TAU + HALF_TIME_WINDOW
|
|
|
|
! write(*, '(A15,f30.15)') 'WINDOW_BEGIN',WINDOW_BEGIN
|
|
! write(*, '(A15,f30.15)') 'WINDOW_END',WINDOW_END
|
|
|
|
#if defined( NESTED_CH ) || defined( NESTED_NA ) || defined( NESTED_SD )
|
|
XEDGE_MIN = GET_XEDGE( 1 )
|
|
XEDGE_MAX = GET_XEDGE( IIPAR+1 )
|
|
YEDGE_MIN = GET_YEDGE( 1 )
|
|
YEDGE_MAX = GET_YEDGE( JJPAR+1 )
|
|
PRINT*, 'Nested region edge limit'
|
|
PRINT*, 'XEDGE_MIN: ', XEDGE_MIN
|
|
PRINT*, 'XEDGE_MAX: ', XEDGE_MAX
|
|
PRINT*, 'YEDGE_MIN: ', YEDGE_MIN
|
|
PRINT*, 'YEDGE_MAX: ', YEDGE_MAX
|
|
#endif
|
|
! Write(*, '(f30.15)') OMI_SO2(1:10)%TIME
|
|
N_CURR = 0
|
|
! Find observations in current time window and simulation area
|
|
DO NT = 1, N_SO2, 1
|
|
|
|
IF ( ( OMI_SO2(NT)%TIME >= WINDOW_BEGIN )
|
|
& .AND. ( OMI_SO2(NT)%TIME < WINDOW_END )
|
|
#if defined( NESTED_CH ) || defined( NESTED_NA ) || defined( NESTED_SD )
|
|
& .AND. ( OMI_SO2(NT)%LON >= XEDGE_MIN )
|
|
& .AND. ( OMI_SO2(NT)%LON <= XEDGE_MAX )
|
|
& .AND. ( OMI_SO2(NT)%LAT >= YEDGE_MIN )
|
|
& .AND. ( OMI_SO2(NT)%LAT <= YEDGE_MAX )
|
|
#endif
|
|
& ) THEN
|
|
|
|
|
|
FLAGS(NT) = .TRUE.
|
|
|
|
N_CURR = N_CURR + 1
|
|
|
|
ELSE
|
|
|
|
FLAGS(NT) = .FALSE.
|
|
|
|
END IF
|
|
|
|
END DO
|
|
|
|
WRITE(6, 100) N_CURR, GET_NHMS()
|
|
100 FORMAT(' Number of OMI SO2 observations: ' I10 ' at ' I10.6)
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE GET_OBS
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE CALC_CMA( I, J, GC_SO2_CONC, GC_CMA )
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine CALC_CMA calculate GEOS-Chem Center Mass of Altitude (
|
|
! The height where SO2 reach its maximum value )
|
|
! (ywang, 07/17/14)
|
|
!
|
|
! Arguements as Input:
|
|
! ===========================================================================
|
|
! ( 1) I (INTEGER) : LON INDEX
|
|
! ( 2) J (INTEGER) : LAT INDEX
|
|
! ( 3) GC_SO2_CONC(LLPAR) (REAL*8) : SO2 concentration at each layer
|
|
! Arguements as Output:
|
|
! ===========================================================================
|
|
! ( 1) GC_CMA (REAL*8) : Center Mass of Altitude (km)
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE DAO_MOD, ONLY : BXHEIGHT
|
|
|
|
! Arguements
|
|
INTEGER, INTENT( IN) :: I, J
|
|
REAL*8, INTENT( IN) :: GC_SO2_CONC(LLPAR)
|
|
REAL*8, INTENT(OUT) :: GC_CMA
|
|
|
|
! Local variabls
|
|
INTEGER :: L, MAX_SO2_L
|
|
|
|
!=================================================================
|
|
! CALC_CMA begins here!
|
|
!=================================================================
|
|
|
|
MAX_SO2_L = 1
|
|
|
|
! Find the layer SO2 concentration reaches its maximum value
|
|
DO L = 2, LLPAR, 1
|
|
|
|
IF ( GC_SO2_CONC(L) > GC_SO2_CONC(MAX_SO2_L) ) THEN
|
|
|
|
MAX_SO2_L = L
|
|
|
|
END IF
|
|
|
|
END DO
|
|
! MAX_SO2_L = MAXLOC( GC_SO2_CONC )
|
|
|
|
! Calculate CMA
|
|
GC_CMA = 0D0
|
|
IF ( MAX_SO2_L == 1) THEN
|
|
|
|
GC_CMA = BXHEIGHT(I,J,MAX_SO2_L) / 2D0
|
|
|
|
ELSE
|
|
|
|
DO L = 1, MAX_SO2_L-1, 1
|
|
|
|
GC_CMA = GC_CMA + BXHEIGHT(I,J,L)
|
|
|
|
END DO
|
|
|
|
GC_CMA = GC_CMA + BXHEIGHT(I,J,MAX_SO2_L) / 2D0
|
|
|
|
END IF
|
|
|
|
! m => km
|
|
GC_CMA = GC_CMA / 1000D0
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CALC_CMA
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE DETERMINE_OBS( GC_CMA, NT )
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine DETERMINE_OBS finds the OMI SO2 observation whose CMA is
|
|
! closest to GEOS-Chem CMA
|
|
! (ywang, 07/18/14)
|
|
!
|
|
! Arguements as Input:
|
|
! ===========================================================================
|
|
! ( 1) GC_CMA (REAL*8 ) : GEOS-Chem Center Mass of Altitude (km)
|
|
! ( 2) NT (INTEGER) : OMI_SO2 index
|
|
! 1: PBL, 2: TRL, 3: TRM
|
|
!
|
|
! Moudule variables as Output:
|
|
! ( 1) OMI_SO2(NT)%SO2 (REAL*8) : OMI SO2 will be used
|
|
! ( 2) OMI_SO2(NT)%ERR (REAL*8) : OMI SO2 error will be used
|
|
!! ( 3) OMI_SO2(NT)%MARK (INTEGER) : Marks of which observation is
|
|
! expected
|
|
! ( 4) OMI_SO2(NT)%OPT (INTEGER) : Mark of which observation whose CMA
|
|
! is close to GEOS-Chem CMA, though the observation may not exists
|
|
! ( 5) OMI_SO2(NT)%FLAG (INTEGER) : Does the observartion expected
|
|
! really exist? 0: not exist, 1: exist
|
|
!
|
|
! Notes:
|
|
! ( 1) The alogrithm is changed. Now if the expected obsevation does
|
|
! not exit, we shall not use other observation to substutite it.
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Parameters
|
|
! ! PBL_CMA, TRL_CMA, and TRM_CMA references to moudle note 2
|
|
! REAL*8, PARAMETER :: PBL_CMA = 0.9D0 ! units: km
|
|
! REAL*8, PARAMETER :: TRL_CMA = 2.5D0 ! units: km
|
|
! REAL*8, PARAMETER :: TRM_CMA = 7.5D0 ! units: km
|
|
REAL*8, PARAMETER :: MIN_PBL = 0.0D0 ! units: km
|
|
REAL*8, PARAMETER :: MAX_PBL = 1.7D0 ! units: km
|
|
REAL*8, PARAMETER :: MIN_TRL = MAX_PBL
|
|
REAL*8, PARAMETER :: MAX_TRL = 5.0D0 ! units: km
|
|
REAL*8, PARAMETER :: MIN_TRM = MAX_TRL
|
|
REAL*8, PARAMETER :: MAX_TRM = 10.0D0 ! units: km
|
|
|
|
! minimum valid observations
|
|
REAL*8, PARAMETER :: MIN_VAL = -10.0 ! units: DU
|
|
|
|
REAL*8, PARAMETER :: UNDEF = -999.0D0
|
|
|
|
! Arguments
|
|
REAL*8, INTENT( IN) :: GC_CMA
|
|
INTEGER, INTENT( IN) :: NT
|
|
|
|
! ! Local variables
|
|
! REAL*8 :: DIST1(3), DIST2(3)
|
|
! INTEGER :: I(1)
|
|
|
|
!=================================================================
|
|
! DETERMINE_OBS begins here!
|
|
!=================================================================
|
|
|
|
! ! for OPT
|
|
! DIST1(1) = ABS( GC_CMA-PBL_CMA )
|
|
! DIST1(2) = ABS( GC_CMA-TRL_CMA )
|
|
! DIST1(3) = ABS( GC_CMA-TRM_CMA )
|
|
|
|
! I = MINLOC( DIST1 )
|
|
!
|
|
! SELECT CASE ( I(1) )
|
|
!
|
|
! CASE ( 1 )
|
|
! OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_PBL
|
|
! OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_PBL
|
|
!
|
|
! CASE ( 2 )
|
|
! OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_TRL
|
|
! OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_TRL
|
|
! CASE ( 3 )
|
|
! OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_TRM
|
|
! OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_TRM
|
|
!
|
|
! CASE DEFAULT
|
|
! PRINT*, 'DETERMINE_OBS ERROR'
|
|
! STOP
|
|
!
|
|
! END SELECT
|
|
!
|
|
! OMI_SO2(NT)%OPT = I(1)
|
|
|
|
! ! for MARK
|
|
! DIST2 = 1D10
|
|
! IF ( OMI_SO2(NT)%SO2_PBL > 0.0 ) DIST2(1) = ABS( GC_CMA-PBL_CMA )
|
|
! IF ( OMI_SO2(NT)%SO2_TRL > 0.0 ) DIST2(2) = ABS( GC_CMA-TRL_CMA )
|
|
! IF ( OMI_SO2(NT)%SO2_TRM > 0.0 ) DIST2(3) = ABS( GC_CMA-TRM_CMA )
|
|
!
|
|
! I = MINLOC( DIST2 )
|
|
!
|
|
! SELECT CASE ( I(1) )
|
|
!
|
|
! CASE ( 1 )
|
|
! OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_PBL
|
|
! OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_PBL
|
|
!
|
|
! CASE ( 2 )
|
|
! OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_TRL
|
|
! OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_TRL
|
|
! CASE ( 3 )
|
|
! OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_TRM
|
|
! OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_TRM
|
|
!
|
|
! CASE DEFAULT
|
|
! PRINT*, 'DETERMINE_OBS ERROR'
|
|
! STOP
|
|
!
|
|
! END SELECT
|
|
!
|
|
! OMI_SO2(NT)%MARK = I(1)
|
|
|
|
OMI_SO2(NT)%SO2 = UNDEF
|
|
OMI_SO2(NT)%ERR = UNDEF
|
|
|
|
IF ( (GC_CMA >= MIN_PBL) .AND. (GC_CMA < MAX_PBL) ) THEN
|
|
|
|
OMI_SO2(NT)%OPT = 1
|
|
|
|
IF ( OMI_SO2(NT)%SO2_PBL >= MIN_VAL ) THEN
|
|
OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_PBL
|
|
OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_PBL
|
|
END IF
|
|
|
|
ELSE IF ( (GC_CMA >= MIN_TRL) .AND. (GC_CMA < MAX_TRL) ) THEN
|
|
|
|
OMI_SO2(NT)%OPT = 2
|
|
|
|
IF ( OMI_SO2(NT)%SO2_TRL >= MIN_VAL ) THEN
|
|
OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_TRL
|
|
OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_TRL
|
|
END IF
|
|
|
|
ELSE IF ( (GC_CMA >= MIN_TRM) .AND. (GC_CMA < MAX_TRM) ) THEN
|
|
|
|
OMI_SO2(NT)%OPT = 3
|
|
|
|
IF ( OMI_SO2(NT)%SO2_TRM >= MIN_VAL ) THEN
|
|
OMI_SO2(NT)%SO2 = OMI_SO2(NT)%SO2_TRM
|
|
OMI_SO2(NT)%ERR = OMI_SO2(NT)%ERR_TRM
|
|
END IF
|
|
|
|
ELSE
|
|
|
|
OMI_SO2(NT)%OPT = 0
|
|
|
|
END IF
|
|
|
|
IF ( OMI_SO2(NT)%SO2 > MIN_VAL ) THEN
|
|
|
|
OMI_SO2(NT)%FLAG = 1
|
|
|
|
ELSE
|
|
|
|
OMI_SO2(NT)%FLAG = 0
|
|
|
|
END IF
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE DETERMINE_OBS
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE CHECK( STATUS, LOCATION )
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine CHECK checks the status of calls to netCDF libraries
|
|
! routines
|
|
! (dkh, 02/15/09)
|
|
!
|
|
! Arguments as Input:
|
|
! ===========================================================================
|
|
! (1 ) STATUS (INTEGER) : Completion status of netCDF library call
|
|
! (2 ) LOCATION (INTEGER) : Location at which netCDF library call was
|
|
! made
|
|
!
|
|
! NOTES:
|
|
!
|
|
!*****************************************************************************
|
|
!
|
|
! Reference to f90 modules
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE NETCDF
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: STATUS
|
|
INTEGER, INTENT(IN) :: LOCATION
|
|
|
|
!=================================================================
|
|
! CHECK begins here!
|
|
!=================================================================
|
|
|
|
IF ( STATUS /= NF90_NOERR ) THEN
|
|
WRITE(6,*) TRIM( NF90_STRERROR( STATUS ) )
|
|
WRITE(6,*) 'At location = ', LOCATION
|
|
CALL ERROR_STOP('netCDF error', 'omi_so2_mod')
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CHECK
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE NCIO_1D (NCID, VAR1D, VARNAME, LONGNAME, VARUNIT,
|
|
& DIMID, DIMV, INDEX)
|
|
|
|
! References to F90 modules
|
|
USE NETCDF
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NCID, DIMID, DIMV, INDEX
|
|
REAL*4, INTENT(IN) :: VAR1D(DIMV)
|
|
CHARACTER(LEN=*), INTENT(IN) :: VARNAME, LONGNAME, VARUNIT
|
|
|
|
! Local variable
|
|
INTEGER :: DIMS(1)
|
|
INTEGER :: VAR_ID
|
|
|
|
CALL CHECK( NF90_REDEF(NCID), INDEX )
|
|
|
|
DIMS(1) = DIMID
|
|
CALL CHECK( NF90_DEF_VAR(NCID, TRIM(VARNAME),
|
|
& NF90_FLOAT, DIMS, VAR_ID), INDEX)
|
|
CALL CHECK( NF90_PUT_ATT(NCID,VAR_ID,"name",TRIM(LONGNAME)),INDEX)
|
|
CALL CHECK( NF90_PUT_ATT(NCID,VAR_ID,"units",TRIM(VARUNIT)),INDEX)
|
|
CALL CHECK( NF90_ENDDEF(NCID), INDEX )
|
|
CALL CHECK( NF90_PUT_VAR(NCID, VAR_ID, VAR1D ), INDEX )
|
|
|
|
END SUBROUTINE NCIO_1D
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE NCIO_1D_DBL (NCID, VAR1D, VARNAME, LONGNAME, VARUNIT,
|
|
& DIMID, DIMV, INDEX)
|
|
|
|
! References to F90 modules
|
|
USE NETCDF
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NCID, DIMID, DIMV, INDEX
|
|
REAL*8, INTENT(IN) :: VAR1D(DIMV)
|
|
CHARACTER(LEN=*), INTENT(IN) :: VARNAME, LONGNAME, VARUNIT
|
|
|
|
! Local variable
|
|
INTEGER :: DIMS(1)
|
|
INTEGER :: VAR_ID
|
|
|
|
CALL CHECK( NF90_REDEF(NCID), INDEX )
|
|
|
|
DIMS(1) = DIMID
|
|
CALL CHECK( NF90_DEF_VAR(NCID, TRIM(VARNAME),
|
|
& NF90_DOUBLE, DIMS, VAR_ID), INDEX)
|
|
CALL CHECK( NF90_PUT_ATT(NCID,VAR_ID,"name",TRIM(LONGNAME)),INDEX)
|
|
CALL CHECK( NF90_PUT_ATT(NCID,VAR_ID,"units",TRIM(VARUNIT)),INDEX)
|
|
CALL CHECK( NF90_ENDDEF(NCID), INDEX )
|
|
CALL CHECK( NF90_PUT_VAR(NCID, VAR_ID, VAR1D ), INDEX )
|
|
|
|
END SUBROUTINE NCIO_1D_DBL
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
SUBROUTINE NCIO_1D_INT (NCID, VAR1D, VARNAME, LONGNAME, VARUNIT,
|
|
& DIMID, DIMV, INDEX)
|
|
|
|
! References to F90 modules
|
|
USE NETCDF
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NCID, DIMID, DIMV, INDEX
|
|
INTEGER, INTENT(IN) :: VAR1D(DIMV)
|
|
CHARACTER(LEN=*), INTENT(IN) :: VARNAME, LONGNAME, VARUNIT
|
|
|
|
! Local variable
|
|
INTEGER :: DIMS(1)
|
|
INTEGER :: VAR_ID
|
|
|
|
CALL CHECK( NF90_REDEF(NCID), INDEX )
|
|
|
|
DIMS(1) = DIMID
|
|
CALL CHECK( NF90_DEF_VAR(NCID, TRIM(VARNAME),
|
|
& NF90_INT, DIMS, VAR_ID), INDEX)
|
|
CALL CHECK( NF90_PUT_ATT(NCID,VAR_ID,"name",TRIM(LONGNAME)),INDEX)
|
|
CALL CHECK( NF90_PUT_ATT(NCID,VAR_ID,"units",TRIM(VARUNIT)),INDEX)
|
|
CALL CHECK( NF90_ENDDEF(NCID), INDEX )
|
|
CALL CHECK( NF90_PUT_VAR(NCID, VAR_ID, VAR1D ), INDEX )
|
|
|
|
END SUBROUTINE NCIO_1D_INT
|
|
!
|
|
!-----------------------------------------------------------------------------
|
|
!
|
|
END MODULE OMI_SO2_OBS_MOD
|