File: C:\NOAA\NEMS_11731\src\chem\gocart\src\Components\GOCART_GridComp\Aero_GridCompMod.F90
1
2
3
4
5
6
7
8
9
10
11 module Aero_GridCompMod
12
13
14
15 use MAPL_Mod, only: MAPL_AM_I_ROOT
16
17 use Chem_Mod
18 use Chem_StateMod
19 use Chem_MieMod
20
21 Use Chem_UtilMod, only: pmaxmin
22
23 use O3_GridCompMod
24 use CO_GridCompMod
25 use CO2_GridCompMod
26 use BC_GridCompMod
27 use DU_GridCompMod
28 use OC_GridCompMod
29 use SS_GridCompMod
30 use SU_GridCompMod
31 use CFC_GridCompMod
32 use Rn_GridCompMod
33
34 implicit none
35
36
37
38 PRIVATE
39 PUBLIC Aero_GridComp
40
41
42
43
44
45 PUBLIC Aero_GridCompInitialize
46 PUBLIC Aero_GridCompRun
47 PUBLIC Aero_GridCompFinalize
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68 type Aero_GridComp
69 character(len=255) :: name
70 type(Chem_Mie), pointer :: mie_tables
71 type(O3_GridComp) :: gcO3
72 type(CO_GridComp) :: gcCO
73 type(CO2_GridComp) :: gcCO2
74 type(DU_GridComp) :: gcDU
75 type(SS_GridComp) :: gcSS
76 type(BC_GridComp) :: gcBC
77 type(OC_GridComp) :: gcOC
78 type(SU_GridComp) :: gcSU
79 type(CFC_GridComp) :: gcCFC
80 type(Rn_GridComp) :: gcRn
81 end type Aero_GridComp
82
83 CONTAINS
84
85
86
87
88
89
90
91
92
93
94
95 subroutine Aero_GridCompInitialize ( gcThis, w_c, impChem, expChem, &
96 nymd, nhms, cdt, rc )
97
98
99
100 implicit NONE
101
102
103
104 type(Chem_Bundle), intent(inout) :: w_c
105 integer, intent(in) :: nymd, nhms
106 real, intent(in) :: cdt
107
108
109
110
111 type(Aero_GridComp), intent(out) :: gcThis
112 type(ESMF_State), intent(inout) :: impChem
113 type(ESMF_State), intent(inout) :: expChem
114 integer, intent(out) :: rc
115
116
117
118
119
120
121
122
123
124
125
126
127
128 character(len=*), parameter :: Iam = 'Aero_GridCompInit'
129 integer :: i
130
131 gcThis%name = 'Composite Constituent Package'
132
133
134
135
136 call Chem_StateSetNeeded ( impChem, iRELHUM, .true., rc )
137 if ( rc /= 0 ) then
138 if (MAPL_AM_I_ROOT()) print *, Iam//': failed StateSetNeeded'
139 return
140 end if
141
142
143
144 if ( w_c%reg%doing_DU .or. w_c%reg%doing_SS .or. w_c%reg%doing_SU.or. &
145 w_c%reg%doing_BC .or. w_c%reg%doing_OC ) then
146 allocate ( gcThis%mie_tables, stat = rc )
147 if ( rc /= 0 ) then
148 if (MAPL_AM_I_ROOT()) print *, Iam//': cannot allocate Mie tables'
149 return
150 end if
151
152
153 %mie_tables = Chem_MieCreate ( 'Aod-550nm_Registry.rc', rc )
154 if ( rc /= 0 ) then
155 if (MAPL_AM_I_ROOT()) print *, Iam//': MieCreate failed ', rc
156 return
157 end if
158 end if
159
160
161
162 if ( w_c%reg%doing_O3 ) then
163 call O3_GridCompInitialize ( gcThis%gcO3, w_c, impChem, expChem, &
164 nymd, nhms, cdt, rc )
165 if ( rc /= 0 ) then
166 if (MAPL_AM_I_ROOT()) print *, Iam//': O3 failed to initialize ', rc
167 rc = 1000 + rc
168 return
169 end if
170 end if
171
172
173
174 if ( w_c%reg%doing_CO ) then
175 call CO_GridCompInitialize ( gcThis%gcCO, w_c, impChem, expChem, &
176 nymd, nhms, cdt, rc )
177 if ( rc /= 0 ) then
178 if (MAPL_AM_I_ROOT()) print *, Iam//': CO failed to initialize ', rc
179 rc = 2000 + rc
180 return
181 end if
182 end if
183
184
185
186 if ( w_c%reg%doing_CO2 ) then
187 call CO2_GridCompInitialize ( gcThis%gcCO2, w_c, impChem, expChem, &
188 nymd, nhms, cdt, rc )
189 if ( rc /= 0 ) then
190 if (MAPL_AM_I_ROOT()) print *, Iam//': CO2 failed to initialize ', rc
191 rc = 2500 + rc
192 return
193 end if
194 end if
195
196
197
198 if ( w_c%reg%doing_DU ) then
199 call DU_GridCompInitialize ( gcThis%gcDU, w_c, impChem, expChem, &
200 nymd, nhms, cdt, rc )
201 if ( rc /= 0 ) then
202 if (MAPL_AM_I_ROOT()) print *, Iam//': DU failed to initialize ', rc
203 rc = 3000 + rc
204 return
205 end if
206 gcThis%gcDU%mie_tables => gcThis%mie_tables
207 end if
208
209
210
211 if ( w_c%reg%doing_SS ) then
212 call SS_GridCompInitialize ( gcThis%gcSS, w_c, impChem, expChem, &
213 nymd, nhms, cdt, rc )
214 if ( rc /= 0 ) then
215 if (MAPL_AM_I_ROOT()) print *, Iam//': SS failed to initialize ', rc
216 rc = 4000 + rc
217 return
218 end if
219 gcThis%gcSS%mie_tables => gcThis%mie_tables
220 end if
221
222
223
224 if ( w_c%reg%doing_BC ) then
225 call BC_GridCompInitialize ( gcThis%gcBC, w_c, impChem, expChem, &
226 nymd, nhms, cdt, rc )
227 if ( rc /= 0 ) then
228 if (MAPL_AM_I_ROOT()) print *, Iam//': BC failed to initialize ', rc
229 rc = 5000 + rc
230 return
231 end if
232 gcThis%gcBC%mie_tables => gcThis%mie_tables
233 end if
234
235
236
237 if ( w_c%reg%doing_OC ) then
238 call OC_GridCompInitialize ( gcThis%gcOC, w_c, impChem, expChem, &
239 nymd, nhms, cdt, rc )
240 if ( rc /= 0 ) then
241 if (MAPL_AM_I_ROOT()) print *, Iam//': OC failed to initialize ', rc
242 rc = 6000 + rc
243 return
244 end if
245 gcThis%gcOC%mie_tables => gcThis%mie_tables
246 do i = 1, gcThis%gcOC%n
247 gcThis%gcOC%gcs(i)%mie_tables => gcThis%mie_tables
248 end do
249 end if
250
251
252
253 if ( w_c%reg%doing_SU ) then
254 call SU_GridCompInitialize ( gcThis%gcSU, w_c, impChem, expChem, &
255 nymd, nhms, cdt, rc )
256 if ( rc /= 0 ) then
257 if (MAPL_AM_I_ROOT()) print *, Iam//': SU failed to initialize ', rc
258 rc = 7000 + rc
259 return
260 end if
261 gcThis%gcSU%mie_tables => gcThis%mie_tables
262 end if
263
264
265
266 if ( w_c%reg%doing_CFC ) then
267 call CFC_GridCompInitialize ( gcThis%gcCFC, w_c, impChem, expChem, &
268 nymd, nhms, cdt, rc )
269 if ( rc /= 0 ) then
270 if (MAPL_AM_I_ROOT()) print *, Iam//': CFC failed to initialize ', rc
271 rc = 8000 + rc
272 return
273 end if
274 end if
275
276
277
278 if ( w_c%reg%doing_Rn ) then
279 call Rn_GridCompInitialize ( gcThis%gcRn, w_c, impChem, expChem, &
280 nymd, nhms, cdt, rc )
281 if ( rc /= 0 ) then
282 if (MAPL_AM_I_ROOT()) print *, Iam//': Rn failed to initialize ', rc
283 rc = 8500 + rc
284 return
285 end if
286 end if
287
288 call print_init_()
289
290 return
291
292 CONTAINS
293
294 subroutine print_init_()
295
296 integer :: i1, i2, j1, j2, ijl, km, n
297 real :: qmin, qmax
298
299 i1 = w_c%grid%i1; i2 = w_c%grid%i2
300 j1 = w_c%grid%j1; j2 = w_c%grid%j2
301 km = w_c%grid%km
302 ijl = ( i2 - i1 + 1 ) * ( j2 - j1 + 1 )
303
304 #ifdef DEBUG
305 do n = w_c%reg%i_GOCART, w_c%reg%j_GOCART
306 call pmaxmin('Init::'//trim(w_c%reg%vname(n)), &
307 w_c%qa(n)%data3d(i1:i2,j1:j2,1:km), qmin, qmax, &
308 ijl, km, 1. )
309 end do
310 #endif
311
312 end subroutine print_init_
313
314 end subroutine Aero_GridCompInitialize
315
316
317
318
319
320
321
322
323
324
325
326 subroutine Aero_GridCompRun ( gcThis, w_c, impChem, expChem, &
327 nymd, nhms, cdt, rc )
328
329
330
331 implicit NONE
332
333
334
335 type(Aero_GridComp), intent(inout) :: gcThis
336 type(Chem_Bundle), intent(inout) :: w_c
337
338
339
340 type(ESMF_State), intent(inout) :: impChem
341 integer, intent(in) :: nymd, nhms
342 real, intent(in) :: cdt
343
344
345
346
347 type(ESMF_State), intent(inout) :: expChem
348 integer, intent(out) :: rc
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368 if ( w_c%reg%doing_O3 ) then
369 call O3_GridCompRun( gcThis%gcO3, w_c, impChem, expChem, &
370 nymd, nhms, cdt, rc )
371 if ( rc /= 0 ) then
372 rc = 1000 + rc
373 return
374 end if
375 end if
376
377
378
379 if ( w_c%reg%doing_CO ) then
380 call CO_GridCompRun ( gcThis%gcCO, w_c, impChem, expChem, &
381 nymd, nhms, cdt, rc )
382 if ( rc /= 0 ) then
383 rc = 2000 + rc
384 return
385 end if
386 end if
387
388
389
390 if ( w_c%reg%doing_CO2 ) then
391 call CO2_GridCompRun ( gcThis%gcCO2, w_c, impChem, expChem, &
392 nymd, nhms, cdt, rc )
393 if ( rc /= 0 ) then
394 rc = 2500 + rc
395 return
396 end if
397 end if
398
399
400
401 if ( w_c%reg%doing_DU ) then
402 call DU_GridCompRun ( gcThis%gcDU, w_c, impChem, expChem, &
403 nymd, nhms, cdt, rc )
404 if ( rc /= 0 ) then
405 rc = 3000 + rc
406 return
407 end if
408 end if
409
410
411
412 if ( w_c%reg%doing_SS ) then
413 call SS_GridCompRun ( gcThis%gcSS, w_c, impChem, expChem, &
414 nymd, nhms, cdt, rc )
415 if ( rc /= 0 ) then
416 rc = 4000 + rc
417 return
418 end if
419 end if
420
421
422
423 if ( w_c%reg%doing_BC ) then
424 call BC_GridCompRun ( gcThis%gcBC, w_c, impChem, expChem, &
425 nymd, nhms, cdt, rc )
426 if ( rc /= 0 ) then
427 rc = 5000 + rc
428 return
429 end if
430 end if
431
432
433
434 if ( w_c%reg%doing_OC ) then
435 call OC_GridCompRun ( gcThis%gcOC, w_c, impChem, expChem, &
436 nymd, nhms, cdt, rc )
437 if ( rc /= 0 ) then
438 rc = 6000 + rc
439 return
440 end if
441 end if
442
443
444
445 if ( w_c%reg%doing_SU ) then
446 call SU_GridCompRun ( gcThis%gcSU, w_c, impChem, expChem, &
447 nymd, nhms, cdt, rc )
448 if ( rc /= 0 ) then
449 rc = 7000 + rc
450 return
451 end if
452 end if
453
454
455
456 if ( w_c%reg%doing_CFC ) then
457 call CFC_GridCompRun ( gcThis%gcCFC, w_c, impChem, expChem, &
458 nymd, nhms, cdt, rc )
459 if ( rc /= 0 ) then
460 rc = 8000 + rc
461 return
462 end if
463 end if
464
465
466
467 if ( w_c%reg%doing_Rn ) then
468 call Rn_GridCompRun ( gcThis%gcRn, w_c, impChem, expChem, &
469 nymd, nhms, cdt, rc )
470 if ( rc /= 0 ) then
471 rc = 8500 + rc
472 return
473 end if
474 end if
475
476 return
477
478 end subroutine Aero_GridCompRun
479
480
481
482
483
484
485
486
487
488
489
490 subroutine Aero_GridCompFinalize ( gcThis, w_c, impChem, expChem, &
491 nymd, nhms, cdt, rc )
492
493
494
495 implicit NONE
496
497
498
499 type(Aero_GridComp), intent(inout) :: gcThis
500
501
502
503 type(Chem_Bundle), intent(in) :: w_c
504 integer, intent(in) :: nymd, nhms
505 real, intent(in) :: cdt
506
507
508
509 type(ESMF_State), intent(inout) :: impChem
510 type(ESMF_State), intent(inout) :: expChem
511 integer, intent(out) :: rc
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527 if ( w_c%reg%doing_DU .or. w_c%reg%doing_SS .or. w_c%reg%doing_SU.or. &
528 w_c%reg%doing_BC .or. w_c%reg%doing_OC ) then
529 call Chem_MieDestroy ( gcThis%mie_tables, rc )
530 if ( rc /= 0 ) return
531 deallocate ( gcThis%mie_tables, stat = rc )
532 if ( rc /= 0 ) return
533 end if
534
535
536
537
538 if ( w_c%reg%doing_O3 ) then
539 call O3_GridCompFinalize ( gcThis%gcO3, w_c, impChem, expChem, &
540 nymd, nhms, cdt, rc )
541 if ( rc /= 0 ) then
542 rc = 1000 + rc
543 return
544 end if
545 end if
546
547
548
549 if ( w_c%reg%doing_CO ) then
550 call CO_GridCompFinalize ( gcThis%gcCO, w_c, impChem, expChem, &
551 nymd, nhms, cdt, rc )
552 if ( rc /= 0 ) then
553 rc = 2000 + rc
554 return
555 end if
556 end if
557
558
559
560 if ( w_c%reg%doing_CO2 ) then
561 call CO2_GridCompFinalize ( gcThis%gcCO2, w_c, impChem, expChem, &
562 nymd, nhms, cdt, rc )
563 if ( rc /= 0 ) then
564 rc = 2500 + rc
565 return
566 end if
567 end if
568
569
570
571 if ( w_c%reg%doing_DU ) then
572 call DU_GridCompFinalize ( gcThis%gcDU, w_c, impChem, expChem, &
573 nymd, nhms, cdt, rc )
574 if ( rc /= 0 ) then
575 rc = 3000 + rc
576 return
577 end if
578 end if
579
580
581
582 if ( w_c%reg%doing_SS ) then
583 call SS_GridCompFinalize ( gcThis%gcSS, w_c, impChem, expChem, &
584 nymd, nhms, cdt, rc )
585 if ( rc /= 0 ) then
586 rc = 4000 + rc
587 return
588 end if
589 end if
590
591
592
593 if ( w_c%reg%doing_BC ) then
594 call BC_GridCompFinalize ( gcThis%gcBC, w_c, impChem, expChem, &
595 nymd, nhms, cdt, rc )
596 if ( rc /= 0 ) then
597 rc = 5000 + rc
598 return
599 end if
600 end if
601
602
603
604 if ( w_c%reg%doing_OC ) then
605 call OC_GridCompFinalize ( gcThis%gcOC, w_c, impChem, expChem, &
606 nymd, nhms, cdt, rc )
607 if ( rc /= 0 ) then
608 rc = 6000 + rc
609 return
610 end if
611 end if
612
613
614
615 if ( w_c%reg%doing_SU ) then
616 call SU_GridCompFinalize ( gcThis%gcSU, w_c, impChem, expChem, &
617 nymd, nhms, cdt, rc )
618 if ( rc /= 0 ) then
619 rc = 7000 + rc
620 return
621 end if
622 end if
623
624
625
626 if ( w_c%reg%doing_CFC ) then
627 call CFC_GridCompFinalize ( gcThis%gcCFC, w_c, impChem, expChem, &
628 nymd, nhms, cdt, rc )
629 if ( rc /= 0 ) then
630 rc = 8000 + rc
631 return
632 end if
633 end if
634
635
636
637 if ( w_c%reg%doing_Rn ) then
638 call Rn_GridCompFinalize ( gcThis%gcRn, w_c, impChem, expChem, &
639 nymd, nhms, cdt, rc )
640 if ( rc /= 0 ) then
641 rc = 8500 + rc
642 return
643 end if
644 end if
645
646 return
647
648 end subroutine Aero_GridCompFinalize
649
650 end module Aero_GridCompMod
651
652