Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hcox_custom_mod.F90
7 : !
8 : ! !DESCRIPTION: Customizable HEMCO emission extension.
9 : !\\
10 : !\\
11 : ! !INTERFACE:
12 : !
13 : MODULE HCOX_Custom_Mod
14 : !
15 : ! !USES:
16 : !
17 : USE HCO_Error_MOD
18 : USE HCO_Diagn_MOD
19 : USE HCOX_State_MOD, ONLY : Ext_State
20 : USE HCO_State_MOD, ONLY : HCO_State
21 :
22 : IMPLICIT NONE
23 : PRIVATE
24 : !
25 : ! !PUBLIC MEMBER FUNCTIONS:
26 : !
27 : PUBLIC :: HCOX_Custom_Run
28 : PUBLIC :: HCOX_Custom_Init
29 : PUBLIC :: HCOX_Custom_Final
30 : !
31 : ! !REVISION HISTORY:
32 : ! 13 Dec 2013 - C. Keller - Initial version
33 : ! See https://github.com/geoschem/hemco for complete history
34 : !EOP
35 : !------------------------------------------------------------------------------
36 : !BOC
37 : !
38 : ! !MODULE VARIABLES:
39 : !
40 : TYPE :: MyInst
41 : INTEGER :: Instance
42 : INTEGER :: ExtNr = -1
43 : INTEGER :: nOcWind = -1
44 : INTEGER :: nIceSrc = -1
45 : INTEGER, POINTER :: OcWindIDs(:)
46 : INTEGER, POINTER :: IceSrcIDs(:)
47 : TYPE(MyInst), POINTER :: NextInst => NULL()
48 : END TYPE MyInst
49 :
50 : ! Pointer to instances
51 : TYPE(MyInst), POINTER :: AllInst => NULL()
52 :
53 : CONTAINS
54 : !EOC
55 : !------------------------------------------------------------------------------
56 : ! Harmonized Emissions Component (HEMCO) !
57 : !------------------------------------------------------------------------------
58 : !BOP
59 : !
60 : ! !IROUTINE: HCOX_Custom_Run
61 : !
62 : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Run is the driver routine
63 : ! for the customizable HEMCO extension.
64 : !\\
65 : !\\
66 : ! !INTERFACE:
67 : !
68 0 : SUBROUTINE HCOX_Custom_Run( ExtState, HcoState, RC )
69 : !
70 : ! !USES:
71 : !
72 : USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd
73 : USE HCO_GeoTools_Mod, ONLY : HCO_LANDTYPE
74 : !
75 : ! !INPUT PARAMETERS:
76 : !
77 : TYPE(Ext_State), POINTER :: ExtState ! Module options
78 : !
79 : ! !INPUT/OUTPUT PARAMETERS:
80 : !
81 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
82 : INTEGER, INTENT(INOUT) :: RC ! Success or failure
83 : !
84 : ! !REMARKS:
85 : !
86 : !
87 : ! !REVISION HISTORY:
88 : ! 13 Dec 2013 - C. Keller - Initial version
89 : ! See https://github.com/geoschem/hemco for complete history
90 : !EOP
91 : !------------------------------------------------------------------------------
92 : !BOC
93 : !
94 : ! !LOCAL VARIABLES:
95 : !
96 : INTEGER :: I, J, N, AS, LANDTYPE
97 : INTEGER :: tmpID
98 : REAL*8 :: W10M
99 0 : REAL(hp), ALLOCATABLE :: FLUXICE(:,:)
100 0 : REAL(hp), ALLOCATABLE :: FLUXWIND(:,:)
101 : LOGICAL :: ERR
102 : CHARACTER(LEN=255) :: MSG, LOC
103 :
104 : TYPE(MyInst), POINTER :: Inst
105 : !
106 : ! !DEFINED PARAMETERS:
107 : !
108 : REAL*8, PARAMETER :: SCALICE = 1.0d-14
109 : REAL*8, PARAMETER :: SCALWIND = 1.0d-14
110 :
111 : !=================================================================
112 : ! HCOX_CUSTOM_RUN begins here!
113 : !=================================================================
114 0 : LOC = 'HCOX_CUSTOM_RUN (HCOX_CUSTOM_MOD.F90)'
115 :
116 : ! Enter
117 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
118 0 : IF ( RC /= HCO_SUCCESS ) THEN
119 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
120 0 : RETURN
121 : ENDIF
122 :
123 : ! Set error flag
124 0 : ERR = .FALSE.
125 :
126 : ! Sanity check: return if extension not turned on
127 0 : IF ( ExtState%Custom <= 0 ) RETURN
128 :
129 : ! Get instance
130 0 : Inst => NULL()
131 0 : CALL InstGet ( ExtState%Custom, Inst, RC )
132 0 : IF ( RC /= HCO_SUCCESS ) THEN
133 0 : WRITE(MSG,*) 'Cannot find custom instance Nr. ', ExtState%Custom
134 0 : CALL HCO_ERROR(MSG,RC)
135 0 : RETURN
136 : ENDIF
137 :
138 : ! Initialize flux arrays
139 : ALLOCATE ( FLUXICE( HcoState%NX,HcoState%NY), &
140 0 : FLUXWIND(HcoState%NX,HcoState%NY), STAT=AS )
141 0 : IF ( AS/= 0 ) THEN
142 0 : CALL HCO_ERROR( 'ALLOCATION ERROR', RC )
143 0 : RETURN
144 : ENDIF
145 0 : FLUXICE = 0.0_hp
146 0 : FLUXWIND = 0.0_hp
147 :
148 : !$OMP PARALLEL DO &
149 : !$OMP DEFAULT( SHARED ) &
150 : !$OMP PRIVATE( I, J, W10M, LANDTYPE ) &
151 : !$OMP SCHEDULE( DYNAMIC )
152 : ! Loop over surface grid boxes
153 0 : DO J = 1, HcoState%NY
154 0 : DO I = 1, HcoState%NX
155 :
156 : ! Get the land type for grid box (I,J)
157 0 : LANDTYPE = HCO_LANDTYPE( ExtState%FRLAND%Arr%Val(I,J), &
158 0 : ExtState%FRLANDIC%Arr%Val(I,J), &
159 0 : ExtState%FROCEAN%Arr%Val(I,J), &
160 0 : ExtState%FRSEAICE%Arr%Val(I,J), &
161 0 : ExtState%FRLAKE%Arr%Val(I,J) )
162 :
163 : ! Check surface type
164 : ! Ocean:
165 0 : IF ( LANDTYPE == 0 ) THEN
166 :
167 : ! 10m wind speed [m/s]
168 0 : W10M = ExtState%U10M%Arr%Val(I,J)**2 + &
169 0 : ExtState%V10M%Arr%Val(I,J)**2
170 0 : W10M = SQRT(W10M)
171 :
172 : ! Set flux to wind speed
173 0 : FLUXWIND(I,J) = W10M * SCALWIND
174 :
175 : ! Ice:
176 0 : ELSE IF ( LANDTYPE == 2 ) THEN
177 :
178 : ! Set uniform flux
179 0 : FLUXICE(I,J) = SCALICE
180 : ENDIF
181 :
182 : ENDDO !I
183 : ENDDO !J
184 : !$OMP END PARALLEL DO
185 :
186 : ! Check exit status
187 : IF ( ERR ) THEN
188 : RC = HCO_FAIL
189 : RETURN
190 : ENDIF
191 :
192 : ! Add wind fluxes to emission arrays & diagnostics
193 0 : DO N = 1, Inst%nOcWind
194 :
195 : ! Emissions array
196 0 : CALL HCO_EmisAdd( HcoState, FLUXWIND, Inst%OcWindIDs(N), &
197 0 : RC, ExtNr=Inst%ExtNr )
198 0 : IF ( RC /= HCO_SUCCESS ) THEN
199 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
200 0 : RETURN
201 : ENDIF
202 : ENDDO !N
203 :
204 : ! Add ice fluxes to emission arrays & diagnostics
205 0 : DO N = 1, Inst%nIceSrc
206 :
207 : ! Emissions array
208 0 : CALL HCO_EmisAdd( HcoState, FLUXICE, Inst%IceSrcIDs(N), &
209 0 : RC, ExtNr=Inst%ExtNr )
210 0 : IF ( RC /= HCO_SUCCESS ) THEN
211 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
212 0 : RETURN
213 : ENDIF
214 : ENDDO !N
215 :
216 : ! Return w/ success
217 0 : Inst => NULL()
218 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
219 :
220 0 : END SUBROUTINE HCOX_Custom_Run
221 : !EOC
222 : !------------------------------------------------------------------------------
223 : ! Harmonized Emissions Component (HEMCO) !
224 : !------------------------------------------------------------------------------
225 : !BOP
226 : !
227 : ! !IROUTINE: HCOX_Custom_Init
228 : !
229 : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Init initializes the HEMCO
230 : ! CUSTOM extension.
231 : !\\
232 : !\\
233 : ! !INTERFACE:
234 : !
235 0 : SUBROUTINE HCOX_Custom_Init( HcoState, ExtName, ExtState, RC )
236 : !
237 : ! !USES:
238 : !
239 : USE HCO_ExtList_Mod, ONLY : GetExtNr
240 : USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID
241 : !
242 : ! !INPUT PARAMETERS:
243 : !
244 : CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name
245 : TYPE(Ext_State), POINTER :: ExtState ! Module options
246 : !
247 : ! !INPUT/OUTPUT PARAMETERS:
248 : !
249 : TYPE(HCO_State), POINTER :: HcoState ! Hemco state
250 : INTEGER, INTENT(INOUT) :: RC
251 :
252 : ! !REVISION HISTORY:
253 : ! 13 Dec 2013 - C. Keller - Now a HEMCO extension
254 : ! See https://github.com/geoschem/hemco for complete history
255 : !EOP
256 : !------------------------------------------------------------------------------
257 : !BOC
258 : !
259 : ! !LOCAL VARIABLES:
260 : !
261 : INTEGER :: ExtNr, N, nSpc, AS
262 0 : INTEGER, ALLOCATABLE :: HcoIDs(:)
263 : LOGICAL :: verb
264 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
265 : CHARACTER(LEN=255) :: MSG, LOC
266 : TYPE(MyInst), POINTER :: Inst
267 :
268 : !=================================================================
269 : ! HCOX_CUSTOM_INIT begins here!
270 : !=================================================================
271 0 : LOC = 'HCOX_CUSTOM_INIT (HCOX_CUSTOM_MOD.F90)'
272 :
273 : ! Extension Nr.
274 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
275 0 : IF ( ExtNr <= 0 ) RETURN
276 :
277 : ! Enter
278 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
279 0 : IF ( RC /= HCO_SUCCESS ) THEN
280 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
281 0 : RETURN
282 : ENDIF
283 0 : verb = HCO_IsVerb(HcoState%Config%Err,1)
284 :
285 0 : Inst => NULL()
286 0 : CALL InstCreate ( ExtNr, ExtState%Custom, Inst, RC )
287 0 : IF ( RC /= HCO_SUCCESS ) THEN
288 0 : CALL HCO_ERROR ( 'Cannot create custom instance', RC )
289 0 : RETURN
290 : ENDIF
291 :
292 : ! Set species IDs
293 0 : CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, HcoIDs, SpcNames, nSpc, RC )
294 0 : IF ( RC /= HCO_SUCCESS ) THEN
295 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
296 0 : RETURN
297 : ENDIF
298 :
299 : ! Assume first half are 'wind species', second half are ice.
300 0 : IF ( MOD(nSpc,2) /= 0 ) THEN
301 0 : MSG = 'Cannot set species IDs for custom emission module!'
302 0 : CALL HCO_ERROR(MSG, RC )
303 0 : RETURN
304 : ENDIF
305 :
306 : ! Pass # of sources
307 0 : Inst%nOcWind = nSpc / 2
308 0 : Inst%nIceSrc = nSpc / 2
309 :
310 : ! Allocate vector w/ the species IDs
311 0 : ALLOCATE ( Inst%OcWindIDs(Inst%nOcWind) )
312 0 : ALLOCATE ( Inst%IceSrcIDs(Inst%nIceSrc) )
313 0 : Inst%OcWindIDs(:) = HcoIDs(1:Inst%nOcWind)
314 0 : N = Inst%nOcWind + 1
315 0 : Inst%IceSrcIDs(:) = HcoIDs(N:nSpc)
316 :
317 : ! Verbose mode
318 0 : IF ( verb ) THEN
319 0 : MSG = 'Use custom emissions module (extension module)'
320 0 : CALL HCO_MSG(HcoState%Config%Err,MSG )
321 :
322 0 : MSG = 'Use the following species (Name: HcoID):'
323 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
324 0 : DO N = 1, nSpc
325 0 : WRITE(MSG,*) TRIM(SpcNames(N)), ':', HcoIDs(N)
326 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
327 : ENDDO
328 : ENDIF
329 :
330 : ! Activate met fields required by this extension
331 0 : ExtState%U10M%DoUse = .TRUE.
332 0 : ExtState%V10M%DoUse = .TRUE.
333 0 : ExtState%FRLAND%DoUse = .TRUE.
334 0 : ExtState%FRLANDIC%DoUse = .TRUE.
335 0 : ExtState%FROCEAN%DoUse = .TRUE.
336 0 : ExtState%FRSEAICE%DoUse = .TRUE.
337 0 : ExtState%FRLAKE%DoUse = .TRUE.
338 :
339 : ! Activate this extension
340 : !ExtState%Custom = .TRUE.
341 :
342 : ! Leave w/ success
343 0 : IF ( ALLOCATED(HcoIDs ) ) DEALLOCATE(HcoIDs )
344 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
345 :
346 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
347 :
348 0 : END SUBROUTINE HCOX_Custom_Init
349 : !EOC
350 : !------------------------------------------------------------------------------
351 : ! Harmonized Emissions Component (HEMCO) !
352 : !------------------------------------------------------------------------------
353 : !BOP
354 : !
355 : ! !IROUTINE: HCOX_Custom_Final
356 : !
357 : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Final finalizes the HEMCO
358 : ! CUSTOM extension.
359 : !\\
360 : !\\
361 : ! !INTERFACE:
362 : !
363 0 : SUBROUTINE HCOX_Custom_Final ( ExtState )
364 : !
365 : ! !INPUT PARAMETERS:
366 : !
367 : TYPE(Ext_State), POINTER :: ExtState ! Module options
368 : !
369 : ! !REVISION HISTORY:
370 : ! 13 Dec 2013 - C. Keller - Now a HEMCO extension
371 : ! See https://github.com/geoschem/hemco for complete history
372 : !EOP
373 : !------------------------------------------------------------------------------
374 : !BOC
375 :
376 : !=================================================================
377 : ! HCOX_CUSTOM_FINAL begins here!
378 : !=================================================================
379 0 : CALL InstRemove ( ExtState%Custom )
380 :
381 0 : END SUBROUTINE HCOX_Custom_Final
382 : !EOC
383 : !------------------------------------------------------------------------------
384 : ! Harmonized Emissions Component (HEMCO) !
385 : !------------------------------------------------------------------------------
386 : !BOP
387 : !
388 : ! !IROUTINE: InstGet
389 : !
390 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
391 : !\\
392 : !\\
393 : ! !INTERFACE:
394 : !
395 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
396 : !
397 : ! !INPUT PARAMETERS:
398 : !
399 : INTEGER :: Instance
400 : TYPE(MyInst), POINTER :: Inst
401 : INTEGER :: RC
402 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
403 : !
404 : ! !REVISION HISTORY:
405 : ! 18 Feb 2016 - C. Keller - Initial version
406 : ! See https://github.com/geoschem/hemco for complete history
407 : !EOP
408 : !------------------------------------------------------------------------------
409 : !BOC
410 : TYPE(MyInst), POINTER :: PrvInst
411 :
412 : !=================================================================
413 : ! InstGet begins here!
414 : !=================================================================
415 :
416 : ! Get instance. Also archive previous instance.
417 0 : PrvInst => NULL()
418 0 : Inst => AllInst
419 0 : DO WHILE ( ASSOCIATED(Inst) )
420 0 : IF ( Inst%Instance == Instance ) EXIT
421 0 : PrvInst => Inst
422 0 : Inst => Inst%NextInst
423 : END DO
424 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
425 0 : RC = HCO_FAIL
426 0 : RETURN
427 : ENDIF
428 :
429 : ! Pass output arguments
430 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
431 :
432 : ! Cleanup & Return
433 0 : PrvInst => NULL()
434 0 : RC = HCO_SUCCESS
435 :
436 : END SUBROUTINE InstGet
437 : !EOC
438 : !------------------------------------------------------------------------------
439 : ! Harmonized Emissions Component (HEMCO) !
440 : !------------------------------------------------------------------------------
441 : !BOP
442 : !
443 : ! !IROUTINE: InstCreate
444 : !
445 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
446 : !\\
447 : !\\
448 : ! !INTERFACE:
449 : !
450 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
451 : !
452 : ! !INPUT PARAMETERS:
453 : !
454 : INTEGER, INTENT(IN) :: ExtNr
455 : !
456 : ! !OUTPUT PARAMETERS:
457 : !
458 : INTEGER, INTENT( OUT) :: Instance
459 : TYPE(MyInst), POINTER :: Inst
460 : !
461 : ! !INPUT/OUTPUT PARAMETERS:
462 : !
463 : INTEGER, INTENT(INOUT) :: RC
464 : !
465 : ! !REVISION HISTORY:
466 : ! 18 Feb 2016 - C. Keller - Initial version
467 : ! See https://github.com/geoschem/hemco for complete history
468 : !EOP
469 : !------------------------------------------------------------------------------
470 : !BOC
471 : TYPE(MyInst), POINTER :: TmpInst
472 : INTEGER :: nnInst
473 :
474 : !=================================================================
475 : ! InstCreate begins here!
476 : !=================================================================
477 :
478 : ! ----------------------------------------------------------------
479 : ! Generic instance initialization
480 : ! ----------------------------------------------------------------
481 :
482 : ! Initialize
483 0 : Inst => NULL()
484 :
485 : ! Get number of already existing instances
486 0 : TmpInst => AllInst
487 0 : nnInst = 0
488 0 : DO WHILE ( ASSOCIATED(TmpInst) )
489 0 : nnInst = nnInst + 1
490 0 : TmpInst => TmpInst%NextInst
491 : END DO
492 :
493 : ! Create new instance
494 0 : ALLOCATE(Inst)
495 0 : Inst%Instance = nnInst + 1
496 0 : Inst%ExtNr = ExtNr
497 :
498 : ! Attach to instance list
499 0 : Inst%NextInst => AllInst
500 0 : AllInst => Inst
501 :
502 : ! Update output instance
503 0 : Instance = Inst%Instance
504 :
505 : ! ----------------------------------------------------------------
506 : ! Type specific initialization statements follow below
507 : ! ----------------------------------------------------------------
508 :
509 : ! Return w/ success
510 0 : RC = HCO_SUCCESS
511 :
512 0 : END SUBROUTINE InstCreate
513 : !EOC
514 : !------------------------------------------------------------------------------
515 : ! Harmonized Emissions Component (HEMCO) !
516 : !------------------------------------------------------------------------------
517 : !BOP
518 : !
519 : ! !IROUTINE: InstRemove
520 : !
521 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
522 : !\\
523 : !\\
524 : ! !INTERFACE:
525 : !
526 0 : SUBROUTINE InstRemove ( Instance )
527 : !
528 : ! !INPUT PARAMETERS:
529 : !
530 : INTEGER :: Instance
531 : !
532 : ! !REVISION HISTORY:
533 : ! 18 Feb 2016 - C. Keller - Initial version
534 : ! See https://github.com/geoschem/hemco for complete history
535 : !EOP
536 : !------------------------------------------------------------------------------
537 : !BOC
538 : INTEGER :: RC
539 : TYPE(MyInst), POINTER :: PrevInst
540 : TYPE(MyInst), POINTER :: Inst
541 :
542 : !=================================================================
543 : ! InstRemove begins here!
544 : !=================================================================
545 :
546 : ! Init
547 0 : PrevInst => NULL()
548 0 : Inst => NULL()
549 :
550 : ! Get instance. Also archive previous instance.
551 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
552 :
553 : ! Instance-specific deallocation
554 0 : IF ( ASSOCIATED(Inst) ) THEN
555 :
556 : !---------------------------------------------------------------------
557 : ! Deallocate fields of Inst before popping off from the list
558 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
559 : !---------------------------------------------------------------------
560 0 : IF ( ASSOCIATED( Inst%OcWindIDs ) ) THEN
561 0 : DEALLOCATE ( Inst%OcWindIDs )
562 : ENDIF
563 0 : Inst%OcWindIDs => NULL()
564 :
565 0 : IF ( ASSOCIATED( Inst%IceSrcIDs ) ) THEN
566 0 : DEALLOCATE ( Inst%IceSrcIDs )
567 : ENDIF
568 0 : Inst%IceSrcIDs => NULL()
569 :
570 : !---------------------------------------------------------------------
571 : ! Pop off instance from list
572 : !---------------------------------------------------------------------
573 0 : IF ( ASSOCIATED(PrevInst) ) THEN
574 0 : PrevInst%NextInst => Inst%NextInst
575 : ELSE
576 0 : AllInst => Inst%NextInst
577 : ENDIF
578 0 : DEALLOCATE(Inst)
579 : Inst => NULL()
580 : ENDIF
581 :
582 : ! Free pointers before exiting
583 0 : PrevInst => NULL()
584 0 : Inst => NULL()
585 :
586 0 : END SUBROUTINE InstRemove
587 : !EOC
588 0 : END MODULE HCOX_Custom_Mod
|
