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

Annotation of /MITgcm/pkg/kpp/kpp_calc.F

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


Revision 1.44 - (hide annotations) (download)
Sat Sep 22 17:55:32 2007 UTC (16 years, 8 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j
Changes since 1.43: +44 -4 lines
added the salt plume scheme (ALLOW_SALT_PLUME) to pkg/kpp
(code conttributed by An Nguyen)

1 dimitri 1.44 C $Header: /u/gcmpack/MITgcm/pkg/kpp/kpp_calc.F,v 1.43 2007/06/04 18:47:35 heimbach Exp $
2 adcroft 1.9 C $Name: $
3 adcroft 1.1
4     #include "KPP_OPTIONS.h"
5    
6 dimitri 1.25 CBOP
7     C !ROUTINE: KPP_CALC
8    
9     C !INTERFACE: ==========================================================
10 jmc 1.42 SUBROUTINE KPP_CALC(
11     I bi, bj, myTime, myIter, myThid )
12 dimitri 1.25
13     C !DESCRIPTION: \bv
14 jmc 1.42 C *==========================================================*
15 adcroft 1.1 C | SUBROUTINE KPP_CALC |
16     C | o Compute all KPP fields defined in KPP.h |
17 jmc 1.42 C *==========================================================*
18 adcroft 1.1 C | This subroutine serves as an interface between MITGCMUV |
19     C | code and NCOM 1-D routines in kpp_routines.F |
20 jmc 1.42 C *==========================================================*
21 adcroft 1.1 IMPLICIT NONE
22    
23     c=======================================================================
24     c
25     c written by : jan morzel, august 11, 1994
26     c modified by : jan morzel, january 25, 1995 : "dVsq" and 1d code
27     c detlef stammer, august, 1997 : for MIT GCM Classic
28     c d. menemenlis, july, 1998 : for MIT GCM UV
29     c
30     c compute vertical mixing coefficients based on the k-profile
31     c and oceanic planetary boundary layer scheme by large & mcwilliams.
32     c
33     c summary:
34     c - compute interior mixing everywhere:
35     c interior mixing gets computed at all interfaces due to constant
36     c internal wave background activity ("fkpm" and "fkph"), which
37     c is enhanced in places of static instability (local richardson
38     c number < 0).
39     c Additionally, mixing can be enhanced by adding contribution due
40     c to shear instability which is a function of the local richardson
41     c number
42     c - double diffusivity:
43     c interior mixing can be enhanced by double diffusion due to salt
44     c fingering and diffusive convection (ifdef "kmixdd").
45     c - kpp scheme in the boundary layer:
46     c
47     c a.boundary layer depth:
48     c at every gridpoint the depth of the oceanic boundary layer
49     c ("hbl") gets computed by evaluating bulk richardson numbers.
50     c b.boundary layer mixing:
51     c within the boundary layer, above hbl, vertical mixing is
52     c determined by turbulent surface fluxes, and interior mixing at
53     c the lower boundary, i.e. at hbl.
54     c
55 jmc 1.42 c this subroutine provides the interface between the MITGCM and
56     c the routine "kppmix", where boundary layer depth, vertical
57 adcroft 1.1 c viscosity, vertical diffusivity, and counter gradient term (ghat)
58     c are computed slabwise.
59     c note: subroutine "kppmix" uses m-k-s units.
60     c
61     c time level:
62     c input tracer and velocity profiles are evaluated at time level
63     c tau, surface fluxes come from tau or tau-1.
64     c
65     c grid option:
66     c in this "1-grid" implementation, diffusivity and viscosity
67     c profiles are computed on the "t-grid" (by using velocity shear
68     c profiles averaged from the "u,v-grid" onto the "t-grid"; note, that
69     c the averaging includes zero values on coastal and seafloor grid
70     c points). viscosity on the "u,v-grid" is computed by averaging the
71     c "t-grid" viscosity values onto the "u,v-grid".
72     c
73     c vertical grid:
74     c mixing coefficients get evaluated at the bottom of the lowest
75     c layer, i.e., at depth zw(Nr). these values are only useful when
76     c the model ocean domain does not include the entire ocean down to
77     c the seafloor ("upperocean" setup) and allows flux through the
78     c bottom of the domain. for full-depth runs, these mixing
79     c coefficients are being zeroed out before leaving this subroutine.
80     c
81     c-------------------------------------------------------------------------
82    
83     c global parameters updated by kpp_calc
84     c KPPviscAz - KPP eddy viscosity coefficient (m^2/s)
85     c KPPdiffKzT - KPP diffusion coefficient for temperature (m^2/s)
86     c KPPdiffKzS - KPP diffusion coefficient for salt and tracers (m^2/s)
87     c KPPghat - Nonlocal transport coefficient (s/m^2)
88     c KPPhbl - Boundary layer depth on "t-grid" (m)
89     c KPPfrac - Fraction of short-wave flux penetrating mixing layer
90 dimitri 1.44 c KPPplumefrac- Fraction of saltplume (flux) penetrating mixing layer
91 adcroft 1.1
92     c-- KPP_CALC computes vertical viscosity and diffusivity for region
93     c (-2:sNx+3,-2:sNy+3) as required by CALC_DIFFUSIVITY and requires
94 jmc 1.28 c values of uVel, vVel, surfaceForcingU, surfaceForcingV in the
95 heimbach 1.2 c region (-2:sNx+4,-2:sNy+4).
96 adcroft 1.1 c Hence overlap region needs to be set OLx=4, OLy=4.
97 dimitri 1.25 c \ev
98 adcroft 1.1
99 dimitri 1.25 C !USES: ===============================================================
100 adcroft 1.1 #include "SIZE.h"
101     #include "EEPARAMS.h"
102     #include "PARAMS.h"
103     #include "DYNVARS.h"
104     #include "KPP.h"
105     #include "KPP_PARAMS.h"
106     #include "FFIELDS.h"
107     #include "GRID.h"
108 dimitri 1.36 #include "GAD.h"
109 mlosch 1.35 #ifdef ALLOW_SHELFICE
110     # include "SHELFICE.h"
111     #endif /* ALLOW_SHELFICE */
112 adcroft 1.1 #ifdef ALLOW_AUTODIFF_TAMC
113     #include "tamc.h"
114     #include "tamc_keys.h"
115     #else /* ALLOW_AUTODIFF_TAMC */
116 heimbach 1.16 integer ikppkey
117 adcroft 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
118    
119 jmc 1.32 EXTERNAL DIFFERENT_MULTIPLE
120     LOGICAL DIFFERENT_MULTIPLE
121 adcroft 1.1
122 dimitri 1.25 C !INPUT PARAMETERS: ===================================================
123 adcroft 1.1 c Routine arguments
124 jmc 1.42 c bi, bj :: Current tile indices
125     c myTime :: Current time in simulation
126     c myIter :: Current iteration number in simulation
127     c myThid :: My Thread Id. number
128 adcroft 1.1
129     INTEGER bi, bj
130 jmc 1.42 _RL myTime
131     INTEGER myIter
132 adcroft 1.1 INTEGER myThid
133    
134     #ifdef ALLOW_KPP
135    
136 dimitri 1.25 C !LOCAL VARIABLES: ====================================================
137 heimbach 1.4 c Local constants
138     c minusone, p0, p5, p25, p125, p0625
139     c imin, imax, jmin, jmax - array computation indices
140    
141     _RL minusone
142     parameter( minusone=-1.0)
143 dimitri 1.37 _RL p0 , p5 , p25 , p125 , p0625
144 heimbach 1.4 parameter( p0=0.0, p5=0.5, p25=0.25, p125=0.125, p0625=0.0625 )
145 dimitri 1.17 integer imin ,imax ,jmin ,jmax
146 heimbach 1.15 parameter(imin=2-OLx,imax=sNx+OLx-1,jmin=2-OLy,jmax=sNy+OLy-1)
147 heimbach 1.4
148 adcroft 1.1 c Local arrays and variables
149     c work? (nx,ny) - horizontal working arrays
150     c ustar (nx,ny) - surface friction velocity (m/s)
151     c bo (nx,ny) - surface turbulent buoyancy forcing (m^2/s^3)
152     c bosol (nx,ny) - surface radiative buoyancy forcing (m^2/s^3)
153 dimitri 1.44 c boplume(nx,ny) - surface haline buoyancy forcing (m^2/s^3)
154 adcroft 1.1 c shsq (nx,ny,Nr) - local velocity shear squared
155     c at interfaces for ri_iwmix (m^2/s^2)
156     c dVsq (nx,ny,Nr) - velocity shear re surface squared
157     c at grid levels for bldepth (m^2/s^2)
158     c dbloc (nx,ny,Nr) - local delta buoyancy at interfaces
159     c for ri_iwmix and bldepth (m/s^2)
160     c Ritop (nx,ny,Nr) - numerator of bulk richardson number
161     c at grid levels for bldepth
162     c vddiff (nx,ny,Nrp2,1)- vertical viscosity on "t-grid" (m^2/s)
163 dimitri 1.24 c vddiff (nx,ny,Nrp2,2)- vert. diff. on next row for salt&tracers (m^2/s)
164     c vddiff (nx,ny,Nrp2,3)- vert. diff. on next row for temperature (m^2/s)
165 adcroft 1.1 c ghat (nx,ny,Nr) - nonlocal transport coefficient (s/m^2)
166     c hbl (nx,ny) - mixing layer depth (m)
167     c kmtj (nx,ny) - maximum number of wet levels in each column
168     c z0 (nx,ny) - Roughness length (m)
169     c zRef (nx,ny) - Reference depth: Hmix * epsilon (m)
170     c uRef (nx,ny) - Reference zonal velocity (m/s)
171     c vRef (nx,ny) - Reference meridional velocity (m/s)
172    
173 dimitri 1.37 integer work1 ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
174     _RL worka ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
175     _RL work2 ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
176     _RL work3 ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
177     _RL ustar ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
178     _RL bo ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
179     _RL bosol ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
180 dimitri 1.44 #ifdef ALLOW_SALT_PLUME
181     _RL boplume ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
182     #endif /* ALLOW_SALT_PLUME */
183 dimitri 1.37 _RL shsq ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr )
184     _RL dVsq ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr )
185     _RL dbloc ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr )
186     _RL Ritop ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr )
187     _RL vddiff( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, 0:Nrp1, mdiff )
188     _RL ghat ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr )
189     _RL hbl ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
190 heimbach 1.33 cph(
191 dimitri 1.37 _RL TTALPHA( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nrp1 )
192     _RL SSBETA ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nrp1 )
193 heimbach 1.33 cph)
194 adcroft 1.1 #ifdef KPP_ESTIMATE_UREF
195 dimitri 1.37 _RL z0 ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
196     _RL zRef ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
197     _RL uRef ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
198     _RL vRef ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy )
199 adcroft 1.1 #endif /* KPP_ESTIMATE_UREF */
200 jmc 1.42
201 dimitri 1.37 _RL tempvar2
202 mlosch 1.35 integer i, j, k, kp1, km1, im1, ip1, jm1, jp1
203 adcroft 1.1
204     #ifdef KPP_ESTIMATE_UREF
205 dimitri 1.37 _RL tempvar1, dBdz1, dBdz2, ustarX, ustarY
206 adcroft 1.1 #endif
207    
208 heimbach 1.16 #ifdef ALLOW_AUTODIFF_TAMC
209     act1 = bi - myBxLo(myThid)
210     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
211     act2 = bj - myByLo(myThid)
212     max2 = myByHi(myThid) - myByLo(myThid) + 1
213     act3 = myThid - 1
214     max3 = nTx*nTy
215     act4 = ikey_dynamics - 1
216     ikppkey = (act1 + 1) + act2*max1
217     & + act3*max1*max2
218     & + act4*max1*max2*max3
219     #endif /* ALLOW_AUTODIFF_TAMC */
220 dimitri 1.25 CEOP
221 heimbach 1.16
222 adcroft 1.1 c Check to see if new vertical mixing coefficient should be computed now?
223 jmc 1.32 IF ( DIFFERENT_MULTIPLE(kpp_freq,myTime,deltaTClock)
224 jmc 1.31 1 .OR. myTime .EQ. startTime ) THEN
225 jmc 1.42
226 adcroft 1.1 c-----------------------------------------------------------------------
227     c prepare input arrays for subroutine "kppmix" to compute
228     c viscosity and diffusivity and ghat.
229     c All input arrays need to be in m-k-s units.
230     c
231     c note: for the computation of the bulk richardson number in the
232     c "bldepth" subroutine, gradients of velocity and buoyancy are
233     c required at every depth. in the case of very fine vertical grids
234     c (thickness of top layer < 2m), the surface reference depth must
235     c be set to zref=epsilon/2*zgrid(k), and the reference value
236     c of velocity and buoyancy must be computed as vertical average
237     c between the surface and 2*zref. in the case of coarse vertical
238     c grids zref is zgrid(1)/2., and the surface reference value is
239     c simply the surface value at zgrid(1).
240     c-----------------------------------------------------------------------
241    
242     c------------------------------------------------------------------------
243     c density related quantities
244     c --------------------------
245     c
246     c work2 - density of surface layer (kg/m^3)
247     c dbloc - local buoyancy gradient at Nr interfaces
248     c g/rho{k+1,k+1} * [ drho{k,k+1}-drho{k+1,k+1} ] (m/s^2)
249     c dbsfc (stored in Ritop to conserve stack memory)
250     c - buoyancy difference with respect to the surface
251     c g * [ drho{1,k}/rho{1,k} - drho{k,k}/rho{k,k} ] (m/s^2)
252     c ttalpha (stored in vddiff(:,:,:,1) to conserve stack memory)
253     c - thermal expansion coefficient without 1/rho factor
254     c d(rho{k,k})/d(T(k)) (kg/m^3/C)
255     c ssbeta (stored in vddiff(:,:,:,2) to conserve stack memory)
256     c - salt expansion coefficient without 1/rho factor
257     c d(rho{k,k})/d(S(k)) (kg/m^3/PSU)
258     c------------------------------------------------------------------------
259    
260     CALL TIMER_START('STATEKPP [KPP_CALC]', myThid)
261     CALL STATEKPP(
262 mlosch 1.40 O work2, dbloc, Ritop,
263     O TTALPHA, SSBETA,
264     I ikppkey, bi, bj, myThid )
265 adcroft 1.1 CALL TIMER_STOP ('STATEKPP [KPP_CALC]', myThid)
266    
267     DO k = 1, Nr
268 dimitri 1.34 DO j = 1-OLy, sNy+OLy
269     DO i = 1-OLx, sNx+OLx
270 adcroft 1.1 ghat(i,j,k) = dbloc(i,j,k)
271     ENDDO
272     ENDDO
273     ENDDO
274    
275 heimbach 1.4 #ifdef KPP_SMOOTH_DBLOC
276     c horizontally smooth dbloc with a 121 filter
277     c smooth dbloc stored in ghat to save space
278     c dbloc(k) is buoyancy gradientnote between k and k+1
279     c levels therefore k+1 mask must be used
280    
281     DO k = 1, Nr-1
282 dimitri 1.37 CALL SMOOTH_HORIZ (
283 heimbach 1.4 I k+1, bi, bj,
284 jmc 1.42 U ghat (1-OLx,1-OLy,k),
285 mlosch 1.40 I myThid )
286 heimbach 1.4 ENDDO
287    
288 adcroft 1.1 #endif /* KPP_SMOOTH_DBLOC */
289    
290     #ifdef KPP_SMOOTH_DENS
291     c horizontally smooth density related quantities with 121 filters
292 dimitri 1.37 CALL SMOOTH_HORIZ (
293 heimbach 1.4 I 1, bi, bj,
294 jmc 1.42 U work2,
295 mlosch 1.40 I myThid )
296 adcroft 1.1 DO k = 1, Nr
297 dimitri 1.37 CALL SMOOTH_HORIZ (
298 heimbach 1.4 I k+1, bi, bj,
299 jmc 1.42 U dbloc (1-OLx,1-OLy,k),
300 mlosch 1.40 I myThid )
301 dimitri 1.37 CALL SMOOTH_HORIZ (
302 adcroft 1.1 I k, bi, bj,
303 jmc 1.42 U Ritop (1-OLx,1-OLy,k),
304 mlosch 1.40 I myThid )
305 dimitri 1.37 CALL SMOOTH_HORIZ (
306 adcroft 1.1 I k, bi, bj,
307 jmc 1.42 U TTALPHA(1-OLx,1-OLy,k),
308 mlosch 1.40 I myThid )
309 dimitri 1.37 CALL SMOOTH_HORIZ (
310 adcroft 1.1 I k, bi, bj,
311 jmc 1.42 U SSBETA(1-OLx,1-OLy,k),
312 mlosch 1.40 I myThid )
313 adcroft 1.1 ENDDO
314     #endif /* KPP_SMOOTH_DENS */
315    
316     DO k = 1, Nr
317 mlosch 1.35 km1 = max(1,k-1)
318 dimitri 1.34 DO j = 1-OLy, sNy+OLy
319     DO i = 1-OLx, sNx+OLx
320 adcroft 1.1
321     c zero out dbloc over land points (so that the convective
322     c part of the interior mixing can be diagnosed)
323 jmc 1.28 dbloc(i,j,k) = dbloc(i,j,k) * maskC(i,j,k,bi,bj)
324 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
325 jmc 1.28 ghat(i,j,k) = ghat(i,j,k) * maskC(i,j,k,bi,bj)
326 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
327 jmc 1.28 Ritop(i,j,k) = Ritop(i,j,k) * maskC(i,j,k,bi,bj)
328 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
329 adcroft 1.1 if(k.eq.nzmax(i,j,bi,bj)) then
330     dbloc(i,j,k) = p0
331     ghat(i,j,k) = p0
332     Ritop(i,j,k) = p0
333     endif
334    
335     c numerator of bulk richardson number on grid levels
336     c note: land and ocean bottom values need to be set to zero
337     c so that the subroutine "bldepth" works correctly
338     Ritop(i,j,k) = (zgrid(1)-zgrid(k)) * Ritop(i,j,k)
339    
340 jmc 1.42 ENDDO
341     ENDDO
342     ENDDO
343 adcroft 1.1
344 heimbach 1.11 cph(
345     cph this avoids a single or double recomp./call of statekpp
346 heimbach 1.16 CADJ store work2 = comlev1_kpp, key = ikppkey
347 heimbach 1.27 #ifdef KPP_AUTODIFF_EXCESSIVE_STORE
348 heimbach 1.16 CADJ store dbloc, Ritop, ghat = comlev1_kpp, key = ikppkey
349     CADJ store vddiff = comlev1_kpp, key = ikppkey
350 heimbach 1.33 CADJ store TTALPHA, SSBETA = comlev1_kpp, key = ikppkey
351 heimbach 1.11 #endif
352     cph)
353    
354 mlosch 1.35 CML#ifdef ALLOW_SHELFICE
355     CMLC For the pbl parameterisation to work underneath the ice shelves
356     CMLC it needs to know the surface (ice-ocean) fluxes. However, masking
357     CMLC and indexing problems make this part of the code not work
358     CMLC underneath the ice shelves and the following lines are only here
359     CMLC to remind me that this still needs to be sorted out.
360 mlosch 1.41 CML shelfIceFac = 0. _d 0
361     CML IF ( useShelfIce ) selfIceFac = 1. _d 0
362 mlosch 1.35 CML DO j = jmin, jmax
363     CML DO i = imin, imax
364 mlosch 1.41 CML surfForcT = surfaceForcingT(i,j,bi,bj)
365     CML & + shelficeForcingT(i,j,bi,bj) * shelfIceFac
366     CML surfForcS = surfaceForcingS(i,j,bi,bj)
367     CML & + shelficeForcingS(i,j,bi,bj) * shelfIceFac
368 jmc 1.42 CML ENDDO
369     CML ENDDO
370 mlosch 1.35 CML#endif /* ALLOW_SHELFICE */
371 heimbach 1.11
372 mlosch 1.41 c------------------------------------------------------------------------
373     c friction velocity, turbulent and radiative surface buoyancy forcing
374     c -------------------------------------------------------------------
375     c taux / rho = surfaceForcingU (N/m^2)
376     c tauy / rho = surfaceForcingV (N/m^2)
377     c ustar = sqrt( sqrt( taux^2 + tauy^2 ) / rho ) (m/s)
378     c bo = - g * ( alpha*surfaceForcingT +
379     c beta *surfaceForcingS ) / rho (m^2/s^3)
380     c bosol = - g * alpha * Qsw * drF(1) / rho (m^2/s^3)
381 dimitri 1.44 c boplume = g * (beta * saltPlumeFlux/rhoConst ) /rho (m^2/s^3)
382 adcroft 1.1 c------------------------------------------------------------------------
383     c velocity shear
384     c --------------
385     c Get velocity shear squared, averaged from "u,v-grid"
386     c onto "t-grid" (in (m/s)**2):
387     c dVsq(k)=(Uref-U(k))**2+(Vref-V(k))**2 at grid levels
388     c shsq(k)=(U(k)-U(k+1))**2+(V(k)-V(k+1))**2 at interfaces
389 mlosch 1.41 c
390     c note: Vref can depend on the surface fluxes that is why we compute
391     c dVsq in the subroutine that does the surface related stuff
392     c (admittedly this is a bit messy)
393 adcroft 1.1 c------------------------------------------------------------------------
394 jmc 1.42
395 mlosch 1.41 CALL KPP_FORCING_SURF(
396     I work2, surfaceForcingU, surfaceForcingV,
397 jmc 1.42 I surfaceForcingT, surfaceForcingS, surfaceForcingTice,
398 dimitri 1.44 I Qsw,
399     #ifdef ALLOW_SALT_PLUME
400     I saltPlumeFlux,
401     #endif /* ALLOW_SALT_PLUME */
402     I ttalpha, ssbeta,
403     O ustar, bo, bosol,
404     #ifdef ALLOW_SALT_PLUME
405     O boplume,
406     #endif /* ALLOW_SALT_PLUME */
407     O dVsq,
408 mlosch 1.41 I ikppkey, iMin, iMax, jMin, jMax, bi, bj, myTime, myThid )
409    
410     CMLcph(
411     CMLCADJ store ustar = comlev1_kpp, key = ikppkey
412     CMLcph)
413 adcroft 1.1
414 heimbach 1.4 c initialize arrays to zero
415     DO k = 1, Nr
416 mlosch 1.41 DO j = 1-OLy, sNy+OLy
417     DO i = 1-OLx, sNx+OLx
418     shsq(i,j,k) = p0
419 jmc 1.42 ENDDO
420     ENDDO
421     ENDDO
422 adcroft 1.1
423     c shsq computation
424     DO k = 1, Nrm1
425 mlosch 1.41 kp1 = k + 1
426     DO j = jmin, jmax
427     jm1 = j - 1
428     jp1 = j + 1
429     DO i = imin, imax
430     im1 = i - 1
431     ip1 = i + 1
432     shsq(i,j,k) = p5 * (
433 jmc 1.42 & (uVel(i, j, k,bi,bj)-uVel(i, j, kp1,bi,bj)) *
434     & (uVel(i, j, k,bi,bj)-uVel(i, j, kp1,bi,bj)) +
435     & (uVel(ip1,j, k,bi,bj)-uVel(ip1,j, kp1,bi,bj)) *
436     & (uVel(ip1,j, k,bi,bj)-uVel(ip1,j, kp1,bi,bj)) +
437     & (vVel(i, j, k,bi,bj)-vVel(i, j, kp1,bi,bj)) *
438     & (vVel(i, j, k,bi,bj)-vVel(i, j, kp1,bi,bj)) +
439     & (vVel(i, jp1,k,bi,bj)-vVel(i, jp1,kp1,bi,bj)) *
440     & (vVel(i, jp1,k,bi,bj)-vVel(i, jp1,kp1,bi,bj)) )
441 adcroft 1.1 #ifdef KPP_SMOOTH_SHSQ
442 mlosch 1.41 shsq(i,j,k) = p5 * shsq(i,j,k) + p125 * (
443 jmc 1.42 & (uVel(i, jm1,k,bi,bj)-uVel(i, jm1,kp1,bi,bj)) *
444     & (uVel(i, jm1,k,bi,bj)-uVel(i, jm1,kp1,bi,bj)) +
445     & (uVel(ip1,jm1,k,bi,bj)-uVel(ip1,jm1,kp1,bi,bj)) *
446     & (uVel(ip1,jm1,k,bi,bj)-uVel(ip1,jm1,kp1,bi,bj)) +
447     & (uVel(i, jp1,k,bi,bj)-uVel(i, jp1,kp1,bi,bj)) *
448     & (uVel(i, jp1,k,bi,bj)-uVel(i, jp1,kp1,bi,bj)) +
449     & (uVel(ip1,jp1,k,bi,bj)-uVel(ip1,jp1,kp1,bi,bj)) *
450     & (uVel(ip1,jp1,k,bi,bj)-uVel(ip1,jp1,kp1,bi,bj)) +
451     & (vVel(im1,j, k,bi,bj)-vVel(im1,j, kp1,bi,bj)) *
452     & (vVel(im1,j, k,bi,bj)-vVel(im1,j, kp1,bi,bj)) +
453     & (vVel(im1,jp1,k,bi,bj)-vVel(im1,jp1,kp1,bi,bj)) *
454     & (vVel(im1,jp1,k,bi,bj)-vVel(im1,jp1,kp1,bi,bj)) +
455     & (vVel(ip1,j, k,bi,bj)-vVel(ip1,j, kp1,bi,bj)) *
456     & (vVel(ip1,j, k,bi,bj)-vVel(ip1,j, kp1,bi,bj)) +
457     & (vVel(ip1,jp1,k,bi,bj)-vVel(ip1,jp1,kp1,bi,bj)) *
458     & (vVel(ip1,jp1,k,bi,bj)-vVel(ip1,jp1,kp1,bi,bj)) )
459 adcroft 1.1 #endif
460 jmc 1.42 ENDDO
461     ENDDO
462     ENDDO
463 adcroft 1.1
464 heimbach 1.11 cph(
465 heimbach 1.27 #ifdef KPP_AUTODIFF_EXCESSIVE_STORE
466 heimbach 1.16 CADJ store dvsq, shsq = comlev1_kpp, key = ikppkey
467 heimbach 1.11 #endif
468     cph)
469    
470 adcroft 1.1 c-----------------------------------------------------------------------
471     c solve for viscosity, diffusivity, ghat, and hbl on "t-grid"
472     c-----------------------------------------------------------------------
473    
474 dimitri 1.36 c precompute background vertical diffusivities, which are needed for
475     c matching diffusivities at bottom of KPP PBL
476     CALL CALC_3D_DIFFUSIVITY(
477     I bi,bj,1-Olx,sNx+OLx,1-Oly,sNy+OLy,
478     I GAD_SALINITY, .FALSE., .FALSE.,
479     O KPPdiffKzS(1-Olx,1-Oly,1,bi,bj),
480     I myThid)
481     CALL CALC_3D_DIFFUSIVITY(
482     I bi,bj,1-Olx,sNx+OLx,1-Oly,sNy+OLy,
483     I GAD_TEMPERATURE, .FALSE., .FALSE.,
484     O KPPdiffKzT(1-Olx,1-Oly,1,bi,bj),
485     I myThid)
486    
487 dimitri 1.34 DO j = 1-OLy, sNy+OLy
488     DO i = 1-OLx, sNx+OLx
489 adcroft 1.1 work1(i,j) = nzmax(i,j,bi,bj)
490     work2(i,j) = Fcori(i,j,bi,bj)
491 jmc 1.42 ENDDO
492     ENDDO
493 adcroft 1.1 CALL TIMER_START('KPPMIX [KPP_CALC]', myThid)
494     CALL KPPMIX (
495 mlosch 1.40 I work1, shsq, dVsq, ustar
496     I , maskC(1-Olx,1-Oly,1,bi,bj)
497 dimitri 1.44 I , bo, bosol
498     #ifdef ALLOW_SALT_PLUME
499     I , boplume,SaltPlumeDepth
500     #endif /* ALLOW_SALT_PLUME */
501     I , dbloc, Ritop, work2
502 dimitri 1.36 I , KPPdiffKzS(1-Olx,1-Oly,1,bi,bj)
503     I , KPPdiffKzT(1-Olx,1-Oly,1,bi,bj)
504 heimbach 1.16 I , ikppkey
505 adcroft 1.1 O , vddiff
506     U , ghat
507 mlosch 1.40 O , hbl
508 heimbach 1.43 I , mytime, myIter, mythid )
509 adcroft 1.1 CALL TIMER_STOP ('KPPMIX [KPP_CALC]', myThid)
510    
511     c-----------------------------------------------------------------------
512 heimbach 1.4 c zero out land values and transfer to global variables
513 adcroft 1.1 c-----------------------------------------------------------------------
514    
515     DO j = jmin, jmax
516 heimbach 1.4 DO i = imin, imax
517     DO k = 1, Nr
518 mlosch 1.35 km1 = max(1,k-1)
519 jmc 1.28 KPPviscAz(i,j,k,bi,bj) = vddiff(i,j,k-1,1) * maskC(i,j,k,bi,bj)
520 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
521 jmc 1.28 KPPdiffKzS(i,j,k,bi,bj)= vddiff(i,j,k-1,2) * maskC(i,j,k,bi,bj)
522 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
523 jmc 1.28 KPPdiffKzT(i,j,k,bi,bj)= vddiff(i,j,k-1,3) * maskC(i,j,k,bi,bj)
524 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
525 jmc 1.28 KPPghat(i,j,k,bi,bj) = ghat(i,j,k) * maskC(i,j,k,bi,bj)
526 mlosch 1.35 & * maskC(i,j,km1,bi,bj)
527 jmc 1.42 ENDDO
528 mlosch 1.35 k = 1
529     #ifdef ALLOW_SHELFICE
530     if ( useShelfIce ) k = kTopC(i,j,bi,bj)
531     #endif /* ALLOW_SHELFICE */
532     KPPhbl(i,j,bi,bj) = hbl(i,j) * maskC(i,j,k,bi,bj)
533    
534 jmc 1.42 ENDDO
535     ENDDO
536 adcroft 1.1
537     #ifdef KPP_SMOOTH_VISC
538     c horizontal smoothing of vertical viscosity
539     DO k = 1, Nr
540 heimbach 1.4 CALL SMOOTH_HORIZ (
541 adcroft 1.1 I k, bi, bj,
542 jmc 1.42 U KPPviscAz(1-OLx,1-OLy,k,bi,bj),
543 mlosch 1.40 I myThid )
544 jmc 1.42 ENDDO
545     C jmc: No EXCH inside bi,bj loop !!!
546     c _EXCH_XYZ_R8(KPPviscAz , myThid )
547 adcroft 1.1 #endif /* KPP_SMOOTH_VISC */
548    
549     #ifdef KPP_SMOOTH_DIFF
550     c horizontal smoothing of vertical diffusivity
551     DO k = 1, Nr
552 heimbach 1.4 CALL SMOOTH_HORIZ (
553 adcroft 1.1 I k, bi, bj,
554 jmc 1.42 U KPPdiffKzS(1-OLx,1-OLy,k,bi,bj),
555 mlosch 1.40 I myThid )
556 heimbach 1.4 CALL SMOOTH_HORIZ (
557 adcroft 1.1 I k, bi, bj,
558 jmc 1.42 U KPPdiffKzT(1-OLx,1-OLy,k,bi,bj),
559 mlosch 1.40 I myThid )
560 jmc 1.42 ENDDO
561 adcroft 1.1 #endif /* KPP_SMOOTH_DIFF */
562 heimbach 1.11
563     cph(
564     cph crucial: this avoids full recomp./call of kppmix
565 heimbach 1.16 CADJ store KPPhbl = comlev1_kpp, key = ikppkey
566 heimbach 1.11 cph)
567 adcroft 1.1
568     C Compute fraction of solar short-wave flux penetrating to
569     C the bottom of the mixing layer.
570     DO j=1-OLy,sNy+OLy
571     DO i=1-OLx,sNx+OLx
572     worka(i,j) = KPPhbl(i,j,bi,bj)
573     ENDDO
574     ENDDO
575     CALL SWFRAC(
576 heimbach 1.4 I (sNx+2*OLx)*(sNy+2*OLy), minusone,
577 jmc 1.42 U worka,
578     I myTime, myIter, myThid )
579 adcroft 1.1 DO j=1-OLy,sNy+OLy
580     DO i=1-OLx,sNx+OLx
581 heimbach 1.4 KPPfrac(i,j,bi,bj) = worka(i,j)
582 adcroft 1.1 ENDDO
583     ENDDO
584    
585 dimitri 1.44 #ifdef ALLOW_SALT_PLUME
586     C Compute fraction of saltplume (flux) penetrating to
587     C the bottom of the mixing layer.
588     DO j=1-OLy,sNy+OLy
589     DO i=1-OLx,sNx+OLx
590     worka(i,j) = KPPhbl(i,j,bi,bj)
591     ENDDO
592     ENDDO
593     CALL PLUMEFRAC(
594     I (sNx+2*OLx)*(sNy+2*OLy), minusone,SaltPlumeDepth,
595     U worka,
596     I myTime, myIter, myThid )
597     DO j=1-OLy,sNy+OLy
598     DO i=1-OLx,sNx+OLx
599     KPPplumefrac(i,j,bi,bj) = worka(i,j)
600     ENDDO
601     ENDDO
602     #endif /* ALLOW_SALT_PLUME */
603    
604 adcroft 1.1 ENDIF
605    
606 adcroft 1.9 #endif /* ALLOW_KPP */
607 adcroft 1.1
608 heimbach 1.8 RETURN
609     END
610    
611 jmc 1.42 SUBROUTINE KPP_CALC_DUMMY(
612     I bi, bj, myTime, myIter, myThid )
613     C *==========================================================*
614 heimbach 1.8 C | SUBROUTINE KPP_CALC_DUMMY |
615     C | o Compute all KPP fields defined in KPP.h |
616     C | o Dummy routine for TAMC
617 jmc 1.42 C *==========================================================*
618 heimbach 1.8 C | This subroutine serves as an interface between MITGCMUV |
619     C | code and NCOM 1-D routines in kpp_routines.F |
620 jmc 1.42 C *==========================================================*
621 heimbach 1.8 IMPLICIT NONE
622    
623     #include "SIZE.h"
624     #include "EEPARAMS.h"
625     #include "PARAMS.h"
626     #include "KPP.h"
627     #include "KPP_PARAMS.h"
628     #include "GRID.h"
629 dimitri 1.36 #include "GAD.h"
630 heimbach 1.8
631     c Routine arguments
632 jmc 1.42 c bi, bj :: Current tile indices
633     c myTime :: Current time in simulation
634     c myIter :: Current iteration number in simulation
635     c myThid :: My Thread Id. number
636 heimbach 1.8
637     INTEGER bi, bj
638 jmc 1.42 _RL myTime
639     INTEGER myIter
640 heimbach 1.8 INTEGER myThid
641    
642     #ifdef ALLOW_KPP
643    
644     c Local constants
645     integer i, j, k
646    
647     DO j=1-OLy,sNy+OLy
648     DO i=1-OLx,sNx+OLx
649     KPPhbl (i,j,bi,bj) = 1.0
650     KPPfrac(i,j,bi,bj) = 0.0
651 dimitri 1.44 #ifdef ALLOW_SALT_PLUME
652     KPPplumefrac(i,j,bi,bj) = 0.0
653     #endif /* ALLOW_SALT_PLUME */
654 heimbach 1.8 DO k = 1,Nr
655     KPPghat (i,j,k,bi,bj) = 0.0
656 jmc 1.21 KPPviscAz (i,j,k,bi,bj) = viscAr
657 heimbach 1.8 ENDDO
658     ENDDO
659     ENDDO
660 dimitri 1.36
661     CALL CALC_3D_DIFFUSIVITY(
662     I bi,bj,1-Olx,sNx+OLx,1-Oly,sNy+OLy,
663     I GAD_SALINITY, .FALSE., .FALSE.,
664     O KPPdiffKzS(1-Olx,1-Oly,1,bi,bj),
665     I myThid)
666     CALL CALC_3D_DIFFUSIVITY(
667     I bi,bj,1-Olx,sNx+OLx,1-Oly,sNy+OLy,
668     I GAD_TEMPERATURE, .FALSE., .FALSE.,
669     O KPPdiffKzT(1-Olx,1-Oly,1,bi,bj),
670     I myThid)
671    
672 heimbach 1.8 #endif
673 adcroft 1.1 RETURN
674     END

  ViewVC Help
Powered by ViewVC 1.1.22