/[MITgcm]/MITgcm/pkg/kpp/kpp_forcing_surf.F
ViewVC logotype

Contents of /MITgcm/pkg/kpp/kpp_forcing_surf.F

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


Revision 1.1 - (show annotations) (download)
Thu May 3 14:51:05 2007 UTC (17 years, 1 month ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59c, checkpoint59b
 - move computation of surface related input fields to KPP into a new
   subroutine kpp_forcing_surf.F

1 C $Header: $
2 C $Name: $
3
4 #include "KPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: KPP_FORCING_SURF
8
9 C !INTERFACE: ==========================================================
10 SUBROUTINE KPP_FORCING_SURF(
11 I rhoSurf, surfForcU, surfForcV,
12 I surfForcT, surfForcS, surfForcTice,
13 I Qsw, ttalpha, ssbeta,
14 O ustar, bo, bosol, dVsq,
15 I ikppkey, iMin, iMax, jMin, jMax, bi, bj, myTime, myThid )
16
17 C !DESCRIPTION: \bv
18 C /==========================================================\
19 C | SUBROUTINE KPP_FORCING_SURF |
20 C | o Compute all surface related KPP fields: |
21 C | - friction velocity ustar |
22 C | - turbulent and radiative surface buoyancy forcing, |
23 C | bo and bosol |
24 C | - velocity shear relative to surface squared (this is |
25 C | not really a surface affected quantity unless it is |
26 C | computed with respect to some resolution independent |
27 C | reference level, that is KPP_ESTIMATE_UREF defined ) |
28 C |==========================================================|
29 C \==========================================================/
30 IMPLICIT NONE
31
32 c taux / rho = surfForcU (N/m^2)
33 c tauy / rho = surfForcV (N/m^2)
34 c ustar = sqrt( sqrt( taux^2 + tauy^2 ) / rho ) (m/s)
35 c bo = - g * ( alpha*surfForcT +
36 c beta *surfForcS ) / rho (m^2/s^3)
37 c bosol = - g * alpha * Qsw * drF(1) / rho (m^2/s^3)
38 c------------------------------------------------------------------------
39
40 c \ev
41
42 C !USES: ===============================================================
43 #include "SIZE.h"
44 #include "EEPARAMS.h"
45 #include "PARAMS.h"
46 #include "GRID.h"
47 #include "DYNVARS.h"
48 #include "KPP_PARAMS.h"
49
50 C !INPUT PARAMETERS: ===================================================
51 C Routine arguments
52 C ikppkeyb - key for storing trajectory for adjoint (taf)
53 c imin, imax, jmin, jmax - array computation indices
54 C bi, bj - array indices on which to apply calculations
55 C myTime - Current time in simulation
56 C myThid - Current thread id
57 c rhoSurf- density of surface layer (kg/m^3)
58 C surfForcU units are r_unit.m/s^2 (=m^2/s^2 if r=z)
59 C surfForcV units are r_unit.m/s^2 (=m^2/s^-2 if r=z)
60 C surfForcS units are r_unit.psu/s (=psu.m/s if r=z)
61 C - EmPmR * S_surf plus salinity relaxation*drF(1)
62 C surfForcT units are r_unit.Kelvin/s (=Kelvin.m/s if r=z)
63 C - Qnet (+Qsw) plus temp. relaxation*drF(1)
64 C -> calculate -lambda*(T(model)-T(clim))
65 C Qnet assumed to be net heat flux including ShortWave rad.
66 C surfForcTice
67 C - equivalent Temperature flux in the top level that corresponds
68 C to the melting or freezing of sea-ice.
69 C Note that the surface level temperature is modified
70 C directly by the sea-ice model in order to maintain
71 C water temperature under sea-ice at the freezing
72 C point. But we need to keep track of the
73 C equivalent amount of heat that this surface-level
74 C temperature change implies because it is used by
75 C the KPP package (kpp_calc.F and kpp_transport_t.F).
76 C Units are r_unit.K/s (=Kelvin.m/s if r=z) (>0 for ocean warming).
77 C
78 C Qsw - surface shortwave radiation (upwards positive)
79 C ttalpha - thermal expansion coefficient without 1/rho factor
80 C d(rho{k,k})/d(T(k)) (kg/m^3/C)
81 C ssbeta - salt expansion coefficient without 1/rho factor
82 C d(rho{k,k})/d(S(k)) (kg/m^3/PSU)
83
84 C ustar (nx,ny) - surface friction velocity (m/s)
85 C bo (nx,ny) - surface turbulent buoyancy forcing (m^2/s^3)
86 C bosol (nx,ny) - surface radiative buoyancy forcing (m^2/s^3)
87 C dVsq (nx,ny,Nr) - velocity shear re surface squared
88 C at grid levels for bldepth (m^2/s^2)
89
90 INTEGER ikppkey
91 INTEGER iMin, iMax, jMin, jMax
92 INTEGER bi, bj
93 INTEGER myThid
94 _RL myTime
95
96 _RL rhoSurf (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97 _RL surfForcU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
98 _RL surfForcV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
99 _RL surfForcT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
100 _RL surfForcS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
101 _RL surfForcTice(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
102 _RL Qsw (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
103 _RL TTALPHA (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrp1)
104 _RL SSBETA (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nrp1)
105
106 _RL ustar ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
107 _RL bo ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
108 _RL bosol ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
109 _RL dVsq ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr )
110
111 C !LOCAL VARIABLES: ====================================================
112 c Local constants
113 c minusone, p0, p5, p25, p125, p0625
114 _RL p0 , p5 , p125
115 parameter( p0=0.0, p5=0.5, p125=0.125 )
116 integer i, j, k, im1, ip1, jm1, jp1
117 _RL tempvar2
118
119 _RL work3 ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
120
121 #ifdef KPP_ESTIMATE_UREF
122 _RL tempvar1, dBdz1, dBdz2, ustarX, ustarY
123 _RL z0 ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
124 _RL zRef ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
125 _RL uRef ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
126 _RL vRef ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
127 #endif
128 CEOP
129
130 c------------------------------------------------------------------------
131 c friction velocity, turbulent and radiative surface buoyancy forcing
132 c -------------------------------------------------------------------
133 c taux / rho = surfForcU (N/m^2)
134 c tauy / rho = surfForcV (N/m^2)
135 c ustar = sqrt( sqrt( taux^2 + tauy^2 ) / rho ) (m/s)
136 c bo = - g * ( alpha*surfForcT +
137 c beta *surfForcS ) / rho (m^2/s^3)
138 c bosol = - g * alpha * Qsw * drF(1) / rho (m^2/s^3)
139 c------------------------------------------------------------------------
140
141 c initialize arrays to zero
142 DO j = 1-OLy, sNy+OLy
143 DO i = 1-OLx, sNx+OLx
144 ustar(i,j) = p0
145 bo (I,J) = p0
146 bosol(I,J) = p0
147 END DO
148 END DO
149
150 DO j = jmin, jmax
151 jp1 = j + 1
152 DO i = imin, imax
153 ip1 = i+1
154 work3(i,j) =
155 & (surfForcU(i,j,bi,bj) + surfForcU(ip1,j,bi,bj)) *
156 & (surfForcU(i,j,bi,bj) + surfForcU(ip1,j,bi,bj)) +
157 & (surfForcV(i,j,bi,bj) + surfForcV(i,jp1,bi,bj)) *
158 & (surfForcV(i,j,bi,bj) + surfForcV(i,jp1,bi,bj))
159 END DO
160 END DO
161 cph(
162 CADJ store work3 = comlev1_kpp, key = ikppkey
163 cph)
164 DO j = jmin, jmax
165 jp1 = j + 1
166 DO i = imin, imax
167 ip1 = i+1
168
169 if ( work3(i,j) .lt. (phepsi*phepsi*drF(1)*drF(1)) ) then
170 ustar(i,j) = SQRT( phepsi * p5 * drF(1) )
171 else
172 tempVar2 = SQRT( work3(i,j) ) * p5
173 ustar(i,j) = SQRT( tempVar2 )
174 endif
175
176 END DO
177 END DO
178
179 DO j = jmin, jmax
180 jp1 = j + 1
181 DO i = imin, imax
182 ip1 = i+1
183
184 bo(I,J) = - gravity *
185 & ( TTALPHA(I,J,1) * (surfForcT(i,j,bi,bj)+
186 & surfForcTice(i,j,bi,bj)) +
187 & SSBETA(I,J,1) * surfForcS(i,j,bi,bj) )
188 & / rhoSurf(I,J)
189
190 bosol(I,J) = gravity * TTALPHA(I,J,1) * Qsw(i,j,bi,bj) *
191 & recip_Cp*recip_rhoConst
192 & / rhoSurf(I,J)
193
194 END DO
195 END DO
196 cph(
197 CADJ store ustar = comlev1_kpp, key = ikppkey
198 cph)
199
200 c------------------------------------------------------------------------
201 c velocity shear
202 c --------------
203 c Get velocity shear squared, averaged from "u,v-grid"
204 c onto "t-grid" (in (m/s)**2):
205 c dVsq(k)=(Uref-U(k))**2+(Vref-V(k))**2 at grid levels
206 c------------------------------------------------------------------------
207
208 c initialize arrays to zero
209 DO k = 1, Nr
210 DO j = 1-OLy, sNy+OLy
211 DO i = 1-OLx, sNx+OLx
212 dVsq(i,j,k) = p0
213 END DO
214 END DO
215 END DO
216
217 c dVsq computation
218
219 #ifdef KPP_ESTIMATE_UREF
220
221 c Get rid of vertical resolution dependence of dVsq term by
222 c estimating a surface velocity that is independent of first level
223 c thickness in the model. First determine mixed layer depth hMix.
224 c Second zRef = espilon * hMix. Third determine roughness length
225 c scale z0. Third estimate reference velocity.
226
227 DO j = jmin, jmax
228 jp1 = j + 1
229 DO i = imin, imax
230 ip1 = i + 1
231
232 c Determine mixed layer depth hMix as the shallowest depth at which
233 c dB/dz exceeds 5.2e-5 s^-2.
234 work1(i,j) = nzmax(i,j,bi,bj)
235 DO k = 1, Nr
236 IF ( k .LT. nzmax(i,j,bi,bj) .AND.
237 & maskC(I,J,k,bi,bj) .GT. 0. .AND.
238 & dbloc(i,j,k) / drC(k+1) .GT. dB_dz )
239 & work1(i,j) = k
240 ENDDO
241
242 c Linearly interpolate to find hMix.
243 k = work1(i,j)
244 IF ( k .EQ. 0 .OR. nzmax(i,j,bi,bj) .EQ. 1 ) THEN
245 zRef(i,j) = p0
246 ELSEIF ( k .EQ. 1) THEN
247 dBdz2 = dbloc(i,j,1) / drC(2)
248 zRef(i,j) = drF(1) * dB_dz / dBdz2
249 ELSEIF ( k .LT. nzmax(i,j,bi,bj) ) THEN
250 dBdz1 = dbloc(i,j,k-1) / drC(k )
251 dBdz2 = dbloc(i,j,k ) / drC(k+1)
252 zRef(i,j) = rF(k) + drF(k) * (dB_dz - dBdz1) /
253 & MAX ( phepsi, dBdz2 - dBdz1 )
254 ELSE
255 zRef(i,j) = rF(k+1)
256 ENDIF
257
258 c Compute roughness length scale z0 subject to 0 < z0
259 tempVar1 = p5 * (
260 & (uVel(i, j, 1,bi,bj)-uVel(i, j, 2,bi,bj)) *
261 & (uVel(i, j, 1,bi,bj)-uVel(i, j, 2,bi,bj)) +
262 & (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, 2,bi,bj)) *
263 & (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, 2,bi,bj)) +
264 & (vVel(i, j, 1,bi,bj)-vVel(i, j, 2,bi,bj)) *
265 & (vVel(i, j, 1,bi,bj)-vVel(i, j, 2,bi,bj)) +
266 & (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,2,bi,bj)) *
267 & (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,2,bi,bj)) )
268 IF ( tempVar1 .lt. (epsln*epsln) ) THEN
269 tempVar2 = epsln
270 ELSE
271 tempVar2 = SQRT ( tempVar1 )
272 ENDIF
273 z0(i,j) = rF(2) *
274 & ( rF(3) * LOG ( rF(3) / rF(2) ) /
275 & ( rF(3) - rF(2) ) -
276 & tempVar2 * vonK /
277 & MAX ( ustar(i,j), phepsi ) )
278 z0(i,j) = MAX ( z0(i,j), phepsi )
279
280 c zRef is set to 0.1 * hMix subject to z0 <= zRef <= drF(1)
281 zRef(i,j) = MAX ( epsilon * zRef(i,j), z0(i,j) )
282 zRef(i,j) = MIN ( zRef(i,j), drF(1) )
283
284 c Estimate reference velocity uRef and vRef.
285 uRef(i,j) = p5 * ( uVel(i,j,1,bi,bj) + uVel(ip1,j,1,bi,bj) )
286 vRef(i,j) = p5 * ( vVel(i,j,1,bi,bj) + vVel(i,jp1,1,bi,bj) )
287 IF ( zRef(i,j) .LT. drF(1) ) THEN
288 ustarX = ( surfForcU(i, j,bi,bj) +
289 & surfForcU(ip1,j,bi,bj) ) * p5 *recip_drF(1)
290 ustarY = ( surfForcV(i,j, bi,bj) +
291 & surfForcV(i,jp1,bi,bj) ) * p5 *recip_drF(1)
292 tempVar1 = ustarX * ustarX + ustarY * ustarY
293 if ( tempVar1 .lt. (epsln*epsln) ) then
294 tempVar2 = epsln
295 else
296 tempVar2 = SQRT ( tempVar1 )
297 endif
298 tempVar2 = ustar(i,j) *
299 & ( LOG ( zRef(i,j) / rF(2) ) +
300 & z0(i,j) / zRef(i,j) - z0(i,j) / rF(2) ) /
301 & vonK / tempVar2
302 uRef(i,j) = uRef(i,j) + ustarX * tempVar2
303 vRef(i,j) = vRef(i,j) + ustarY * tempVar2
304 ENDIF
305
306 ENDDO
307 ENDDO
308
309 DO k = 1, Nr
310 DO j = jmin, jmax
311 jm1 = j - 1
312 jp1 = j + 1
313 DO i = imin, imax
314 im1 = i - 1
315 ip1 = i + 1
316 dVsq(i,j,k) = p5 * (
317 $ (uRef(i,j) - uVel(i, j, k,bi,bj)) *
318 $ (uRef(i,j) - uVel(i, j, k,bi,bj)) +
319 $ (uRef(i,j) - uVel(ip1,j, k,bi,bj)) *
320 $ (uRef(i,j) - uVel(ip1,j, k,bi,bj)) +
321 $ (vRef(i,j) - vVel(i, j, k,bi,bj)) *
322 $ (vRef(i,j) - vVel(i, j, k,bi,bj)) +
323 $ (vRef(i,j) - vVel(i, jp1,k,bi,bj)) *
324 $ (vRef(i,j) - vVel(i, jp1,k,bi,bj)) )
325 #ifdef KPP_SMOOTH_DVSQ
326 dVsq(i,j,k) = p5 * dVsq(i,j,k) + p125 * (
327 $ (uRef(i,j) - uVel(i, jm1,k,bi,bj)) *
328 $ (uRef(i,j) - uVel(i, jm1,k,bi,bj)) +
329 $ (uRef(i,j) - uVel(ip1,jm1,k,bi,bj)) *
330 $ (uRef(i,j) - uVel(ip1,jm1,k,bi,bj)) +
331 $ (uRef(i,j) - uVel(i, jp1,k,bi,bj)) *
332 $ (uRef(i,j) - uVel(i, jp1,k,bi,bj)) +
333 $ (uRef(i,j) - uVel(ip1,jp1,k,bi,bj)) *
334 $ (uRef(i,j) - uVel(ip1,jp1,k,bi,bj)) +
335 $ (vRef(i,j) - vVel(im1,j, k,bi,bj)) *
336 $ (vRef(i,j) - vVel(im1,j, k,bi,bj)) +
337 $ (vRef(i,j) - vVel(im1,jp1,k,bi,bj)) *
338 $ (vRef(i,j) - vVel(im1,jp1,k,bi,bj)) +
339 $ (vRef(i,j) - vVel(ip1,j, k,bi,bj)) *
340 $ (vRef(i,j) - vVel(ip1,j, k,bi,bj)) +
341 $ (vRef(i,j) - vVel(ip1,jp1,k,bi,bj)) *
342 $ (vRef(i,j) - vVel(ip1,jp1,k,bi,bj)) )
343 #endif /* KPP_SMOOTH_DVSQ */
344 ENDDO
345 ENDDO
346 ENDDO
347
348 #else /* KPP_ESTIMATE_UREF */
349
350 DO k = 1, Nr
351 DO j = jmin, jmax
352 jm1 = j - 1
353 jp1 = j + 1
354 DO i = imin, imax
355 im1 = i - 1
356 ip1 = i + 1
357 dVsq(i,j,k) = p5 * (
358 $ (uVel(i, j, 1,bi,bj)-uVel(i, j, k,bi,bj)) *
359 $ (uVel(i, j, 1,bi,bj)-uVel(i, j, k,bi,bj)) +
360 $ (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, k,bi,bj)) *
361 $ (uVel(ip1,j, 1,bi,bj)-uVel(ip1,j, k,bi,bj)) +
362 $ (vVel(i, j, 1,bi,bj)-vVel(i, j, k,bi,bj)) *
363 $ (vVel(i, j, 1,bi,bj)-vVel(i, j, k,bi,bj)) +
364 $ (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,k,bi,bj)) *
365 $ (vVel(i, jp1,1,bi,bj)-vVel(i, jp1,k,bi,bj)) )
366 #ifdef KPP_SMOOTH_DVSQ
367 dVsq(i,j,k) = p5 * dVsq(i,j,k) + p125 * (
368 $ (uVel(i, jm1,1,bi,bj)-uVel(i, jm1,k,bi,bj)) *
369 $ (uVel(i, jm1,1,bi,bj)-uVel(i, jm1,k,bi,bj)) +
370 $ (uVel(ip1,jm1,1,bi,bj)-uVel(ip1,jm1,k,bi,bj)) *
371 $ (uVel(ip1,jm1,1,bi,bj)-uVel(ip1,jm1,k,bi,bj)) +
372 $ (uVel(i, jp1,1,bi,bj)-uVel(i, jp1,k,bi,bj)) *
373 $ (uVel(i, jp1,1,bi,bj)-uVel(i, jp1,k,bi,bj)) +
374 $ (uVel(ip1,jp1,1,bi,bj)-uVel(ip1,jp1,k,bi,bj)) *
375 $ (uVel(ip1,jp1,1,bi,bj)-uVel(ip1,jp1,k,bi,bj)) +
376 $ (vVel(im1,j, 1,bi,bj)-vVel(im1,j, k,bi,bj)) *
377 $ (vVel(im1,j, 1,bi,bj)-vVel(im1,j, k,bi,bj)) +
378 $ (vVel(im1,jp1,1,bi,bj)-vVel(im1,jp1,k,bi,bj)) *
379 $ (vVel(im1,jp1,1,bi,bj)-vVel(im1,jp1,k,bi,bj)) +
380 $ (vVel(ip1,j, 1,bi,bj)-vVel(ip1,j, k,bi,bj)) *
381 $ (vVel(ip1,j, 1,bi,bj)-vVel(ip1,j, k,bi,bj)) +
382 $ (vVel(ip1,jp1,1,bi,bj)-vVel(ip1,jp1,k,bi,bj)) *
383 $ (vVel(ip1,jp1,1,bi,bj)-vVel(ip1,jp1,k,bi,bj)) )
384 #endif /* KPP_SMOOTH_DVSQ */
385 ENDDO
386 ENDDO
387 ENDDO
388
389 #endif /* KPP_ESTIMATE_UREF */
390
391 RETURN
392 END
393

  ViewVC Help
Powered by ViewVC 1.1.22