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 0 : CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
264 : CHARACTER(LEN=255) :: MSG, LOC
265 : TYPE(MyInst), POINTER :: Inst
266 :
267 : !=================================================================
268 : ! HCOX_CUSTOM_INIT begins here!
269 : !=================================================================
270 0 : LOC = 'HCOX_CUSTOM_INIT (HCOX_CUSTOM_MOD.F90)'
271 :
272 : ! Extension Nr.
273 0 : ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
274 0 : IF ( ExtNr <= 0 ) RETURN
275 :
276 : ! Enter
277 0 : CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
278 0 : IF ( RC /= HCO_SUCCESS ) THEN
279 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
280 0 : RETURN
281 : ENDIF
282 :
283 0 : Inst => NULL()
284 0 : CALL InstCreate ( ExtNr, ExtState%Custom, Inst, RC )
285 0 : IF ( RC /= HCO_SUCCESS ) THEN
286 0 : CALL HCO_ERROR ( 'Cannot create custom instance', RC )
287 0 : RETURN
288 : ENDIF
289 :
290 : ! Set species IDs
291 0 : CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, HcoIDs, SpcNames, nSpc, RC )
292 0 : IF ( RC /= HCO_SUCCESS ) THEN
293 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
294 0 : RETURN
295 : ENDIF
296 :
297 : ! Assume first half are 'wind species', second half are ice.
298 0 : IF ( MOD(nSpc,2) /= 0 ) THEN
299 0 : MSG = 'Cannot set species IDs for custom emission module!'
300 0 : CALL HCO_ERROR(MSG, RC )
301 0 : RETURN
302 : ENDIF
303 :
304 : ! Pass # of sources
305 0 : Inst%nOcWind = nSpc / 2
306 0 : Inst%nIceSrc = nSpc / 2
307 :
308 : ! Allocate vector w/ the species IDs
309 0 : ALLOCATE ( Inst%OcWindIDs(Inst%nOcWind) )
310 0 : ALLOCATE ( Inst%IceSrcIDs(Inst%nIceSrc) )
311 0 : Inst%OcWindIDs(:) = HcoIDs(1:Inst%nOcWind)
312 0 : N = Inst%nOcWind + 1
313 0 : Inst%IceSrcIDs(:) = HcoIDs(N:nSpc)
314 :
315 : ! Verbose mode
316 0 : IF ( Hcostate%amIRoot ) THEN
317 :
318 : ! Write the name of the extension regardless of the verbose setting
319 0 : msg = 'Using HEMCO extension: Custom (custom emissions module)'
320 0 : IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
321 0 : CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator
322 : ELSE
323 0 : CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator
324 : ENDIF
325 :
326 : ! Write all other messages as debug printout only
327 0 : MSG = 'Use the following species (Name: HcoID):'
328 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
329 0 : DO N = 1, nSpc
330 0 : WRITE(MSG,*) TRIM(SpcNames(N)), ':', HcoIDs(N)
331 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
332 : ENDDO
333 : ENDIF
334 :
335 : ! Activate met fields required by this extension
336 0 : ExtState%U10M%DoUse = .TRUE.
337 0 : ExtState%V10M%DoUse = .TRUE.
338 0 : ExtState%FRLAND%DoUse = .TRUE.
339 0 : ExtState%FRLANDIC%DoUse = .TRUE.
340 0 : ExtState%FROCEAN%DoUse = .TRUE.
341 0 : ExtState%FRSEAICE%DoUse = .TRUE.
342 0 : ExtState%FRLAKE%DoUse = .TRUE.
343 :
344 : ! Activate this extension
345 : !ExtState%Custom = .TRUE.
346 :
347 : ! Leave w/ success
348 0 : IF ( ALLOCATED(HcoIDs ) ) DEALLOCATE(HcoIDs )
349 0 : IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames)
350 :
351 0 : CALL HCO_LEAVE( HcoState%Config%Err,RC )
352 :
353 0 : END SUBROUTINE HCOX_Custom_Init
354 : !EOC
355 : !------------------------------------------------------------------------------
356 : ! Harmonized Emissions Component (HEMCO) !
357 : !------------------------------------------------------------------------------
358 : !BOP
359 : !
360 : ! !IROUTINE: HCOX_Custom_Final
361 : !
362 : ! !DESCRIPTION: Subroutine HCOX\_Custom\_Final finalizes the HEMCO
363 : ! CUSTOM extension.
364 : !\\
365 : !\\
366 : ! !INTERFACE:
367 : !
368 0 : SUBROUTINE HCOX_Custom_Final ( ExtState )
369 : !
370 : ! !INPUT PARAMETERS:
371 : !
372 : TYPE(Ext_State), POINTER :: ExtState ! Module options
373 : !
374 : ! !REVISION HISTORY:
375 : ! 13 Dec 2013 - C. Keller - Now a HEMCO extension
376 : ! See https://github.com/geoschem/hemco for complete history
377 : !EOP
378 : !------------------------------------------------------------------------------
379 : !BOC
380 :
381 : !=================================================================
382 : ! HCOX_CUSTOM_FINAL begins here!
383 : !=================================================================
384 0 : CALL InstRemove ( ExtState%Custom )
385 :
386 0 : END SUBROUTINE HCOX_Custom_Final
387 : !EOC
388 : !------------------------------------------------------------------------------
389 : ! Harmonized Emissions Component (HEMCO) !
390 : !------------------------------------------------------------------------------
391 : !BOP
392 : !
393 : ! !IROUTINE: InstGet
394 : !
395 : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
396 : !\\
397 : !\\
398 : ! !INTERFACE:
399 : !
400 0 : SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
401 : !
402 : ! !INPUT PARAMETERS:
403 : !
404 : INTEGER :: Instance
405 : TYPE(MyInst), POINTER :: Inst
406 : INTEGER :: RC
407 : TYPE(MyInst), POINTER, OPTIONAL :: PrevInst
408 : !
409 : ! !REVISION HISTORY:
410 : ! 18 Feb 2016 - C. Keller - Initial version
411 : ! See https://github.com/geoschem/hemco for complete history
412 : !EOP
413 : !------------------------------------------------------------------------------
414 : !BOC
415 : TYPE(MyInst), POINTER :: PrvInst
416 :
417 : !=================================================================
418 : ! InstGet begins here!
419 : !=================================================================
420 :
421 : ! Get instance. Also archive previous instance.
422 0 : PrvInst => NULL()
423 0 : Inst => AllInst
424 0 : DO WHILE ( ASSOCIATED(Inst) )
425 0 : IF ( Inst%Instance == Instance ) EXIT
426 0 : PrvInst => Inst
427 0 : Inst => Inst%NextInst
428 : END DO
429 0 : IF ( .NOT. ASSOCIATED( Inst ) ) THEN
430 0 : RC = HCO_FAIL
431 0 : RETURN
432 : ENDIF
433 :
434 : ! Pass output arguments
435 0 : IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
436 :
437 : ! Cleanup & Return
438 0 : PrvInst => NULL()
439 0 : RC = HCO_SUCCESS
440 :
441 : END SUBROUTINE InstGet
442 : !EOC
443 : !------------------------------------------------------------------------------
444 : ! Harmonized Emissions Component (HEMCO) !
445 : !------------------------------------------------------------------------------
446 : !BOP
447 : !
448 : ! !IROUTINE: InstCreate
449 : !
450 : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
451 : !\\
452 : !\\
453 : ! !INTERFACE:
454 : !
455 0 : SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
456 : !
457 : ! !INPUT PARAMETERS:
458 : !
459 : INTEGER, INTENT(IN) :: ExtNr
460 : !
461 : ! !OUTPUT PARAMETERS:
462 : !
463 : INTEGER, INTENT( OUT) :: Instance
464 : TYPE(MyInst), POINTER :: Inst
465 : !
466 : ! !INPUT/OUTPUT PARAMETERS:
467 : !
468 : INTEGER, INTENT(INOUT) :: RC
469 : !
470 : ! !REVISION HISTORY:
471 : ! 18 Feb 2016 - C. Keller - Initial version
472 : ! See https://github.com/geoschem/hemco for complete history
473 : !EOP
474 : !------------------------------------------------------------------------------
475 : !BOC
476 : TYPE(MyInst), POINTER :: TmpInst
477 : INTEGER :: nnInst
478 :
479 : !=================================================================
480 : ! InstCreate begins here!
481 : !=================================================================
482 :
483 : ! ----------------------------------------------------------------
484 : ! Generic instance initialization
485 : ! ----------------------------------------------------------------
486 :
487 : ! Initialize
488 0 : Inst => NULL()
489 :
490 : ! Get number of already existing instances
491 0 : TmpInst => AllInst
492 0 : nnInst = 0
493 0 : DO WHILE ( ASSOCIATED(TmpInst) )
494 0 : nnInst = nnInst + 1
495 0 : TmpInst => TmpInst%NextInst
496 : END DO
497 :
498 : ! Create new instance
499 0 : ALLOCATE(Inst)
500 0 : Inst%Instance = nnInst + 1
501 0 : Inst%ExtNr = ExtNr
502 :
503 : ! Attach to instance list
504 0 : Inst%NextInst => AllInst
505 0 : AllInst => Inst
506 :
507 : ! Update output instance
508 0 : Instance = Inst%Instance
509 :
510 : ! ----------------------------------------------------------------
511 : ! Type specific initialization statements follow below
512 : ! ----------------------------------------------------------------
513 :
514 : ! Return w/ success
515 0 : RC = HCO_SUCCESS
516 :
517 0 : END SUBROUTINE InstCreate
518 : !EOC
519 : !------------------------------------------------------------------------------
520 : ! Harmonized Emissions Component (HEMCO) !
521 : !------------------------------------------------------------------------------
522 : !BOP
523 : !
524 : ! !IROUTINE: InstRemove
525 : !
526 : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
527 : !\\
528 : !\\
529 : ! !INTERFACE:
530 : !
531 0 : SUBROUTINE InstRemove ( Instance )
532 : !
533 : ! !INPUT PARAMETERS:
534 : !
535 : INTEGER :: Instance
536 : !
537 : ! !REVISION HISTORY:
538 : ! 18 Feb 2016 - C. Keller - Initial version
539 : ! See https://github.com/geoschem/hemco for complete history
540 : !EOP
541 : !------------------------------------------------------------------------------
542 : !BOC
543 : INTEGER :: RC
544 : TYPE(MyInst), POINTER :: PrevInst
545 : TYPE(MyInst), POINTER :: Inst
546 :
547 : !=================================================================
548 : ! InstRemove begins here!
549 : !=================================================================
550 :
551 : ! Init
552 0 : PrevInst => NULL()
553 0 : Inst => NULL()
554 :
555 : ! Get instance. Also archive previous instance.
556 0 : CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
557 :
558 : ! Instance-specific deallocation
559 0 : IF ( ASSOCIATED(Inst) ) THEN
560 :
561 : !---------------------------------------------------------------------
562 : ! Deallocate fields of Inst before popping off from the list
563 : ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
564 : !---------------------------------------------------------------------
565 0 : IF ( ASSOCIATED( Inst%OcWindIDs ) ) THEN
566 0 : DEALLOCATE ( Inst%OcWindIDs )
567 : ENDIF
568 0 : Inst%OcWindIDs => NULL()
569 :
570 0 : IF ( ASSOCIATED( Inst%IceSrcIDs ) ) THEN
571 0 : DEALLOCATE ( Inst%IceSrcIDs )
572 : ENDIF
573 0 : Inst%IceSrcIDs => NULL()
574 :
575 : !---------------------------------------------------------------------
576 : ! Pop off instance from list
577 : !---------------------------------------------------------------------
578 0 : IF ( ASSOCIATED(PrevInst) ) THEN
579 0 : PrevInst%NextInst => Inst%NextInst
580 : ELSE
581 0 : AllInst => Inst%NextInst
582 : ENDIF
583 0 : DEALLOCATE(Inst)
584 : Inst => NULL()
585 : ENDIF
586 :
587 : ! Free pointers before exiting
588 0 : PrevInst => NULL()
589 0 : Inst => NULL()
590 :
591 0 : END SUBROUTINE InstRemove
592 : !EOC
593 0 : END MODULE HCOX_Custom_Mod
|
