forked from geoschem/geos-chem
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtoms_mod.F90
306 lines (291 loc) · 12.4 KB
/
toms_mod.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !MODULE: toms_mod.F90
!
! !DESCRIPTION: Module TOMS\_MOD contains variables and routines for reading
! the TOMS/SBUV O3 column data from disk (for use w/ the FAST-J photolysis
! routines).
!\\
!\\
! !INTERFACE:
!
MODULE TOMS_MOD
!
! !USES:
!
USE PRECISION_MOD ! For GEOS-Chem Precision (fp)
USE ErrCode_Mod
IMPLICIT NONE
PRIVATE
!
! !PUBLIC MEMBER FUNCTIONS:
!
PUBLIC :: COMPUTE_OVERHEAD_O3
PUBLIC :: GET_OVERHEAD_O3
!
! !PUBLIC DATA MEMBERS:
!
! First & last years for which TOMS/SBUV data is is available
! (update these as new data is added to the archive)
INTEGER, PUBLIC, PARAMETER :: FIRST_TOMS_YEAR = 1979
INTEGER, PUBLIC, PARAMETER :: LAST_TOMS_YEAR = 2010
!
! !REMARKS:
! References:
! ============================================================================
! Version 8 Merged Ozone Data Sets
! Total Ozone Revision 05
! DATA THROUGH: MAR 2009
! LAST MODIFIED: 01 MAY 2009
! .
! http://acdb-ext.gsfc.nasa.gov/Data_services/merged/index.html
! .
! TOMS/SBUV MERGED TOTAL OZONE DATA, Version 8, Revision 5.
! Resolution: 5 x 10 deg.
! .
! * Includes reprocessed N16 and N17 SBUV/2 data using latest calibration.
! * OMI data updated from Collection 2 to Collection 3.
! * New offsets derived based on revised data sets.
! * 1970-1972 N4 BUV data added with no adjustments. User may wish to apply
! offset based on Comparisons between BUV and Dobson Measurements.
! .
! Responsible NASA official:
! Dr. Richard Stolarski (Richard.S.Stolarski@nasa.gov)
! Stacey Frith (Stacey.M.Frith@nasa.gov )
!
! !REVISION HISTORY:
! 14 Jul 2003 - R. Yantosca - Initial version
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
CONTAINS
!EOC
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: compute_overhead_o3
!
! !DESCRIPTION: Subroutine COMPUTE\_OVERHEAD\_O3 returns the resultant total
! overhead O3 column for the FAST-J photolysis. This will be one of two
! options:
! \begin{enumerate}
! \item Default: TOMS/SBUV overhead O3 columns. These will be used be
! the FAST-J routine set\_prof.F90 to overwrite the existing FAST-J
! climatology (cf McPeters \& Nagatani 1992). Missing data (i.e.
! for months \& locations where TOMS/SBUV data does not exist)
! is denoted by the value -999; FAST-J will skip over these points.
! \item Overhead O3 columns taken directly from the met fields. These
! will be returned if the flag USE\_O3\_FROM\_MET is set to TRUE.
! \end{enumerate}
!
! !INTERFACE:
!
SUBROUTINE COMPUTE_OVERHEAD_O3( Input_Opt, State_Grid, State_Chm, &
DAY, USE_O3_FROM_MET, TO3, &
RC )
!
! !USES:
!
USE HCO_Utilities_GC_Mod, ONLY : HCO_GC_EvalFld
USE Input_Opt_Mod, ONLY : OptInput
USE State_Grid_Mod, ONLY : GrdState
USE State_Chm_Mod, ONLY : ChmState
!
! !INPUT PARAMETERS:
!
TYPE(OptInput), INTENT(IN) :: Input_Opt ! Input Options
TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State
INTEGER, INTENT(IN) :: DAY ! Day of month
LOGICAL, INTENT(IN) :: USE_O3_FROM_MET ! Use TO3 rom met?
REAL(fp), INTENT(IN) :: TO3(State_Grid%NX, &
State_Grid%NY) ! Met TO3 [Dobsons]
!
! !INPUT/OUTPUT PARAMETERS
!
TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State
!
! !OUTPUT PARAMETERS:
!
INTEGER, INTENT(OUT) :: RC ! Success/failure?
!
! !REMARKS:
! Reference for the TOMS/SBUV merged O3 columns:
! .
! 1985 - 2005 are taken from:
! .
! http://code916.gsfc.nasa.gov/Data_services/merged/index.html
! .
! TOMS/SBUV MERGED TOTAL OZONE DATA, Version 8, Revision 3.
! Resolution: 5 x 10 deg.
! .
! Contact person for the merged data product:
! Stacey Hollandsworth Frith (smh@hyperion.gsfc.nasa.gov)
! .
! 2006 and 2007 are taken from:
! .
! http://code916.gsfc.nasa.gov/Data_services/merged/index.html
! .
! Version 8 Merged Ozone Data Sets
! Revision 04
! DATA THROUGH: SEP 2008
! LAST MODIFIED: 20 OCT 2008
! .
! Methodology (bmy, 2/12/07)
! ----------------------------------------------------------------
! FAST-J comes with its own default O3 column climatology (from
! McPeters 1992 & Nagatani 1991), which is stored in the input
! file "jv_atms.dat". These "FAST-J default" O3 columns are used
! in the computation of the actinic flux and other optical
! quantities for the FAST-J photolysis.
! .
! The TOMS/SBUV O3 columns and 1/2-monthly O3 trends (contained
! in the TOMS_200701 directory) are read into GEOS-Chem by routine
! READ_TOMS in "toms_mod.F90". Missing values (i.e. locations where
! there are no data) in the TOMS/SBUV O3 columns are defined by
! the flag -999.
! .
! After being read from disk in routine READ_TOMS, the TOMS/SBUV
! O3 data are then passed to the FAST-J routine "set_prof.F90". In
! "set_prof.F90", a test is done to make sure that the TOMS/SBUV O3
! columns and 1/2-monthly trends do not have any missing values
! for (lat,lon) location for the given month. If so, then the
! TOMS/SBUV O3 column data is interpolated to the current day and
! is used to weight the "FAST-J default" O3 column. This
! essentially "forces" the "FAST-J default" O3 column values to
! better match the observations, as defined by TOMS/SBUV.
! .
! If there are no TOMS/SBUV O3 columns (and 1/2-monthly trends)
! at a (lat,lon) location for given month, then FAST-J will revert
! to its own "default" climatology for that location and month.
! Therefore, the TOMS O3 can be thought of as an "overlay" data
! -- it is only used if it exists.
! .
! Note that there are no TOMS/SBUV O3 columns at the higher
! latitudes. At these latitudes, the code will revert to using
! the "FAST-J default" O3 columns.
! .
! As of February 2007, we have TOMS/SBUV data for 1979 thru 2005.
! 2006 TOMS/SBUV data is incomplete as of this writing. For years
! 2006 and onward, we use 2005 TOMS O3 columns.
! .
! This methodology was originally adopted by Mat Evans. Symeon
! Koumoutsaris was responsible for creating the downloading and
! processing the TOMS O3 data files from 1979 thru 2005 in the
! TOMS_200701 directory.
!
! !REVISION HISTORY:
! 06 Mar 2012 - R. Yantosca - Initial version, pulled code out from
! the FAST-J routine SET_PROF; based on the
! GEOS-Chem column code routine
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
LOGICAL, SAVE :: FIRST = .TRUE.
INTEGER :: I, J
CHARACTER(LEN=255) :: ErrMsg
! Assume success
RC = GC_SUCCESS
! Initialize
State_Chm%TO3_DAILY = 0e+0_fp
!=================================================================
! Now weight the O3 column by the observed monthly mean TOMS.
! Missing data is denoted by the flag -999. (mje, bmy, 7/15/03)
!=================================================================
IF ( USE_O3_FROM_MET ) THEN
!---------------------------------------------------------------
! Here we are using the overhead O3 from the meteorology;
! we won't overwrite this with TOMS/SBUV O3 columns
! NOTE: Only print if debug output is on (bmy, 05 Dec 2022)
!---------------------------------------------------------------
IF ( FIRST .and. Input_Opt%amIRoot .and. Input_Opt%Verbose ) THEN
WRITE( 6, '(a)' ) REPEAT( '%', 45 )
WRITE( 6, 100 )
100 FORMAT( '%%% USING O3 COLUMNS FROM THE MET FIELDS! %%% ' )
WRITE( 6, '(a)' ) REPEAT( '%', 45 )
FIRST = .FALSE.
ENDIF
! Get the overhead O3 column directly from the met field O3
State_Chm%TO3_DAILY = TO3
ELSE
! Evalulate the first day TOMS O3 columns from HEMCO
CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'TOMS1_O3_COL', State_Chm%TOMS1, RC )
IF ( RC /= GC_SUCCESS ) THEN
ErrMsg = 'Could not find TOMS1_O3_COL in HEMCO data list!'
CALL GC_Error( ErrMsg, RC, 'toms_mod.F' )
RETURN
ENDIF
! Evalulate the last day TOMS O3 columns from HEMCO
CALL HCO_GC_EvalFld( Input_Opt, State_Grid, 'TOMS2_O3_COL', State_Chm%TOMS2, RC )
IF ( RC /= GC_SUCCESS ) THEN
ErrMsg = 'Could not find TOMS2_O3_COL in HEMCO data list!'
CALL GC_Error( ErrMsg, RC, 'toms_mod.F' )
RETURN
ENDIF
!---------------------------------------------------------------
! Here we are returning the default FAST-J overhead O3
! climatology with the TOMS/SBUV O3 columns (where data exists)
!---------------------------------------------------------------
! Interpolate O3 to current day (w/in 2nd half of month)
!$OMP PARALLEL DO &
!$OMP PRIVATE( I, J ) &
!$OMP DEFAULT( SHARED )
DO J = 1, State_Grid%NY
DO I = 1, State_Grid%NX
State_Chm%TO3_DAILY(I,J) = State_Chm%TOMS1(I,J) + (DAY - 1) * &
( (State_Chm%TOMS2(I,J)-State_Chm%TOMS1(I,J))/30.0_fp )
ENDDO
ENDDO
!$OMP END PARALLEL DO
ENDIF
END SUBROUTINE COMPUTE_OVERHEAD_O3
!EOC
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: get_overhead_o3
!
! !DESCRIPTION: Function GET\_OVERHEAD\_O3 returns the total overhead O3
! column [DU] (which is taken either from TOMS/SBUV or directly from the
! met fields) at a given surface grid box location (I,J).
!\\
!\\
! !INTERFACE:
!
FUNCTION GET_OVERHEAD_O3( State_Chm, I, J ) RESULT( OVERHEAD_O3 )
!
! !USES:
!
USE State_Chm_Mod, ONLY : ChmState
!
! !INPUT PARAMETERS:
!
TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry State object
INTEGER :: I ! Grid box longitude index
INTEGER :: J ! Grid box latitude index
!
! !RETURN VALUE:
!
REAL(fp) :: OVERHEAD_O3 ! Total overhead O3 column [DU]
!
! !REVISION HISTORY:
! 06 Mar 2012 - R. Yantosca - Initial version
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
OVERHEAD_O3 = State_Chm%TO3_DAILY(I,J)
END FUNCTION GET_OVERHEAD_O3
!EOC
END MODULE TOMS_MOD