/[MITgcm]/MITgcm_contrib/bling/pkg/bling_airseaflux.F
ViewVC logotype

Contents of /MITgcm_contrib/bling/pkg/bling_airseaflux.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (show annotations) (download)
Fri May 23 17:33:42 2014 UTC (11 years, 2 months ago) by mmazloff
Branch: MAIN
Adding package BLING

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

  ViewVC Help
Powered by ViewVC 1.1.22