/[MITgcm]/MITgcm_contrib/atnguyen/code_21Dec2012_saltplume/kpp_calc.F
ViewVC logotype

Annotation of /MITgcm_contrib/atnguyen/code_21Dec2012_saltplume/kpp_calc.F

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


Revision 1.3 - (hide annotations) (download)
Tue Apr 29 07:26:42 2014 UTC (11 years, 3 months ago) by atn
Branch: MAIN
Changes since 1.2: +3 -1 lines
add missing ndef SALT_PLUME_VOLUME

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

  ViewVC Help
Powered by ViewVC 1.1.22