1 |
C $Header: /u/gcmpack/MITgcm/pkg/bling/bling_airseaflux.F,v 1.2 2016/09/12 20:00:28 mmazloff Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "BLING_OPTIONS.h" |
5 |
#include "PTRACERS_OPTIONS.h" |
6 |
|
7 |
CBOP |
8 |
subroutine BLING_AIRSEAFLUX( |
9 |
I PTR_DIC, PTR_ALK, PTR_O2, PTR_NO3, PTR_PO4, |
10 |
O SGDIC, SGO2, FluxO2, |
11 |
I bi, bj, imin, imax, jmin, jmax, |
12 |
I myIter, myTime, myThid) |
13 |
|
14 |
C ================================================================= |
15 |
C | subroutine bling_airseaflux |
16 |
C | o Calculate the carbon and oxygen air-sea flux terms |
17 |
C | Adapted from pkg/dic/dic_surfforcing.F |
18 |
C | - Get atmospheric pCO2 value |
19 |
C | Option 1: constant value, default 268.d-6, can be changed in |
20 |
C | data.bling |
21 |
C | Option 2: read 2D field using EXF pkg |
22 |
C | - Update pCO2 and pH |
23 |
C ================================================================= |
24 |
|
25 |
implicit none |
26 |
|
27 |
C === Global variables === |
28 |
#include "SIZE.h" |
29 |
#include "DYNVARS.h" |
30 |
#include "EEPARAMS.h" |
31 |
#include "PARAMS.h" |
32 |
#include "GRID.h" |
33 |
#include "FFIELDS.h" |
34 |
#include "BLING_VARS.h" |
35 |
#ifdef ALLOW_EXF |
36 |
# include "EXF_FIELDS.h" |
37 |
#endif |
38 |
#ifdef ALLOW_AUTODIFF |
39 |
# include "tamc.h" |
40 |
#endif |
41 |
|
42 |
C === Routine arguments === |
43 |
C myTime :: current time |
44 |
C myIter :: current timestep |
45 |
C myThid :: thread Id. number |
46 |
_RL myTime |
47 |
INTEGER myIter |
48 |
INTEGER myThid |
49 |
INTEGER iMin, iMax, jMin, jMax, bi, bj |
50 |
C === Input === |
51 |
C PTR_DIC :: DIC tracer field |
52 |
C PTR_ALK :: alkalinity tracer field |
53 |
C PTR_NO3 :: nitrate tracer field |
54 |
C PTR_PO4 :: phosphate tracer field |
55 |
C PTR_O2 :: oxygen tracer field |
56 |
_RL PTR_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
57 |
_RL PTR_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
58 |
_RL PTR_NO3(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
59 |
_RL PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
60 |
_RL PTR_O2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr) |
61 |
C === Output === |
62 |
C SGDIC :: surface tendency of DIC due to air-sea exchange |
63 |
C SGO2 :: surface tendency of O2 due to air-sea exchange |
64 |
C FluxO2 :: air-sea flux of O2 |
65 |
C (FluxCO2 is a global variable) |
66 |
_RL SGDIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
67 |
_RL SGO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
68 |
_RL FluxO2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
69 |
|
70 |
|
71 |
#ifdef ALLOW_PTRACERS |
72 |
|
73 |
C === Local variables === |
74 |
C i,j :: Loop counters |
75 |
INTEGER i,j,klev |
76 |
C Number of iterations for pCO2 solvers |
77 |
_RL co3dummy |
78 |
_RL Kwexch_Pre (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
79 |
C Solubility relation coefficients |
80 |
_RL SchmidtNoDIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
81 |
_RL pCO2sat (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
82 |
_RL Kwexch (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
83 |
_RL pisvel (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
84 |
C local variables for carbon chem |
85 |
_RL surfalk (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
86 |
_RL surfphos (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
87 |
_RL surfsi (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
88 |
_RL surftemp (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
89 |
_RL surfsalt (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
90 |
_RL surfdic (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
91 |
C o2 solubility relation coefficients |
92 |
_RL SchmidtNoO2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
93 |
_RL O2sat (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
94 |
_RL Kwexch_o2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
95 |
_RL aTT |
96 |
_RL aTK |
97 |
_RL aTS |
98 |
_RL aTS2 |
99 |
_RL aTS3 |
100 |
_RL aTS4 |
101 |
_RL aTS5 |
102 |
_RL o2s |
103 |
_RL ttemp |
104 |
_RL stemp |
105 |
_RL oCnew |
106 |
CEOP |
107 |
|
108 |
C---------------------------------------------------------------------- |
109 |
C First, carbon |
110 |
C---------------------------------------------------------------------- |
111 |
klev=1 |
112 |
C determine inorganic carbon chem coefficients |
113 |
DO j=jmin,jmax |
114 |
DO i=imin,imax |
115 |
|
116 |
surfalk(i,j) = PTR_ALK(i,j,1) |
117 |
& * maskC(i,j,1,bi,bj) |
118 |
surfphos(i,j) = PTR_PO4(i,j,1) |
119 |
& * maskC(i,j,1,bi,bj) |
120 |
|
121 |
C FOR NON-INTERACTIVE Si |
122 |
surfsi(i,j) = SILICA(i,j,bi,bj) * maskC(i,j,1,bi,bj) |
123 |
surftemp(i,j) = theta(i,j,1,bi,bj) |
124 |
surfsalt(i,j) = salt(i,j,1,bi,bj) |
125 |
surfdic(i,j) = PTR_DIC(i,j,1) |
126 |
|
127 |
ENDDO |
128 |
ENDDO |
129 |
|
130 |
CALL CARBON_COEFFS( |
131 |
I surftemp,surfsalt, |
132 |
I bi,bj,iMin,iMax,jMin,jMax,myThid) |
133 |
|
134 |
DO j=jmin,jmax |
135 |
DO i=imin,imax |
136 |
C Compute Kwexch_Pre which is re-used for flux of O2 |
137 |
|
138 |
c Read EXF winds instead of value from file: |
139 |
#ifdef ALLOW_EXF |
140 |
wind(i,j,bi,bj) = wspeed(i,j,bi,bj) |
141 |
#endif |
142 |
|
143 |
C Pre-compute part of exchange coefficient: pisvel*(1-fice) |
144 |
C Schmidt number is accounted for later |
145 |
pisvel(i,j) = 0.337 _d 0 * wind(i,j,bi,bj)**2/3.6 _d 5 |
146 |
Kwexch_Pre(i,j) = pisvel(i,j) |
147 |
& * (1. _d 0 - FIce(i,j,bi,bj)) |
148 |
|
149 |
ENDDO |
150 |
ENDDO |
151 |
|
152 |
c pCO2 solver... |
153 |
|
154 |
CADJ STORE ph = comlev1, key = ikey_dynamics |
155 |
|
156 |
C$TAF LOOP = parallel |
157 |
DO j=jmin,jmax |
158 |
C$TAF LOOP = parallel |
159 |
DO i=imin,imax |
160 |
|
161 |
IF ( maskC(i,j,klev,bi,bj).NE.0. _d 0 ) THEN |
162 |
CALL CALC_PCO2_APPROX( |
163 |
I surftemp(i,j),surfsalt(i,j), |
164 |
I surfdic(i,j), surfphos(i,j), |
165 |
I surfsi(i,j),surfalk(i,j), |
166 |
I ak1(i,j,bi,bj),ak2(i,j,bi,bj), |
167 |
I ak1p(i,j,bi,bj),ak2p(i,j,bi,bj),ak3p(i,j,bi,bj), |
168 |
I aks(i,j,bi,bj),akb(i,j,bi,bj),akw(i,j,bi,bj), |
169 |
I aksi(i,j,bi,bj),akf(i,j,bi,bj), |
170 |
I ak0(i,j,bi,bj), fugf(i,j,bi,bj), |
171 |
I ff(i,j,bi,bj), |
172 |
I bt(i,j,bi,bj),st(i,j,bi,bj),ft(i,j,bi,bj), |
173 |
U pH(i,j,klev,bi,bj),pCO2(i,j,bi,bj),co3dummy, |
174 |
I i,j,klev,bi,bj,myIter,myThid ) |
175 |
ELSE |
176 |
pCO2(i,j,bi,bj) = 0. _d 0 |
177 |
ENDIF |
178 |
|
179 |
ENDDO |
180 |
ENDDO |
181 |
|
182 |
DO j=jmin,jmax |
183 |
DO i=imin,imax |
184 |
|
185 |
IF ( maskC(i,j,1,bi,bj).NE.0. _d 0 ) THEN |
186 |
C calculate SCHMIDT NO. for CO2 |
187 |
SchmidtNoDIC(i,j) = |
188 |
& sca1 |
189 |
& + sca2 * theta(i,j,1,bi,bj) |
190 |
& + sca3 * theta(i,j,1,bi,bj)*theta(i,j,1,bi,bj) |
191 |
& + sca4 * theta(i,j,1,bi,bj)*theta(i,j,1,bi,bj) |
192 |
& *theta(i,j,1,bi,bj) |
193 |
c make sure Schmidt number is not negative (will happen if temp>39C) |
194 |
SchmidtNoDIC(i,j)=max(1.0 _d -2, SchmidtNoDIC(i,j)) |
195 |
|
196 |
C First determine local saturation pCO2 |
197 |
#ifdef USE_EXFCO2 |
198 |
pCO2sat(i,j) = apco2(i,j,bi,bj) |
199 |
#else |
200 |
pCO2sat(i,j) = bling_pCO2 |
201 |
#endif |
202 |
|
203 |
c Correct for atmospheric pressure |
204 |
#ifdef USE_EXF_ATMPRES |
205 |
C Atm pressure in N/m2, convert to bars |
206 |
pCO2sat(i,j) = pCO2sat(i,j)*(apressure(i,j,bi,bj)*0.00001) |
207 |
#else |
208 |
pCO2sat(i,j) = pCO2sat(i,j)*AtmosP(i,j,bi,bj) |
209 |
#endif |
210 |
|
211 |
C then account for Schmidt number |
212 |
Kwexch(i,j) = Kwexch_Pre(i,j) |
213 |
& / sqrt(SchmidtNoDIC(i,j)/660.0 _d 0) |
214 |
|
215 |
C Calculate flux in terms of DIC units using K0, solubility |
216 |
c Flux = kw*rho*(ff*pCO2atm-k0*FugFac*pCO2ocean) |
217 |
FluxCO2(i,j,bi,bj) = |
218 |
& Kwexch(i,j)*( |
219 |
& ff(i,j,bi,bj)*pCO2sat(i,j) - |
220 |
& pCO2(i,j,bi,bj)*fugf(i,j,bi,bj) |
221 |
& *ak0(i,j,bi,bj) ) |
222 |
& |
223 |
ELSE |
224 |
FluxCO2(i,j,bi,bj) = 0. _d 0 |
225 |
ENDIF |
226 |
|
227 |
C convert flux (mol kg-1 m s-1) to (mol m-2 s-1) |
228 |
FluxCO2(i,j,bi,bj) = FluxCO2(i,j,bi,bj)/permil |
229 |
|
230 |
ENDDO |
231 |
ENDDO |
232 |
|
233 |
C update tendency |
234 |
DO j=jmin,jmax |
235 |
DO i=imin,imax |
236 |
SGDIC(i,j)= recip_drF(1)*recip_hFacC(i,j,1,bi,bj) |
237 |
& *FluxCO2(i,j,bi,bj) |
238 |
ENDDO |
239 |
ENDDO |
240 |
|
241 |
C---------------------------------------------------------------------- |
242 |
C Now oxygen |
243 |
C---------------------------------------------------------------------- |
244 |
|
245 |
C calculate SCHMIDT NO. for O2 |
246 |
DO j=jmin,jmax |
247 |
DO i=imin,imax |
248 |
IF (maskC(i,j,1,bi,bj).NE.0.) THEN |
249 |
ttemp = theta(i,j,1,bi,bj) |
250 |
stemp = salt(i,j,1,bi,bj) |
251 |
|
252 |
SchmidtNoO2(i,j) = |
253 |
& sox1 |
254 |
& + sox2 * ttemp |
255 |
& + sox3 * ttemp*ttemp |
256 |
& + sox4 * ttemp*ttemp*ttemp |
257 |
|
258 |
C Determine surface flux of O2 |
259 |
C exchange coeff accounting for ice cover and Schmidt no. |
260 |
C Kwexch_Pre= pisvel*(1-fice): previously computed above |
261 |
|
262 |
Kwexch_o2(i,j) = Kwexch_Pre(i,j) |
263 |
& / sqrt(SchmidtNoO2(i,j)/660.0 _d 0) |
264 |
|
265 |
C determine saturation O2 |
266 |
C using Garcia and Gordon (1992), L&O (mistake in original ?) |
267 |
aTT = 298.15 _d 0 -ttemp |
268 |
aTK = 273.15 _d 0 +ttemp |
269 |
aTS = log(aTT/aTK) |
270 |
aTS2 = aTS*aTS |
271 |
aTS3 = aTS2*aTS |
272 |
aTS4 = aTS3*aTS |
273 |
aTS5 = aTS4*aTS |
274 |
|
275 |
oCnew = oA0 + oA1*aTS + oA2*aTS2 + oA3*aTS3 + |
276 |
& oA4*aTS4 + oA5*aTS5 |
277 |
& + stemp*(oB0 + oB1*aTS + oB2*aTS2 + oB3*aTS3) |
278 |
& + oC0*(stemp*stemp) |
279 |
|
280 |
o2s = EXP(oCnew) |
281 |
|
282 |
c Convert from ml/l to mol/m^3 |
283 |
O2sat(i,j) = o2s/22391.6 _d 0 * 1. _d 3 |
284 |
|
285 |
C Determine flux, inc. correction for local atmos surface pressure |
286 |
#ifdef USE_EXF_ATMPRES |
287 |
C Atm pressure in N/m2, convert to bars |
288 |
FluxO2(i,j) = Kwexch_o2(i,j)*( |
289 |
& (apressure(i,j,bi,bj)*0.00001) |
290 |
& *O2sat(i,j) - PTR_O2(i,j,1) ) |
291 |
#else |
292 |
FluxO2(i,j) = Kwexch_o2(i,j)* |
293 |
& (AtmosP(i,j,bi,bj)*O2sat(i,j) |
294 |
& - PTR_O2(i,j,1)) |
295 |
#endif |
296 |
ELSE |
297 |
FluxO2(i,j) = 0. _d 0 |
298 |
ENDIF |
299 |
|
300 |
ENDDO |
301 |
ENDDO |
302 |
|
303 |
C update surface tendencies |
304 |
DO j=jmin,jmax |
305 |
DO i=imin,imax |
306 |
SGO2(i,j)= FluxO2(i,j) |
307 |
& *recip_drF(1) * recip_hFacC(i,j,1,bi,bj) |
308 |
ENDDO |
309 |
ENDDO |
310 |
|
311 |
_EXCH_XY_RL( pCO2, mythid) |
312 |
_EXCH_XYZ_RL( pH, mythid) |
313 |
|
314 |
#endif /* ALLOW_PTRACER */ |
315 |
|
316 |
RETURN |
317 |
END |