forked from geoschem/geos-chem
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsfcvmr_mod.F90
401 lines (357 loc) · 12.4 KB
/
sfcvmr_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
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !MODULE: sfcvmr_mod.F90
!
! !DESCRIPTION: Module sfcvmr\_mod.F90 is a simple module which forces
! surface concentrations of relevant species to values read from an external
! file (via HEMCO). The names of the corresponding HEMCO configuration file
! entries need to be composed of the below defined prefix and the species
! name, e.g.:
!
! * SfcVMR_CH3Cl $ROOT/CMIP6/v2019-09//LIVE/CMIP6_GHG_surface_VMR_1750_2014_for_CH3Cl.nc CH3Cl 1750-2014/1-12/1/0 C xy ppbv * 801 1 1
! * SfcVMR_CH2Cl2 $ROOT/CMIP6/v2019-09//LIVE/CMIP6_GHG_surface_VMR_1750_2014_for_CH2Cl2.nc CH2Cl2 1750-2014/1-12/1/0 C xy ppbv * 801 1 1
! * SfcVMR_CHCl3 $ROOT/CMIP6/v2019-09//LIVE/CMIP6_GHG_surface_VMR_1750_2014_for_CHCl3.nc CHCl3 1750-2014/1-12/1/0 C xy ppbv * 801 1 1
! * SfcVMR_CH3Br /LIVE/CMIP6_GHG_surface_VMR_1750_2014_for_CH3Br.nc CH3Br 1750-2014/1-12/1/0 C xy ppbv * 801 1 1
!
! The concentrations in the file are expected to be in units of ppbv.
! It is also possible to apply scale factors to these fields, e.g. (to scale surface concentrations by 2):
! * SfcVMR_CH3Cl $ROOT/CMIP6/v2019-09//LIVE/CMIP6_GHG_surface_VMR_1750_2014_for_CH3Cl.nc CH3Cl 1750-2014/1-12/1/0 C xy ppbv * 801 1 1
! ...
! # Scale the CMIP6 values in pptv to ppbv
! 802 SfcVMR_ScaleFactor 0.001 - - - xy unitless 1
!
!\\
!\\
! !INTERFACE:
!
MODULE SfcVmr_Mod
!
! !USES:
!
USE PhysConstants ! Physical constants
USE Precision_Mod ! For GEOS-Chem Precision (fp)
IMPLICIT NONE
PRIVATE
!
! !PUBLIC MEMBER FUNCTIONS:
!
PUBLIC :: FixSfcVmr_Run
PUBLIC :: FixSfcVmr_Final
!
! !PRIVATE MEMBER FUNCTIONS:
!
PRIVATE :: FixSfcVmr_Init
!
! !REVISION HISTORY:
! 24 Dec 2016 - S. D. Eastham - Initial version.
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !PRIVATE TYPES:
!
! Linked list type
TYPE :: SfcMrObj
CHARACTER(LEN=63) :: FldName ! Field name
INTEGER :: SpcID ! ID in species database
TYPE(SfcMrObj), POINTER :: Next ! Next element in list
END TYPE SfcMrObj
! Heat of linked list with SfcMrObj objects
TYPE(SfcMrObj), POINTER :: SfcMrHead => NULL()
! Field prefix
CHARACTER(LEN=63), PARAMETER :: Prefix = 'SfcVMR_'
CONTAINS
!EOC
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: FixSfcVmr_Init
!
! !DESCRIPTION: Subroutine FixSfcVmr_Init initializes the SfcMr objects.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE FixSfcVmr_Init( Input_Opt, State_Chm, State_Grid, State_Met, RC )
!
! !USES:
!
USE ErrCode_Mod
USE Input_Opt_Mod, ONLY : OptInput
USE State_Met_Mod, ONLY : MetState
USE State_Chm_Mod, ONLY : ChmState
USE State_Grid_Mod, ONLY : GrdState
USE Species_Mod, ONLY : Species
USE HCO_Utilities_GC_Mod, ONLY : HCO_GC_EvalFld
!
! !INPUT PARAMETERS:
!
TYPE(MetState), INTENT(IN) :: State_Met ! Met state
TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object
TYPE(ChmState), INTENT(IN) :: State_Chm ! Chemistry state
!
! !INPUT/OUTPUT PARAMETERS:
!
TYPE(OptInput), INTENT(INOUT) :: Input_Opt ! Input opts
!
! !OUTPUT PARAMETERS:
!
INTEGER, INTENT(OUT) :: RC ! Failure or success
!
! !REVISION HISTORY:
! 16 Aug 2019 - C. Keller - Updated version
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
! Scalars
LOGICAL :: FOUND
INTEGER :: N
! Strings
CHARACTER(LEN=63) :: FldName
CHARACTER(LEN=255) :: ErrMsg
CHARACTER(LEN=255) :: ThisLoc
! Arrays
REAL(fp) :: Arr2D(State_Grid%NX,State_Grid%NY)
! Pointers
TYPE(Species), POINTER :: SpcInfo
TYPE(SfcMrObj), POINTER :: iSfcMrObj
!=================================================================
! FIXSFCVMR_Init begins here!
!=================================================================
! Initialize
RC = GC_SUCCESS
ErrMsg = ''
ThisLoc = ' --> at fixSfcVMR_Init (in module GeosCore/sfcvmr_mod.F90)'
iSfcMrObj => NULL()
SpcInfo => NULL()
! Verbose output -- only when debug printout is on (bmy, 05 Dec 2022)
IF ( Input_Opt%amIRoot .and. Input_Opt%Verbose ) THEN
WRITE( 6, 100 )
100 FORMAT('--- Initialize surface boundary conditions from input file ---')
ENDIF
! Head of linked list
SfcMrHead => NULL()
! Loop over all species
DO N = 1, State_Chm%nSpecies
! Species information
SpcInfo => State_Chm%SpcData(N)%Info
! Check if file exists
FldName = TRIM( Prefix ) // TRIM( SpcInfo%Name )
CALL HCO_GC_EvalFld( Input_Opt, State_Grid, TRIM(FldName), Arr2D, RC, FOUND=FOUND )
IF ( RC /= GC_SUCCESS ) THEN
ErrMsg = 'Could not find field : ' // TRIM( FldName )
CALL GC_Error( ErrMsg, RC, ThisLoc )
RETURN
ENDIF
! Add to linked list if necessary
IF ( FOUND ) THEN
! Must have positive, non-zero MW
IF ( SpcInfo%MW_g <= 0.0_fp ) THEN
ErrMsg = 'Cannot use surface boundary condition for species ' &
// TRIM(SpcInfo%Name) // ' due to invalid MW!'
CALL GC_Error( ErrMsg, RC, ThisLoc )
RETURN
ENDIF
! Create new object, add to list
ALLOCATE( iSfcMrObj, STAT=RC )
CALL GC_CheckVar( 'sfcvmr_mod.F90:iSfcMrObj', 0, RC )
IF ( RC /= GC_SUCCESS ) RETURN
iSfcMrObj%SpcID = N
iSfcMrObj%FldName = TRIM(Prefix)//TRIM(SpcInfo%Name)
iSfcMrObj%Next => SfcMrHead
SfcMrHead => iSfcMrObj
! Only write messages if debug printout is on (bmy, 05 Dec 2022)
IF ( Input_Opt%amIRoot .and. Input_Opt%Verbose) THEN
WRITE( 6, 110 ) TRIM( SpcInfo%Name ), TRIM( iSfcMrObj%FldName )
110 FORMAT( '--> ', a, ' will use prescribed surface boundary ', &
'conditions from field ', a )
ENDIF
! Free the pointer
iSfcMrObj => NULL()
ENDIF
! Indicate success
RC = GC_SUCCESS
ENDDO
! If successful, print message
! Now only print when debug printout is on (bmy, 05 Dec 2022)
IF ( Input_Opt%amIRoot .and. Input_Opt%Verbose .AND. RC == GC_SUCCESS) THEN
WRITE( 6, 120 )
120 FORMAT( '--- Finished initializing surface boundary conditions ---' )
ENDIF
END SUBROUTINE fixSfcVMR_Init
!EOC
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: FixSfcVmr_Run
!
! !DESCRIPTION: Subroutine FIXSFCVMR_Run fixes the VMR of selected species
! throughout the PBL to observed values.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE FixSfcVmr_Run( Input_Opt, State_Chm, State_Grid, State_Met, RC )
!
! !USES:
!
USE ErrCode_Mod
USE Input_Opt_Mod, ONLY : OptInput
USE State_Met_Mod, ONLY : MetState
USE State_Chm_Mod, ONLY : ChmState
USE State_Grid_Mod, ONLY : GrdState
USE State_Chm_Mod, ONLY : Ind_
USE Species_Mod, ONLY : Species, SpcConc
USE HCO_Utilities_GC_Mod, ONLY : HCO_GC_EvalFld
USE TIME_MOD, ONLY : Get_Month
! Needed for the new CHxCly boundary condition
Use PhysConstants, ONLY : AirMW
!
! !INPUT PARAMETERS:
!
TYPE(GrdState), INTENT(IN) :: State_Grid ! Grid State object
TYPE(MetState), INTENT(IN) :: State_Met ! Met State object
!
! !INPUT/OUTPUT PARAMETERS:
!
TYPE(ChmState), INTENT(INOUT) :: State_Chm ! Chemistry State object
TYPE(OptInput), INTENT(INOUT) :: Input_Opt ! Input Options object
INTEGER, INTENT(INOUT) :: RC ! Failure or success
!
! !REVISION HISTORY:
! 27 Aug 2014 - C. Keller - Initial version
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
! SAVEd scalars
LOGICAL, SAVE :: FIRST = .TRUE.
! Scalars
INTEGER :: I, J, L, MONTH
INTEGER :: id_Spc
! Strings
CHARACTER(LEN=255) :: ErrMsg
CHARACTER(LEN=255) :: ThisLoc
! Arrays
REAL(fp) :: Arr2D(State_Grid%NX,State_Grid%NY)
! Pointers
TYPE(SpcConc), POINTER :: Spc(:) ! Ptr to species array
TYPE(Species), POINTER :: SpcInfo ! Ptr to species database
TYPE(SfcMrObj), POINTER :: iObj ! Linked list
!=======================================================================
! FIXSFCVMR_Run begins here!
!=======================================================================
! Assume success
RC = GC_SUCCESS
ErrMsg = ''
ThisLoc = ' -> at FixSfcVmrRun (in module GeosCore/sfcvmr_mod.F90)'
! Initialize object if needed
IF ( FIRST ) THEN
CALL FixSfcVMR_Init( Input_Opt, State_Chm, State_Grid, State_Met, RC )
IF ( RC /= GC_SUCCESS ) THEN
ErrMsg = 'Error encountered in routine "FixSfcVmrInit"!'
CALL GC_Error( ErrMsg, RC, ThisLoc )
RETURN
ENDIF
! Reset first-time flag
FIRST = .FALSE.
ENDIF
! Get a pointer to the species array
Spc => State_Chm%Species
! Loop over all objects
iObj => SfcMrHead
DO WHILE( ASSOCIATED( iObj ) )
! Get concentration for this species
CALL HCO_GC_EvalFld( Input_Opt, State_Grid, Trim(iObj%FldName), Arr2D, RC )
IF ( RC /= GC_SUCCESS ) THEN
ErrMsg = 'Could not get surface VMR for species: '// &
TRIM( iObj%FldName ) // '!'
CALL GC_Error( ErrMsg, RC, ThisLoc )
RETURN
ENDIF
! Set mixing ratio in PBL
SpcInfo => State_Chm%SpcData(iObj%SpcID)%Info
id_Spc = SpcInfo%ModelID
IF ( id_Spc > 0 ) THEN
DO L = 1, State_Grid%NZ
DO J = 1, State_Grid%NY
DO I = 1, State_Grid%NX
IF ( State_Met%F_UNDER_PBLTOP(I,J,L) > 0.0_fp ) THEN
Spc(id_Spc)%Conc(I,J,L) = ( Arr2d(I,J) * 1.0e-9_fp ) &
/ ( AIRMW / SpcInfo%MW_g )
ENDIF ! end selection of PBL boxes
ENDDO
ENDDO
ENDDO
ENDIF
! Point to next element in list
iObj => iObj%Next
ENDDO
! Free pointer
Spc => NULL()
END SUBROUTINE FixSfcVmr_Run
!EOC
!------------------------------------------------------------------------------
! GEOS-Chem Global Chemical Transport Model !
!------------------------------------------------------------------------------
!BOP
!
! !IROUTINE: FixSfcVmr_Final
!
! !DESCRIPTION: Subroutine FIXSFCVMR_Final cleans up the FixSfcMR linked list.
!\\
!\\
! !INTERFACE:
!
SUBROUTINE FixSfcVmr_Final( RC )
!
! !USES:
!
USE ErrCode_Mod
!
! !OUTPUT PARAMETERS:
!
INTEGER, INTENT(OUT) :: RC ! Failure or success
!
! !REVISION HISTORY:
! 16 Aug 2019 - C. Keller - Updated version
! See https://github.com/geoschem/geos-chem for complete history
!EOP
!------------------------------------------------------------------------------
!BOC
!
! !LOCAL VARIABLES:
!
! Pointers
TYPE(SfcMrObj), POINTER :: iObj
TYPE(SfcMrObj), POINTER :: iObjNext
! Initialize
RC = GC_SUCCESS
iObj => NULL()
iObjNext => NULL()
! Loop over all objects and deallocate
iObj => SfcMrHead
DO WHILE( ASSOCIATED( iObj ) )
iObjNext => iObj%Next
iObj%Next => NULL()
IF ( ASSOCIATED( iObj ) ) DEALLOCATE(iObj)
iObj => iObjNext
ENDDO
END SUBROUTINE FixSfcVmr_Final
!EOC
END MODULE SfcVmr_Mod