Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_interface_common
7 : !
8 : ! !DESCRIPTION: Module HCO\_Interface\_Common defines common utilities for interfacing
9 : ! with HEMCO from other models. The common toolbox should be present for all
10 : ! models interacting with HEMCO.
11 : !\\
12 : !\\
13 : ! !INTERFACE:
14 : !
15 : MODULE HCO_Interface_Common
16 : !
17 : ! !USES:
18 : !
19 : USE HCO_Error_Mod
20 : USE HCO_State_Mod, ONLY: HCO_State
21 : USE HCOX_State_Mod, ONLY: Ext_State
22 :
23 : IMPLICIT NONE
24 : PRIVATE
25 : !
26 : ! !PUBLIC MEMBER FUNCTIONS:
27 : !
28 : PUBLIC :: SetHcoTime
29 : PUBLIC :: GetHcoVal
30 : PUBLIC :: GetHcoDiagn
31 : !
32 : ! !REMARKS:
33 : ! These utilities were mostly migrated from GEOS-Chem HCO_Interface_Mod.
34 : ! All functions now accept as input the HEMCO state (HcoState) as there may
35 : ! be multiple instances and all variables should not be inferred.
36 : !
37 : ! !REVISION HISTORY:
38 : ! 12 Mar 2020 - H.P. Lin - Initial version
39 : ! See https://github.com/geoschem/hemco for complete history
40 : !EOP
41 : !------------------------------------------------------------------------------
42 : !BOC
43 : CONTAINS
44 : !EOC
45 : !------------------------------------------------------------------------------
46 : ! Harmonized Emissions Component (HEMCO) !
47 : !------------------------------------------------------------------------------
48 : !BOP
49 : !
50 : ! !IROUTINE: SetHcoTime
51 : !
52 : ! !DESCRIPTION: SUBROUTINE SetHcoTime sets the current simulation
53 : ! datetime in HcoState.
54 : !\\
55 : !\\
56 : ! !INTERFACE:
57 : !
58 0 : SUBROUTINE SetHcoTime( HcoState, ExtState, year, month, &
59 : day, dayOfYr, hour, minute, &
60 : second, IsEmisTime, RC )
61 : !
62 : ! !USES:
63 : !
64 : USE HCO_CLOCK_MOD, ONLY : HcoClock_Set
65 : !
66 : ! !INPUT PARAMETERS:
67 : !
68 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
69 : TYPE(Ext_State), POINTER :: ExtState ! HEMCO extensions state object
70 : INTEGER, INTENT(IN) :: year ! UTC year
71 : INTEGER, INTENT(IN) :: month ! UTC month
72 : INTEGER, INTENT(IN) :: day ! UTC day
73 : INTEGER, INTENT(IN) :: dayOfYr ! UTC day of year
74 : INTEGER, INTENT(IN) :: hour ! UTC hour
75 : INTEGER, INTENT(IN) :: minute ! UTC minute
76 : INTEGER, INTENT(IN) :: second ! UTC second
77 : LOGICAL, INTENT(IN) :: IsEmisTime ! Time for emissions?
78 : !
79 : ! !INPUT/OUTPUT PARAMETERS:
80 : !
81 : INTEGER, INTENT(INOUT) :: RC
82 : !
83 : ! !REVISION HISTORY:
84 : ! 23 Oct 2012 - C. Keller - Initial Version
85 : ! See https://github.com/geoschem/hemco for complete history
86 : !EOP
87 : !------------------------------------------------------------------------------
88 : !BOC
89 : !
90 : ! LOCAL VARIABLES:
91 : !
92 : !=================================================================
93 : ! SetHcoTime begins here
94 : !=================================================================
95 :
96 : CALL HcoClock_Set ( HcoState, year, month, day, hour, minute, &
97 0 : second, dayOfYr, IsEmisTime=IsEmisTime, RC=RC )
98 :
99 0 : END SUBROUTINE SetHcoTime
100 : !EOC
101 : !------------------------------------------------------------------------------
102 : ! Harmonized Emissions Component (HEMCO) !
103 : !------------------------------------------------------------------------------
104 : !BOP
105 : !
106 : ! !IROUTINE: GetHcoVal
107 : !
108 : ! !DESCRIPTION: Subroutine GetHcoVal is a wrapper routine to return an
109 : ! emission (kg/m2/s) or deposition (1/s) value from the HEMCO state object
110 : ! for a given species at position I, J, L.
111 : ! A value of zero is returned if no HEMCO species is defined for the given
112 : ! tracer, and the output parameter Found is set to false.
113 : !\\
114 : !\\
115 : ! !INTERFACE:
116 : !
117 0 : SUBROUTINE GetHcoVal ( HcoState, ExtState, &
118 : HcoID, I, J, L, Found, Emis, Dep )
119 : !
120 : ! !USES:
121 : !
122 : !
123 : ! !INPUT ARGUMENTS:
124 : !
125 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
126 : TYPE(Ext_State), POINTER :: ExtState ! HEMCO extensions state object
127 : INTEGER, INTENT(IN ) :: HcoID ! HEMCO tracer ID
128 : INTEGER, INTENT(IN ) :: I, J, L ! Position
129 : !
130 : ! !OUTPUT ARGUMENTS:
131 : !
132 : LOGICAL, INTENT( OUT) :: Found ! Was this tracer ID found?
133 : REAL(hp), OPTIONAL, INTENT( OUT) :: Emis ! Emissions [kg/m2/s]
134 : REAL(hp), OPTIONAL, INTENT( OUT) :: Dep ! Deposition [1/s]
135 : !
136 : ! !REMARKS:
137 : ! Tracer ID passed is now always HcoID. This is because GEOS-Chem uses the same
138 : ! HcoID = TrcID. If your model is not, please do a mapping internally in the
139 : ! interface.
140 : !
141 : ! Note that HEMCO expects the grid to be 3-D in IJL indices. If your model
142 : ! (e.g. CAM) stores data in 2-D columns (K, I) where I is a chunked set of
143 : ! columns, one dummy dimension needs to be added. Refer to ESCOMP/HEMCO_CESM
144 : ! (hplin, 3/12/20)
145 : !
146 : ! !REVISION HISTORY:
147 : ! 20 Oct 2014 - C. Keller - Initial Version
148 : ! See https://github.com/geoschem/hemco for complete history
149 : !EOP
150 : !------------------------------------------------------------------------------
151 : !BOC
152 : !=================================================================
153 : ! GetHcoVal begins here
154 : !=================================================================
155 :
156 : ! Init
157 0 : FOUND = .FALSE.
158 0 : IF ( PRESENT(Emis) ) Emis = 0.0_hp
159 0 : IF ( PRESENT(Dep ) ) Dep = 0.0_hp
160 :
161 : ! If HEMCO species exists, get value from HEMCO state
162 0 : IF ( HcoID > 0 ) THEN
163 0 : IF ( PRESENT(Emis) ) THEN
164 0 : IF ( ASSOCIATED(HcoState%Spc(HcoID)%Emis%Val) ) THEN
165 0 : Emis = HcoState%Spc(HcoID)%Emis%Val(I,J,L)
166 0 : FOUND = .TRUE.
167 : ENDIF
168 : ENDIF
169 0 : IF ( PRESENT(Dep) ) THEN
170 0 : IF ( ASSOCIATED(HcoState%Spc(HcoID)%Depv%Val) ) THEN
171 0 : Dep = HcoState%Spc(HcoID)%Depv%Val(I,J)
172 0 : FOUND = .TRUE.
173 : ENDIF
174 : ENDIF
175 : ENDIF
176 :
177 0 : END SUBROUTINE GetHcoVal
178 : !EOC
179 : !------------------------------------------------------------------------------
180 : ! Harmonized Emissions Component (HEMCO) !
181 : !------------------------------------------------------------------------------
182 : !BOP
183 : !
184 : ! !IROUTINE: GetHcoDiagn
185 : !
186 : ! !DESCRIPTION: Subroutine GetHcoDiagn is a convenience wrapper routine to
187 : ! get a HEMCO diagnostics from an external model.
188 : !\\
189 : !\\
190 : ! !INTERFACE:
191 : !
192 0 : SUBROUTINE GetHcoDiagn ( HcoState, ExtState, DiagnName, &
193 : StopIfNotFound, RC, Ptr2D, &
194 : Ptr3D, COL, AutoFill )
195 : !
196 : ! !USES:
197 : !
198 : USE HCO_TYPES_MOD, ONLY : DiagnCont
199 : USE HCO_DIAGN_MOD
200 : !
201 : ! !INPUT PARAMETERS:
202 : !
203 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
204 : TYPE(Ext_State), POINTER :: ExtState ! HEMCO extensions state object
205 : CHARACTER(LEN=*), INTENT(IN) :: DiagnName ! Name of diagnostics
206 : LOGICAL, INTENT(IN) :: StopIfNotFound ! Stop if diagnostics
207 : ! does not exist?
208 : INTEGER, INTENT(IN), OPTIONAL :: COL ! Collection Nr.
209 : INTEGER, INTENT(IN), OPTIONAL :: AutoFill ! AutoFill diagnostics only?
210 : !
211 : ! !INPUT/OUTPUT PARAMETERS:
212 : !
213 : INTEGER, INTENT(INOUT) :: RC ! Error return code
214 : !
215 : ! !OUTPUT PARAMETERS:
216 : !
217 : REAL(sp), POINTER, OPTIONAL :: Ptr2D(:,:) ! Pointer to 2D data
218 : REAL(sp), POINTER, OPTIONAL :: Ptr3D(:,:,:) ! Pointer to 3D data
219 : !
220 : ! !REVISION HISTORY:
221 : ! 24 Sep 2014 - C. Keller - Initial version
222 : ! See https://github.com/geoschem/hemco for complete history
223 : !EOP
224 : !------------------------------------------------------------------------------
225 : !BOC
226 : !
227 : ! !LOCAL VARIABLES:
228 : !
229 : INTEGER :: FLAG, LevIDx, PS, AF
230 : TYPE(DiagnCont), POINTER :: DgnCont => NULL()
231 :
232 : ! Strings
233 : CHARACTER(LEN=255) :: ErrMsg
234 : CHARACTER(LEN=255) :: ThisLoc
235 :
236 : !=======================================================================
237 : ! GetHcoDiagn begins here
238 : !=======================================================================
239 :
240 : ! Initialize
241 0 : RC = HCO_SUCCESS
242 :
243 : ! For error handling
244 0 : ErrMsg = ''
245 :
246 : ! Set collection number
247 0 : PS = HcoState%Diagn%HcoDiagnIDManual
248 0 : IF ( PRESENT(COL) ) PS = COL
249 :
250 : ! Set AutoFill flag
251 0 : AF = -1
252 0 : IF ( PRESENT(AutoFill) ) AF = AutoFill
253 :
254 : ! Get diagnostics by name. Search all diagnostics, i.e. both AutoFill
255 : ! and manually filled diagnostics. Also include those with a manual
256 : ! output interval.
257 : CALL Diagn_Get( HcoState, .FALSE., DgnCont, FLAG, RC, &
258 0 : cName=TRIM(DiagnName), AutoFill=AF, COL=PS )
259 :
260 : ! Trap potential errors
261 0 : IF ( RC /= HCO_SUCCESS ) THEN
262 0 : ErrMsg = 'Error in getting diagnostics: ' // TRIM(DiagnName)
263 0 : CALL HCO_Error( ErrMsg, RC )
264 0 : RETURN
265 : ENDIF
266 :
267 0 : IF ( (FLAG /= HCO_SUCCESS) .AND. StopIfNotFound ) THEN
268 : ErrMsg = 'Cannot get diagnostics for this time stamp: ' // &
269 0 : TRIM(DiagnName)
270 0 : CALL HCO_Error( ErrMsg, RC )
271 0 : RETURN
272 : ENDIF
273 :
274 : ! Pass data to output pointer (only if diagnostics defined):
275 0 : IF ( FLAG == HCO_SUCCESS ) THEN
276 :
277 : ! 2D pointer
278 0 : IF ( PRESENT(Ptr2D) ) THEN
279 :
280 : ! Pass 2D data
281 0 : IF ( ASSOCIATED(DgnCont%Arr2D%Val) ) THEN
282 0 : Ptr2D => DgnCont%Arr2D%Val
283 :
284 : ! Pass 3D data. Get level index from diagnostics (if set)
285 0 : ELSEIF ( ASSOCIATED(DgnCont%Arr3D%Val) ) THEN
286 0 : LevIDx = DgnCont%LevIdx
287 0 : IF ( LevIdx < 1 ) LevIdx = 1
288 0 : Ptr2D => DgnCont%Arr3D%Val(:,:,LevIDx)
289 :
290 : ! Error if no 2D or 3D data available
291 : ELSE
292 0 : ErrMsg = 'no data defined: '// TRIM(DiagnName)
293 0 : CALL HCO_Error( ErrMsg, RC )
294 0 : RETURN
295 : ENDIF
296 :
297 : ! 3D pointer: must point to 3D data
298 0 : ELSEIF ( PRESENT(Ptr3D) ) THEN
299 0 : IF ( ASSOCIATED(DgnCont%Arr3D%Val) ) THEN
300 0 : Ptr3D => DgnCont%Arr3D%Val
301 : ELSE
302 0 : ErrMsg = 'no 3D data defined: '// TRIM(DiagnName)
303 0 : CALL HCO_Error( ErrMsg, RC )
304 0 : RETURN
305 : ENDIF
306 :
307 : ! Error otherwise
308 : ELSE
309 0 : ErrMsg = 'Please define output data pointer: ' // TRIM(DiagnName)
310 0 : CALL HCO_Error( ErrMsg, RC )
311 0 : RETURN
312 : ENDIF
313 : ENDIF
314 :
315 : ! Free pointer
316 0 : DgnCont => NULL()
317 :
318 : ! Leave with success
319 0 : RC = HCO_SUCCESS
320 :
321 : END SUBROUTINE GetHcoDiagn
322 :
323 : !EOC
324 : END MODULE HCO_Interface_Common
|
