Line data Source code
1 : module spehox
2 :
3 : !-----------------------------------------------------------------------
4 : !
5 : ! BOP
6 : !
7 : ! !MODULE: spedata
8 : !
9 : ! !DESCRIPTION
10 : ! Determines the HOx production factor assoctioned with
11 : ! solar proton ionization.
12 : !
13 : ! !USES
14 : use shr_kind_mod, only: r8 => shr_kind_r8
15 :
16 : implicit none
17 :
18 : private ! all unless made public
19 : save
20 :
21 : public hox_prod_factor
22 :
23 : ! !REVISION HISTORY:
24 : ! 17 Nov 2005 Francis Vitt Creation
25 : !
26 : ! EOP
27 : !-----------------------------------------------------------------------
28 : ! $Id: spehox.F90,v 1.1.2.1 2006/05/03 20:53:09 stacy Exp $
29 : ! $Author: stacy $
30 : !-----------------------------------------------------------------------
31 : ! HOx production per ion pair (cm^-3 s-1) from Figure 2
32 : ! of Solomon et al. (1981)
33 : !
34 : ! Data source:
35 : ! Dr. Charles H. Jackman, Code 916
36 : ! NASA/Goddard Space Flight Center
37 : ! Greenbelt, MD 20771
38 : ! ph:301-614-6053 fx:301-614-5903 Charles.H.Jackman@nasa.gov
39 : !
40 : ! Alt(km) 10 100 1000 10000 100000
41 : !
42 : ! 40.0 2.00 2.00 2.00 1.99 1.99
43 : ! 42.5 2.00 2.00 1.99 1.99 1.99
44 : ! 45.0 2.00 2.00 1.99 1.99 1.99
45 : ! 47.5 2.00 2.00 1.99 1.99 1.98
46 : ! 50.0 2.00 1.99 1.99 1.98 1.98
47 : ! 52.5 2.00 1.99 1.99 1.98 1.95
48 : ! 55.0 2.00 1.99 1.98 1.97 1.93
49 : ! 57.5 2.00 1.99 1.98 1.95 1.89
50 : ! 60.0 1.99 1.98 1.97 1.94 1.85
51 : ! 62.5 1.99 1.98 1.96 1.90 1.81
52 : ! 65.0 1.99 1.98 1.94 1.87 1.77
53 : ! 67.5 1.98 1.96 1.91 1.82 1.72
54 : ! 70.0 1.98 1.94 1.87 1.77 1.64
55 : ! 72.5 1.96 1.90 1.80 1.70 1.50
56 : ! 75.0 1.93 1.84 1.73 1.60 1.30
57 : ! 77.5 1.84 1.72 1.60 1.40 0.93
58 : ! 80.0 1.60 1.40 1.20 0.95 0.40
59 : ! 82.5 0.80 0.60 0.40 0.15 0.00
60 : ! 85.0 0.30 0.15 0.10 0.00 0.00
61 : ! 87.5 0.00 0.00 0.00 0.00 0.00
62 : ! 90.0 0.00 0.00 0.00 0.00 0.00
63 : !-----------------------------------------------------------------------
64 :
65 : integer, parameter :: nalts = 21
66 : integer, parameter :: nprods = 5
67 : real(r8) :: alts(nalts)
68 : real(r8) :: log_ion_prod(nprods)
69 : real(r8) :: factor_tbl(nalts,nprods)
70 :
71 : data alts(1:21) / 40.0_r8, 42.5_r8, 45.0_r8, 47.5_r8, 50.0_r8, 52.5_r8, 55.0_r8, 57.5_r8, &
72 : 60.0_r8, 62.5_r8, 65.0_r8, 67.5_r8, 70.0_r8, 72.5_r8, 75.0_r8, 77.5_r8, &
73 : 80.0_r8, 82.5_r8, 85.0_r8, 87.5_r8, 90.0_r8 /
74 :
75 : data log_ion_prod(1:5) / 1._r8, 2._r8, 3._r8, 4._r8, 5._r8 /
76 :
77 : data factor_tbl( 1,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 /
78 : data factor_tbl( 2,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 /
79 : data factor_tbl( 3,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 /
80 : data factor_tbl( 4,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 /
81 : data factor_tbl( 5,1:5) / 2.00_r8, 2.00_r8, 2.00_r8, 1.99_r8, 1.99_r8 /
82 : data factor_tbl( 6,1:5) / 2.00_r8, 1.99_r8, 1.99_r8, 1.98_r8, 1.95_r8 /
83 : data factor_tbl( 7,1:5) / 2.00_r8, 1.99_r8, 1.98_r8, 1.97_r8, 1.93_r8 /
84 : data factor_tbl( 8,1:5) / 2.00_r8, 1.99_r8, 1.98_r8, 1.95_r8, 1.89_r8 /
85 : data factor_tbl( 9,1:5) / 1.99_r8, 1.98_r8, 1.97_r8, 1.94_r8, 1.85_r8 /
86 : data factor_tbl(10,1:5) / 1.99_r8, 1.98_r8, 1.96_r8, 1.90_r8, 1.81_r8 /
87 : data factor_tbl(11,1:5) / 1.99_r8, 1.98_r8, 1.94_r8, 1.87_r8, 1.77_r8 /
88 : data factor_tbl(12,1:5) / 1.98_r8, 1.96_r8, 1.91_r8, 1.82_r8, 1.72_r8 /
89 : data factor_tbl(13,1:5) / 1.98_r8, 1.94_r8, 1.87_r8, 1.77_r8, 1.64_r8 /
90 : data factor_tbl(14,1:5) / 1.96_r8, 1.90_r8, 1.80_r8, 1.70_r8, 1.50_r8 /
91 : data factor_tbl(15,1:5) / 1.93_r8, 1.84_r8, 1.73_r8, 1.60_r8, 1.30_r8 /
92 : data factor_tbl(16,1:5) / 1.84_r8, 1.72_r8, 1.60_r8, 1.40_r8, 0.93_r8 /
93 : data factor_tbl(17,1:5) / 1.60_r8, 1.40_r8, 1.20_r8, 0.95_r8, 0.40_r8 /
94 : data factor_tbl(18,1:5) / 0.80_r8, 0.60_r8, 0.40_r8, 0.15_r8, 0.00_r8 /
95 : data factor_tbl(19,1:5) / 0.30_r8, 0.15_r8, 0.10_r8, 0.00_r8, 0.00_r8 /
96 : data factor_tbl(20,1:5) / 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8 /
97 : data factor_tbl(21,1:5) / 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8, 0.00_r8 /
98 :
99 : contains
100 :
101 : !-----------------------------------------------------------------------
102 : ! Returns the HOx production factor for the ionization profile
103 : !-----------------------------------------------------------------------
104 0 : function hox_prod_factor( ion_pairs, zmid )
105 :
106 : use ppgrid, only : pver
107 : ! for each level interpolate the factor table
108 :
109 : implicit none
110 :
111 : real(r8),intent(in) :: ion_pairs(pver)
112 : real(r8),intent(in) :: zmid(pver)
113 : real(r8) :: hox_prod_factor(pver)
114 :
115 : integer :: k
116 : integer :: lastk
117 :
118 :
119 0 : lastk = 1
120 :
121 : ! start at the bottom since the table goes from bottom to top
122 0 : do k = pver,1,-1
123 0 : hox_prod_factor(k) = interp_factor_tbl( ion_pairs(k), zmid(k), lastk )
124 : enddo
125 :
126 : end function hox_prod_factor
127 :
128 : !-----------------------------------------------------------------------
129 : ! bilinear interpolates the above table of factors
130 : !-----------------------------------------------------------------------
131 0 : function interp_factor_tbl( ionp, z, lastk )
132 :
133 : implicit none
134 :
135 : real(r8),intent(in) :: ionp
136 : real(r8),intent(in) :: z
137 : integer, intent(inout) :: lastk
138 : real(r8) :: interp_factor_tbl
139 :
140 : integer :: i
141 : real(r8) :: logp
142 : real(r8) :: atlwgt1,atlwgt2
143 : real(r8) :: prodwgt1,prodwgt2
144 : real(r8) :: fact(nprods)
145 :
146 0 : if (ionp <= 0._r8 ) then
147 0 : interp_factor_tbl = 0._r8
148 : return
149 : endif
150 :
151 : ! interpolate log10 of the ionization rate since the table is
152 : ! on a log scale.
153 0 : logp = log10(ionp)
154 :
155 0 : if ( z <= alts(1) ) then
156 0 : fact(:) = factor_tbl(1,:)
157 0 : else if ( z >= alts(nalts) ) then
158 0 : fact(:) = factor_tbl(nalts,:)
159 : else
160 0 : do i = lastk,nalts
161 0 : if ( z > alts(i) .and. z <= alts(i+1) ) then
162 0 : atlwgt1 = (alts(i+1) - z)/(alts(i+1) - alts(i))
163 0 : atlwgt2 = (z - alts(i))/(alts(i+1) - alts(i))
164 0 : fact(:) = atlwgt1*factor_tbl(i,:) + atlwgt2*factor_tbl(i+1,:)
165 0 : lastk = i
166 0 : exit
167 : endif
168 : enddo
169 : endif
170 :
171 0 : if ( logp <= log_ion_prod(1) ) then
172 0 : interp_factor_tbl = fact(1)
173 0 : else if ( logp >= log_ion_prod(nprods) ) then
174 0 : interp_factor_tbl = fact(nprods)
175 : else
176 0 : do i = 1,nprods
177 0 : if ( logp > log_ion_prod(i) .and. logp <= log_ion_prod(i+1) ) then
178 0 : prodwgt1 = (log_ion_prod(i+1) - logp)/(log_ion_prod(i+1) - log_ion_prod(i))
179 0 : prodwgt2 = (logp - log_ion_prod(i))/(log_ion_prod(i+1) - log_ion_prod(i))
180 0 : interp_factor_tbl = prodwgt1*fact(i) + prodwgt2*fact(i+1)
181 0 : exit
182 : endif
183 : enddo
184 : endif
185 :
186 : end function interp_factor_tbl
187 :
188 : end module spehox
|
