/[MITgcm]/MITgcm_contrib/darwin2/pkg/darwin/dic_surfforcing.F
ViewVC logotype

Annotation of /MITgcm_contrib/darwin2/pkg/darwin/dic_surfforcing.F

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


Revision 1.6 - (hide annotations) (download)
Thu May 1 16:37:41 2014 UTC (11 years, 6 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt65w_20160512, ctrb_darwin2_ckpt65j_20150225, ctrb_darwin2_ckpt66g_20170424, ctrb_darwin2_ckpt66k_20171025, ctrb_darwin2_ckpt66n_20180118, ctrb_darwin2_ckpt65v_20160409, ctrb_darwin2_ckpt65s_20160114, ctrb_darwin2_ckpt65_20140718, ctrb_darwin2_ckpt66d_20170214, ctrb_darwin2_ckpt65m_20150615, ctrb_darwin2_ckpt65q_20151118, ctrb_darwin2_ckpt65o_20150914, ctrb_darwin2_ckpt65p_20151023, ctrb_darwin2_ckpt65e_20140929, ctrb_darwin2_ckpt64z_20140711, ctrb_darwin2_ckpt65l_20150504, ctrb_darwin2_ckpt65z_20160929, ctrb_darwin2_ckpt65n_20150729, ctrb_darwin2_ckpt64y_20140622, ctrb_darwin2_ckpt65d_20140915, ctrb_darwin2_ckpt66h_20170602, ctrb_darwin2_ckpt64x_20140524, ctrb_darwin2_ckpt65x_20160612, ctrb_darwin2_ckpt66f_20170407, ctrb_darwin2_ckpt65g_20141120, ctrb_darwin2_ckpt65k_20150402, ctrb_darwin2_ckpt64w_20140502, ctrb_darwin2_ckpt66a_20161020, ctrb_darwin2_ckpt65f_20141014, ctrb_darwin2_ckpt66b_20161219, ctrb_darwin2_ckpt65i_20150123, ctrb_darwin2_ckpt66j_20170815, ctrb_darwin2_ckpt65y_20160801, ctrb_darwin2_ckpt66c_20170121, ctrb_darwin2_ckpt65a_20140728, ctrb_darwin2_ckpt65b_20140812, ctrb_darwin2_ckpt65t_20160221, ctrb_darwin2_ckpt66o_20180209, ctrb_darwin2_ckpt66e_20170314, ctrb_darwin2_ckpt65u_20160315, ctrb_darwin2_ckpt65r_20151221, ctrb_darwin2_ckpt66i_20170718, ctrb_darwin2_ckpt65c_20140830, ctrb_darwin2_ckpt66l_20171025, ctrb_darwin2_ckpt65h_20141217, ctrb_darwin2_ckpt66m_20171213, HEAD
Changes since 1.5: +12 -12 lines
replace single-precision constants by _d ones

1 jahn 1.1 #include "CPP_OPTIONS.h"
2     #include "PTRACERS_OPTIONS.h"
3     #include "DARWIN_OPTIONS.h"
4    
5     #ifdef ALLOW_PTRACERS
6     #ifdef ALLOW_DARWIN
7    
8     #ifdef ALLOW_CARBON
9    
10     CBOP
11     C !ROUTINE: DIC_SURFFORCING
12    
13     C !INTERFACE: ==========================================================
14     SUBROUTINE DIC_SURFFORCING( PTR_DIC , PTR_ALK, PTR_PO4, PTR_SIL,
15     O GDC,
16     I bi,bj,imin,imax,jmin,jmax,
17     I myIter,myTime,myThid)
18    
19     C !DESCRIPTION:
20     C Calculate the carbon air-sea flux terms
21     C following external_forcing_dic.F (OCMIP run) from Mick
22    
23     C !USES: ===============================================================
24     IMPLICIT NONE
25     #include "SIZE.h"
26     #include "DYNVARS.h"
27     #include "EEPARAMS.h"
28     #include "PARAMS.h"
29     #include "GRID.h"
30     #include "FFIELDS.h"
31     #include "DARWIN_SIZE.h"
32     #include "DARWIN_IO.h"
33     #include "DARWIN_FLUX.h"
34 stephd 1.3 #ifdef USE_EXFWIND
35     #include "EXF_FIELDS.h"
36     #endif
37 jahn 1.1
38     C !INPUT PARAMETERS: ===================================================
39     C myThid :: thread number
40     C myIter :: current timestep
41     C myTime :: current time
42     c PTR_DIC :: DIC tracer field
43     INTEGER myIter, myThid
44     _RL myTime
45 stephd 1.5 #ifdef pH_3D
46     _RL PTR_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
47     _RL PTR_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
48     _RL PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
49     _RL PTR_SIL(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
50     #else
51 jahn 1.1 _RL PTR_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52     _RL PTR_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53     _RL PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54     _RL PTR_SIL(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55 stephd 1.5 #endif
56 jahn 1.1 INTEGER iMin,iMax,jMin,jMax, bi, bj
57    
58     C !OUTPUT PARAMETERS: ===================================================
59     c GDC :: tendency due to air-sea exchange
60     _RL GDC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61    
62    
63     C !LOCAL VARIABLES: ====================================================
64     INTEGER I,J, kLev, it
65     C Number of iterations for pCO2 solvers...
66     C Solubility relation coefficients
67     _RL SchmidtNoDIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68     _RL pCO2sat(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
69     _RL Kwexch(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
70     _RL pisvel(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71     C local variables for carbon chem
72     _RL surfdic(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
73     _RL surfalk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
74     _RL surfphos(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75     _RL surfsi(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76     _RL surfsalt(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
77 stephd 1.3 _RL surftemp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
78 jahn 1.1 #ifdef ALLOW_OLD_VIRTUALFLUX
79     _RL VirtualFlux(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
80     #endif
81     CEOP
82    
83     cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
84    
85     kLev=1
86    
87     cc if coupled to atmsopheric model, use the
88     cc Co2 value passed from the coupler
89     c#ifndef USE_ATMOSCO2
90     cC PRE-INDUSTRIAL STEADY STATE pCO2 = 278.0 ppmv
91     c DO j=1-OLy,sNy+OLy
92     c DO i=1-OLx,sNx+OLx
93     c AtmospCO2(i,j,bi,bj)=278.0 _d -6
94     c ENDDO
95     c ENDDO
96     c#endif
97     C =================================================================
98     C determine inorganic carbon chem coefficients
99 stephd 1.5 #ifdef pH_3D
100     DO kLev=1,Nr
101     #endif
102 jahn 1.1 DO j=jmin,jmax
103     DO i=imin,imax
104 stephd 1.3 c put bounds on tracers so pH solver doesn't blow up
105 stephd 1.5 #ifdef pH_3D
106     surfdic(i,j) =
107 jahn 1.6 & max(400. _d 0 , min(4000. _d 0, PTR_DIC(i,j,kLev)))*
108     & 1 _d -3 * maskC(i,j,kLev,bi,bj)
109 stephd 1.5 surfalk(i,j) =
110 jahn 1.6 & max(400. _d 0 , min(4000. _d 0, PTR_ALK(i,j,kLev)))*
111     & 1 _d -3 * maskC(i,j,kLev,bi,bj)
112 stephd 1.5 surfphos(i,j) =
113 jahn 1.6 & max(1. _d -10, min(10. _d 0, PTR_PO4(i,j,kLev)))*
114     & 1 _d -3 * maskC(i,j,kLev,bi,bj)
115 stephd 1.5 surfsi(i,j) =
116 jahn 1.6 & max(1. _d -8, min(500. _d 0, PTR_SIL(i,j,kLev)))*
117     & 1 _d -3 * maskC(i,j,kLev,bi,bj)
118 stephd 1.5 #else
119 stephd 1.3 surfdic(i,j) =
120 jahn 1.6 & max(400. _d 0 , min(4000. _d 0, PTR_DIC(i,j)))*1 _d -3
121 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
122 stephd 1.3 surfalk(i,j) =
123 jahn 1.6 & max(400. _d 0 , min(4000. _d 0, PTR_ALK(i,j)))*1 _d -3
124 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
125 stephd 1.3 surfphos(i,j) =
126 jahn 1.6 & max(1. _d -10, min(10. _d 0, PTR_PO4(i,j)))*1 _d -3
127 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
128 stephd 1.3 surfsi(i,j) =
129 jahn 1.6 & max(1. _d -8, min(500. _d 0, PTR_SIL(i,j)))*1 _d -3
130 jahn 1.1 & * maskC(i,j,kLev,bi,bj)
131 stephd 1.5 #endif
132 stephd 1.3 surfsalt(i,j) =
133     & max(4. _d 0, min(50. _d 0, salt(i,j,kLev,bi,bj)))
134     surftemp(i,j) =
135     & max(-4. _d 0, min(39. _d 0, theta(i,j,kLev,bi,bj)))
136 jahn 1.1 ENDDO
137     ENDDO
138    
139     CALL CARBON_COEFFS(
140 stephd 1.3 I surftemp,surfsalt,
141 stephd 1.4 I bi,bj,iMin,iMax,jMin,jMax,
142     I kLev,myThid)
143 jahn 1.1 C====================================================================
144    
145 stephd 1.5 if (kLev.eq.1) then
146 jahn 1.1 DO j=jmin,jmax
147     DO i=imin,imax
148     C Compute AtmosP and Kwexch_Pre which are re-used for flux of O2
149    
150     #ifdef USE_PLOAD
151     C Convert anomalous pressure pLoad (in Pa) from atmospheric model
152     C to total pressure (in Atm)
153     C Note: it is assumed the reference atmospheric pressure is 1Atm=1013mb
154     C rather than the actual ref. pressure from Atm. model so that on
155     C average AtmosP is about 1 Atm.
156     AtmosP(i,j,bi,bj)= 1. _d 0 + pLoad(i,j,bi,bj)/Pa2Atm
157     #endif
158    
159     C Pre-compute part of exchange coefficient: pisvel*(1-fice)
160     C Schmidt number is accounted for later
161 stephd 1.3 #ifdef USE_EXFWIND
162     pisvel(i,j)=0.337 _d 0 *wspeed(i,j,bi,bj)**2/3.6 _d 5
163     #else
164 jahn 1.1 pisvel(i,j)=0.337 _d 0 *wind(i,j,bi,bj)**2/3.6 _d 5
165 stephd 1.3 #endif
166 jahn 1.1 Kwexch_Pre(i,j,bi,bj) = pisvel(i,j)
167     & * (1. _d 0 - FIce(i,j,bi,bj))
168    
169     ENDDO
170     ENDDO
171 stephd 1.5 ENDIF
172 jahn 1.1
173     c pCO2 solver...
174     C$TAF LOOP = parallel
175     DO j=jmin,jmax
176     C$TAF LOOP = parallel
177     DO i=imin,imax
178    
179     IF ( maskC(i,j,kLev,bi,bj).NE.0. _d 0 ) THEN
180     CALL CALC_PCO2_APPROX(
181 stephd 1.3 I surftemp(i,j),surfsalt(i,j),
182 jahn 1.1 I surfdic(i,j), surfphos(i,j),
183     I surfsi(i,j),surfalk(i,j),
184     I ak1(i,j,bi,bj),ak2(i,j,bi,bj),
185     I ak1p(i,j,bi,bj),ak2p(i,j,bi,bj),ak3p(i,j,bi,bj),
186     I aks(i,j,bi,bj),akb(i,j,bi,bj),akw(i,j,bi,bj),
187 stephd 1.2 I aksi(i,j,bi,bj),akf(i,j,bi,bj),
188     I ak0(i,j,bi,bj), fugf(i,j,bi,bj),
189     I ff(i,j,bi,bj),
190 jahn 1.1 I bt(i,j,bi,bj),st(i,j,bi,bj),ft(i,j,bi,bj),
191 stephd 1.5 #ifdef pH_3D
192     U pH(i,j,kLev,bi,bj),pCO2(i,j,kLev,bi,bj),
193     #else
194 jahn 1.1 U pH(i,j,bi,bj),pCO2(i,j,bi,bj),
195 stephd 1.5 #endif
196 jahn 1.1 I myThid )
197     ELSE
198 stephd 1.5 #ifdef pH_3D
199     pCO2(i,j,kLev,bi,bj)=0. _d 0
200     #else
201 jahn 1.1 pCO2(i,j,bi,bj)=0. _d 0
202 stephd 1.5 #endif
203 jahn 1.1 ENDIF
204     ENDDO
205     ENDDO
206    
207    
208 stephd 1.5 if (kLev.eq.1) then
209 jahn 1.1 DO j=jmin,jmax
210     DO i=imin,imax
211    
212     IF ( maskC(i,j,kLev,bi,bj).NE.0. _d 0 ) THEN
213     C calculate SCHMIDT NO. for CO2
214     SchmidtNoDIC(i,j) =
215     & sca1
216 stephd 1.3 & + sca2 * surftemp(i,j)
217     & + sca3 * surftemp(i,j)*surftemp(i,j)
218     & + sca4 * surftemp(i,j)*surftemp(i,j)
219     & *surftemp(i,j)
220     c put positive bound on SCHMIT number (will go negative for temp>40)
221     SchmidtNoDIC(i,j) = max(1. _d -2, SchmidtNoDIC(i,j))
222 jahn 1.1
223     C Determine surface flux (FDIC)
224     C first correct pCO2at for surface atmos pressure
225     pCO2sat(i,j) =
226     & AtmosP(i,j,bi,bj)*AtmospCO2(i,j,bi,bj)
227    
228     C then account for Schmidt number
229 stephd 1.3 Kwexch(i,j) = Kwexch_Pre(i,j,bi,bj)
230 jahn 1.1 & / sqrt(SchmidtNoDIC(i,j)/660.0 _d 0)
231    
232 stephd 1.2 #ifdef WATERVAP_BUG
233 jahn 1.1 C Calculate flux in terms of DIC units using K0, solubility
234     C Flux = Vp * ([CO2sat] - [CO2])
235     C CO2sat = K0*pCO2atmos*P/P0
236     C Converting pCO2 to [CO2] using ff, as in CALC_PCO2
237     FluxCO2(i,j,bi,bj) =
238     & Kwexch(i,j)*(
239     & ak0(i,j,bi,bj)*pCO2sat(i,j) -
240 stephd 1.5 #ifdef pH_3D
241     & ff(i,j,bi,bj)*pCO2(i,j,1,bi,bj)
242     #else
243 jahn 1.1 & ff(i,j,bi,bj)*pCO2(i,j,bi,bj)
244 stephd 1.5 #endif
245 jahn 1.1 & )
246 stephd 1.2 #else
247     C Corrected by Val Bennington Nov 2010 per G.A. McKinley's finding
248     C of error in application of water vapor correction
249     c Flux = kw*rho*(ff*pCO2atm-k0*FugFac*pCO2ocean)
250     FluxCO2(i,j,bi,bj) =
251     & Kwexch(i,j)*(
252     & ff(i,j,bi,bj)*pCO2sat(i,j) -
253 stephd 1.5 #ifdef pH_3D
254     & pCO2(i,j,1,bi,bj)*fugf(i,j,bi,bj)
255     #else
256 stephd 1.2 & pCO2(i,j,bi,bj)*fugf(i,j,bi,bj)
257 stephd 1.5 #endif
258 stephd 1.2 & *ak0(i,j,bi,bj) )
259     &
260     #endif
261 jahn 1.1 ELSE
262     FluxCO2(i,j,bi,bj) = 0. _d 0
263     ENDIF
264     C convert flux (mol kg-1 m s-1) to (mol m-2 s-1)
265     FluxCO2(i,j,bi,bj) = FluxCO2(i,j,bi,bj)/permil
266     c convert flux (mol m-2 s-1) to (mmol m-2 s-1)
267     FluxCO2(i,j,bi,bj) = FluxCO2(i,j,bi,bj)*1. _d 3
268    
269    
270     #ifdef ALLOW_OLD_VIRTUALFLUX
271     IF (maskC(i,j,kLev,bi,bj).NE.0. _d 0) THEN
272     c calculate virtual flux
273     c EminusPforV = dS/dt*(1/Sglob)
274     C NOTE: Be very careful with signs here!
275     C Positive EminusPforV => loss of water to atmos and increase
276     C in salinity. Thus, also increase in other surface tracers
277     C (i.e. positive virtual flux into surface layer)
278     C ...so here, VirtualFLux = dC/dt!
279     VirtualFlux(i,j)=gsm_DIC*surfaceForcingS(i,j,bi,bj)/gsm_s
280     c OR
281     c let virtual flux be zero
282     c VirtualFlux(i,j)=0.d0
283     c
284     ELSE
285     VirtualFlux(i,j)=0. _d 0
286     ENDIF
287     #endif /* ALLOW_OLD_VIRTUALFLUX */
288     ENDDO
289     ENDDO
290    
291     C update tendency
292     DO j=jmin,jmax
293     DO i=imin,imax
294     GDC(i,j)= recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
295     & *(FluxCO2(i,j,bi,bj)
296     #ifdef ALLOW_OLD_VIRTUALFLUX
297     & + VirtualFlux(i,j)
298     #endif
299     & )
300     ENDDO
301     ENDDO
302 stephd 1.5 ENDIF
303     #ifdef pH_3D
304     ENDDO
305     #endif
306 jahn 1.1
307     RETURN
308     END
309     #endif /*ALLOW_CARBON*/
310    
311     #endif /*DARWIN*/
312     #endif /*ALLOW_PTRACERS*/
313     c ==================================================================

  ViewVC Help
Powered by ViewVC 1.1.22