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

Diff of /MITgcm/pkg/kpp/kpp_routines.F

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

revision 1.27 by dimitri, Mon Apr 23 21:09:19 2007 UTC revision 1.35 by jmc, Fri Oct 19 19:11:17 2007 UTC
# Line 19  C--  o STATEKPP    - Compute buoyancy-re Line 19  C--  o STATEKPP    - Compute buoyancy-re
19  c***********************************************************************  c***********************************************************************
20    
21        SUBROUTINE KPPMIX (        SUBROUTINE KPPMIX (
22       I       mytime, mythid       I       kmtj, shsq, dvsq, ustar, msk
23       I     , kmtj, shsq, dvsq, ustar       I     , bo, bosol
24       I     , bo, bosol, dbloc, Ritop, coriol  #ifdef ALLOW_SALT_PLUME
25         I     , boplume,SPDepth
26    #endif /* ALLOW_SALT_PLUME */
27         I     , dbloc, Ritop, coriol
28       I     , diffusKzS, diffusKzT       I     , diffusKzS, diffusKzT
29       I     , ikppkey       I     , ikppkey
30       O     , diffus       O     , diffus
31       U     , ghat       U     , ghat
32       O     , hbl )       O     , hbl
33         I     , myTime, myIter, myThid )
34    
35  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
36  c  c
# Line 50  c--------------------------------------- Line 54  c---------------------------------------
54  #include "KPP_PARAMS.h"  #include "KPP_PARAMS.h"
55    
56  c input  c input
57  c     myTime           - current time in simulation  c   myTime :: Current time in simulation
58  c     myThid           - thread number for this instance of the routine  c   myIter :: Current iteration number in simulation
59    c   myThid :: My Thread Id. number
60  c     kmtj   (imt)     - number of vertical layers on this row  c     kmtj   (imt)     - number of vertical layers on this row
61    c     msk    (imt)     - surface mask (=1 if water, =0 otherwise)
62  c     shsq   (imt,Nr)  - (local velocity shear)^2                     ((m/s)^2)  c     shsq   (imt,Nr)  - (local velocity shear)^2                     ((m/s)^2)
63  c     dvsq   (imt,Nr)  - (velocity shear re sfc)^2                    ((m/s)^2)  c     dvsq   (imt,Nr)  - (velocity shear re sfc)^2                    ((m/s)^2)
64  c     ustar  (imt)     - surface friction velocity                        (m/s)  c     ustar  (imt)     - surface friction velocity                        (m/s)
65  c     bo     (imt)     - surface turbulent buoy. forcing              (m^2/s^3)  c     bo     (imt)     - surface turbulent buoy. forcing              (m^2/s^3)
66  c     bosol  (imt)     - radiative buoyancy forcing                   (m^2/s^3)  c     bosol  (imt)     - radiative buoyancy forcing                   (m^2/s^3)
67    c     boplume(imt)     - haline buoyancy forcing                      (m^2/s^3)
68  c     dbloc  (imt,Nr)  - local delta buoyancy across interfaces         (m/s^2)  c     dbloc  (imt,Nr)  - local delta buoyancy across interfaces         (m/s^2)
69  c     dblocSm(imt,Nr)  - horizontally smoothed dbloc                    (m/s^2)  c     dblocSm(imt,Nr)  - horizontally smoothed dbloc                    (m/s^2)
70  c                          stored in ghat to save space  c                          stored in ghat to save space
# Line 70  c     note: there is a conversion from 2 Line 77  c     note: there is a conversion from 2
77  c           e.g., hbl(sNx,sNy) -> hbl(imt),  c           e.g., hbl(sNx,sNy) -> hbl(imt),
78  c           where hbl(i,j) -> hbl((j-1)*sNx+i)  c           where hbl(i,j) -> hbl((j-1)*sNx+i)
79    
80        _RL     mytime        _RL     myTime
81        integer mythid        integer myIter
82          integer myThid
83        integer kmtj (imt   )        integer kmtj (imt   )
84        _RL shsq     (imt,Nr)        _RL shsq     (imt,Nr)
85        _RL dvsq     (imt,Nr)        _RL dvsq     (imt,Nr)
86        _RL ustar    (imt   )        _RL ustar    (imt   )
87        _RL bo       (imt   )        _RL bo       (imt   )
88        _RL bosol    (imt   )        _RL bosol    (imt   )
89    #ifdef ALLOW_SALT_PLUME
90          _RL boplume  (imt   )
91          _RL SPDepth  (imt   )
92    #endif /* ALLOW_SALT_PLUME */
93        _RL dbloc    (imt,Nr)        _RL dbloc    (imt,Nr)
94        _RL Ritop    (imt,Nr)        _RL Ritop    (imt,Nr)
95        _RL coriol   (imt   )        _RL coriol   (imt   )
96          _RS msk      (imt   )
97        _RL diffusKzS(imt,Nr)        _RL diffusKzS(imt,Nr)
98        _RL diffusKzT(imt,Nr)        _RL diffusKzT(imt,Nr)
99    
# Line 136  cph) Line 149  cph)
149       I       kmtj, shsq, dbloc, ghat       I       kmtj, shsq, dbloc, ghat
150       I     , diffusKzS, diffusKzT       I     , diffusKzS, diffusKzT
151       I     , ikppkey       I     , ikppkey
152       O     , diffus )       O     , diffus, myThid )
153    
154  cph(  cph(
155  cph these storings avoid recomp. of Ri_iwmix  cph these storings avoid recomp. of Ri_iwmix
# Line 153  c for blmix Line 166  c for blmix
166  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
167    
168        do md = 1, mdiff        do md = 1, mdiff
169           do k=1,Nrp1
170           do i = 1,imt           do i = 1,imt
171              do k=kmtj(i),Nrp1               if(k.ge.kmtj(i))  diffus(i,k,md) = 0.0
                diffus(i,k,md) = 0.0  
172              end do              end do
173           end do           end do
174        end do        end do
# Line 167  c diagnose the new boundary layer depth Line 180  c diagnose the new boundary layer depth
180  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
181    
182        call bldepth (        call bldepth (
183       I       mytime, mythid       I       kmtj
184       I     , kmtj       I     , dvsq, dbloc, Ritop, ustar, bo, bosol
185       I     , dvsq, dbloc, Ritop, ustar, bo, bosol, coriol  #ifdef ALLOW_SALT_PLUME
186         I     , boplume,SPDepth
187    #endif /* ALLOW_SALT_PLUME */
188         I     , coriol
189       I     , ikppkey       I     , ikppkey
190       O     , hbl, bfsfc, stable, casea, kbl, Rib, sigma       O     , hbl, bfsfc, stable, casea, kbl, Rib, sigma
191       &     )       I     , myTime, myIter, myThid )
192    
193  CADJ STORE hbl,bfsfc,stable,casea,kbl = comlev1_kpp, key = ikppkey  CADJ STORE hbl,bfsfc,stable,casea,kbl = comlev1_kpp, key = ikppkey
194    
# Line 183  c--------------------------------------- Line 199  c---------------------------------------
199        call blmix (        call blmix (
200       I       ustar, bfsfc, hbl, stable, casea, diffus, kbl       I       ustar, bfsfc, hbl, stable, casea, diffus, kbl
201       O     , dkm1, blmc, ghat, sigma, ikppkey       O     , dkm1, blmc, ghat, sigma, ikppkey
202       &     )       I     , myThid )
203  cph(  cph(
204  CADJ STORE dkm1,blmc,ghat = comlev1_kpp, key = ikppkey  CADJ STORE dkm1,blmc,ghat = comlev1_kpp, key = ikppkey
205  CADJ STORE hbl, kbl, diffus, casea = comlev1_kpp, key = ikppkey  CADJ STORE hbl, kbl, diffus, casea = comlev1_kpp, key = ikppkey
# Line 196  c--------------------------------------- Line 212  c---------------------------------------
212        call enhance (        call enhance (
213       I       dkm1, hbl, kbl, diffus, casea       I       dkm1, hbl, kbl, diffus, casea
214       U     , ghat       U     , ghat
215       O     , blmc )       O     , blmc
216         I     , myThid )
217    
218  cph(  cph(
219  cph avoids recomp. of enhance  cph avoids recomp. of enhance
# Line 212  c--------------------------------------- Line 229  c---------------------------------------
229        do k = 1, Nr        do k = 1, Nr
230           do i = 1, imt           do i = 1, imt
231              if (k .lt. kbl(i)) then              if (k .lt. kbl(i)) then
232    #ifdef ALLOW_SHELFICE
233    C     when there is shelfice on top (msk(i)=0), reset the boundary layer
234    C     mixing coefficients blmc to pure Ri-number based mixing
235                   blmc(i,k,1) = max ( blmc(i,k,1)*msk(i),
236         &              diffus(i,k,1) )
237                   blmc(i,k,2) = max ( blmc(i,k,2)*msk(i),
238         &              diffus(i,k,2) )
239                   blmc(i,k,3) = max ( blmc(i,k,3)*msk(i),
240         &              diffus(i,k,3) )
241    #endif /* not ALLOW_SHELFICE */
242                 diffus(i,k,1) = max ( blmc(i,k,1), viscAr  )                 diffus(i,k,1) = max ( blmc(i,k,1), viscAr  )
243                 diffus(i,k,2) = max ( blmc(i,k,2), diffusKzS(i,Nr) )                 diffus(i,k,2) = max ( blmc(i,k,2), diffusKzS(i,Nr) )
244                 diffus(i,k,3) = max ( blmc(i,k,3), diffusKzT(i,Nr) )                 diffus(i,k,3) = max ( blmc(i,k,3), diffusKzT(i,Nr) )
# Line 229  c--------------------------------------- Line 256  c---------------------------------------
256  c*************************************************************************  c*************************************************************************
257    
258        subroutine bldepth (        subroutine bldepth (
259       I       mytime, mythid       I       kmtj
260       I     , kmtj       I     , dvsq, dbloc, Ritop, ustar, bo, bosol
261       I     , dvsq, dbloc, Ritop, ustar, bo, bosol, coriol  #ifdef ALLOW_SALT_PLUME
262         I     , boplume,SPDepth
263    #endif /* ALLOW_SALT_PLUME */
264         I     , coriol
265       I     , ikppkey       I     , ikppkey
266       O     , hbl, bfsfc, stable, casea, kbl, Rib, sigma       O     , hbl, bfsfc, stable, casea, kbl, Rib, sigma
267       &     )       I     , myTime, myIter, myThid )
268    
269  c     the oceanic planetary boundary layer depth, hbl, is determined as  c     the oceanic planetary boundary layer depth, hbl, is determined as
270  c     the shallowest depth where the bulk Richardson number is  c     the shallowest depth where the bulk Richardson number is
# Line 264  c Line 294  c
294    
295  c input  c input
296  c------  c------
297  c myTime    : current time in simulation  c   myTime :: Current time in simulation
298  c myThid    : thread number for this instance of the routine  c   myIter :: Current iteration number in simulation
299    c   myThid :: My Thread Id. number
300  c kmtj      : number of vertical layers  c kmtj      : number of vertical layers
301  c dvsq      : (velocity shear re sfc)^2             ((m/s)^2)  c dvsq      : (velocity shear re sfc)^2             ((m/s)^2)
302  c dbloc     : local delta buoyancy across interfaces  (m/s^2)  c dbloc     : local delta buoyancy across interfaces  (m/s^2)
# Line 275  c             buoyancy with respect to s Line 306  c             buoyancy with respect to s
306  c ustar     : surface friction velocity                 (m/s)  c ustar     : surface friction velocity                 (m/s)
307  c bo        : surface turbulent buoyancy forcing    (m^2/s^3)  c bo        : surface turbulent buoyancy forcing    (m^2/s^3)
308  c bosol     : radiative buoyancy forcing            (m^2/s^3)  c bosol     : radiative buoyancy forcing            (m^2/s^3)
309    c boplume   : haline buoyancy forcing               (m^2/s^3)
310  c coriol    : Coriolis parameter                        (1/s)  c coriol    : Coriolis parameter                        (1/s)
311        _RL     mytime        _RL     myTime
312        integer mythid        integer myIter
313          integer myThid
314        integer kmtj(imt)        integer kmtj(imt)
315        _RL dvsq    (imt,Nr)        _RL dvsq    (imt,Nr)
316        _RL dbloc   (imt,Nr)        _RL dbloc   (imt,Nr)
# Line 287  c coriol    : Coriolis parameter Line 320  c coriol    : Coriolis parameter
320        _RL bosol   (imt)        _RL bosol   (imt)
321        _RL coriol  (imt)        _RL coriol  (imt)
322        integer ikppkey, kkppkey        integer ikppkey, kkppkey
323    #ifdef ALLOW_SALT_PLUME
324          _RL boplume (imt)
325          _RL SPDepth (imt)
326    #endif /* ALLOW_SALT_PLUME */
327    
328  c  output  c  output
329  c--------  c--------
# Line 312  c------- Line 349  c-------
349  c wm, ws    : turbulent velocity scales         (m/s)  c wm, ws    : turbulent velocity scales         (m/s)
350        _RL wm(imt), ws(imt)        _RL wm(imt), ws(imt)
351        _RL worka(imt)        _RL worka(imt)
   
352        _RL bvsq, vtsq, hekman, hmonob, hlimit, tempVar1, tempVar2        _RL bvsq, vtsq, hekman, hmonob, hlimit, tempVar1, tempVar2
353        integer i, kl        integer i, kl
354    
# Line 351  c     compute bfsfc = sw fraction at hbf Line 387  c     compute bfsfc = sw fraction at hbf
387           end do           end do
388  CADJ store worka = comlev1_kpp_k, key = kkppkey  CADJ store worka = comlev1_kpp_k, key = kkppkey
389           call SWFRAC(           call SWFRAC(
390       I        imt, hbf,       I       imt, hbf,
391       I        mytime, mythid,       U       worka,
392       U        worka )       I       myTime, myIter, myThid )
393  CADJ store worka = comlev1_kpp_k, key = kkppkey  CADJ store worka = comlev1_kpp_k, key = kkppkey
394    
   
395           do i = 1, imt           do i = 1, imt
396    
397  c     use caseA as temporary array  c     use caseA as temporary array
# Line 366  c     use caseA as temporary array Line 401  c     use caseA as temporary array
401  c     compute bfsfc= Bo + radiative contribution down to hbf * hbl  c     compute bfsfc= Bo + radiative contribution down to hbf * hbl
402    
403              bfsfc(i) = bo(i) + bosol(i)*(1. - worka(i))              bfsfc(i) = bo(i) + bosol(i)*(1. - worka(i))
             stable(i) = p5 + sign(p5,bfsfc(i))  
             sigma(i) = stable(i) + (1. - stable(i)) * epsilon  
404    
405           end do           end do
406    #ifdef ALLOW_SALT_PLUME
407    c     compute bfsfc = plume fraction at hbf * zgrid
408             do i = 1, imt
409                worka(i) = zgrid(kl)
410             enddo
411             call PLUMEFRAC(
412         I       imt, hbf,SPDepth,
413         U       worka,
414         I       myTime, myIter, myThid)
415             do i = 1, imt
416                bfsfc(i) = bfsfc(i) + boplume(i)*(1. - worka(i))
417             enddo
418    #endif /* ALLOW_SALT_PLUME */
419    
420             do i = 1, imt
421                stable(i) = p5 + sign(p5,bfsfc(i))
422                sigma(i) = stable(i) + (1. - stable(i)) * epsilon
423             enddo
424    
425  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
426  c     compute velocity scales at sigma, for hbl= caseA = -zgrid(kl)  c     compute velocity scales at sigma, for hbl= caseA = -zgrid(kl)
# Line 377  c--------------------------------------- Line 428  c---------------------------------------
428    
429           call wscale (           call wscale (
430       I        sigma, casea, ustar, bfsfc,       I        sigma, casea, ustar, bfsfc,
431       O        wm, ws )       O        wm, ws, myThid )
432  CADJ store ws = comlev1_kpp_k, key = kkppkey  CADJ store ws = comlev1_kpp_k, key = kkppkey
433    
434           do i = 1, imt           do i = 1, imt
# Line 454  c--------------------------------------- Line 505  c---------------------------------------
505  CADJ store worka = comlev1_kpp  CADJ store worka = comlev1_kpp
506  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
507        call SWFRAC(        call SWFRAC(
508       I     imt, minusone,       I       imt, minusone,
509       I     mytime, mythid,       U       worka,
510       U     worka )       I       myTime, myIter, myThid )
511  CADJ store worka = comlev1_kpp  CADJ store worka = comlev1_kpp
512  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
513    
514        do i = 1, imt        do i = 1, imt
515           bfsfc(i)  = bo(i) + bosol(i) * (1. - worka(i))           bfsfc(i)  = bo(i) + bosol(i) * (1. - worka(i))
516        end do        end do
517    
518    #ifdef ALLOW_SALT_PLUME
519          do i = 1, imt
520             worka(i) = hbl(i)
521          enddo
522          call PLUMEFRAC(
523         I       imt,minusone,SPDepth,
524         U       worka,
525         I       myTime, myIter, myThid )
526          do i = 1, imt
527             bfsfc(i) = bfsfc(i) + boplume(i) * (1. - worka(i))
528          enddo
529    #endif /* ALLOW_SALT_PLUME */
530  CADJ store bfsfc = comlev1_kpp  CADJ store bfsfc = comlev1_kpp
531  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
532    
# Line 527  CADJ store worka = comlev1_kpp Line 591  CADJ store worka = comlev1_kpp
591  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
592        call SWFRAC(        call SWFRAC(
593       I     imt, minusone,       I     imt, minusone,
594       I     mytime, mythid,       U     worka,
595       U     worka )       I     myTime, myIter, myThid )
596  CADJ store worka = comlev1_kpp  CADJ store worka = comlev1_kpp
597  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
598    
599        do i = 1, imt        do i = 1, imt
600           bfsfc(i) = bo(i) + bosol(i) * (1. - worka(i))           bfsfc(i) = bo(i) + bosol(i) * (1. - worka(i))
601        end do        end do
602    
603    #ifdef ALLOW_SALT_PLUME
604          do i = 1, imt
605             worka(i) = hbl(i)
606          enddo
607          call PLUMEFRAC(
608         I       imt,minusone,SPDepth,
609         U       worka,
610         I       myTime, myIter, myThid )
611          do i = 1, imt
612             bfsfc(i) = bfsfc(i) + boplume(i) * (1. - worka(i))
613          enddo
614    #endif /* ALLOW_SALT_PLUME */
615  CADJ store bfsfc = comlev1_kpp  CADJ store bfsfc = comlev1_kpp
616  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)  CADJ &   , key = ikppkey, shape = (/ (sNx+2*OLx)*(sNy+2*OLy) /)
617    
# Line 562  c*************************************** Line 639  c***************************************
639    
640        subroutine wscale (        subroutine wscale (
641       I     sigma, hbl, ustar, bfsfc,       I     sigma, hbl, ustar, bfsfc,
642       O     wm, ws )       O     wm, ws,
643         I     myThid )
644    
645  c     compute turbulent velocity scales.  c     compute turbulent velocity scales.
646  c     use a 2D-lookup table for wm and ws as functions of ustar and  c     use a 2D-lookup table for wm and ws as functions of ustar and
# Line 583  c sigma   : normalized depth (d/hbl) Line 661  c sigma   : normalized depth (d/hbl)
661  c hbl     : boundary layer depth (m)  c hbl     : boundary layer depth (m)
662  c ustar   : surface friction velocity         (m/s)  c ustar   : surface friction velocity         (m/s)
663  c bfsfc   : total surface buoyancy flux       (m^2/s^3)  c bfsfc   : total surface buoyancy flux       (m^2/s^3)
664    c myThid  : thread number for this instance of the routine
665          integer myThid
666        _RL sigma(imt)        _RL sigma(imt)
667        _RL hbl  (imt)        _RL hbl  (imt)
668        _RL ustar(imt)        _RL ustar(imt)
# Line 657  c--------------------------------------- Line 737  c---------------------------------------
737  c*************************************************************************  c*************************************************************************
738    
739        subroutine Ri_iwmix (        subroutine Ri_iwmix (
740       I       kmtj, shsq, dbloc, dblocSm       I       kmtj, shsq, dbloc, dblocSm,
741       I     , diffusKzS, diffusKzT       I       diffusKzS, diffusKzT,
742       I     , ikppkey       I       ikppkey,
743       O     , diffus )       O       diffus,
744         I       myThid )
745    
746  c     compute interior viscosity diffusivity coefficients due  c     compute interior viscosity diffusivity coefficients due
747  c     to shear instability (dependent on a local Richardson number),  c     to shear instability (dependent on a local Richardson number),
# Line 681  c     dbloc  (imt,Nr)      local delta b Line 762  c     dbloc  (imt,Nr)      local delta b
762  c     dblocSm(imt,Nr)      horizontally smoothed dbloc              (m/s^2)  c     dblocSm(imt,Nr)      horizontally smoothed dbloc              (m/s^2)
763  c     diffusKzS(imt,Nr)- background vertical diffusivity for scalars    (m^2/s)  c     diffusKzS(imt,Nr)- background vertical diffusivity for scalars    (m^2/s)
764  c     diffusKzT(imt,Nr)- background vertical diffusivity for theta      (m^2/s)  c     diffusKzT(imt,Nr)- background vertical diffusivity for theta      (m^2/s)
765    c     myThid :: My Thread Id. number
766        integer kmtj (imt)        integer kmtj (imt)
767        _RL shsq     (imt,Nr)        _RL shsq     (imt,Nr)
768        _RL dbloc    (imt,Nr)        _RL dbloc    (imt,Nr)
# Line 688  c     diffusKzT(imt,Nr)- background vert Line 770  c     diffusKzT(imt,Nr)- background vert
770        _RL diffusKzS(imt,Nr)        _RL diffusKzS(imt,Nr)
771        _RL diffusKzT(imt,Nr)        _RL diffusKzT(imt,Nr)
772        integer ikppkey        integer ikppkey
773          integer myThid
774    
775  c output  c output
776  c     diffus(imt,0:Nrp1,1)  vertical viscosivity coefficient        (m^2/s)  c     diffus(imt,0:Nrp1,1)  vertical viscosivity coefficient        (m^2/s)
# Line 760  CADJ store diffus(:,:,1) = kpp_ri_tape_m Line 843  CADJ store diffus(:,:,1) = kpp_ri_tape_m
843  CADJ &  , key=mr, shape=(/ (sNx+2*OLx)*(sNy+2*OLy),Nr+2 /)  CADJ &  , key=mr, shape=(/ (sNx+2*OLx)*(sNy+2*OLy),Nr+2 /)
844    
845           call z121 (           call z121 (
846       U     diffus(1,0,1))       U     diffus(1,0,1)
847         I     myThid )
848        end do        end do
849  #endif  #endif
850    
# Line 824  c         set surface values to 0.0 Line 908  c         set surface values to 0.0
908  c*************************************************************************  c*************************************************************************
909    
910        subroutine z121 (        subroutine z121 (
911       U     v )       U     v,
912         I     myThid )
913    
914  c     Apply 121 smoothing in k to 2-d array V(i,k=1,Nr)  c     Apply 121 smoothing in k to 2-d array V(i,k=1,Nr)
915  c     top (0) value is used as a dummy  c     top (0) value is used as a dummy
# Line 842  c     penetrative convection. Line 927  c     penetrative convection.
927  c input/output  c input/output
928  c-------------  c-------------
929  c v     : 2-D array to be smoothed in Nrp1 direction  c v     : 2-D array to be smoothed in Nrp1 direction
930    c myThid: thread number for this instance of the routine
931          integer myThid
932        _RL v(imt,0:Nrp1)        _RL v(imt,0:Nrp1)
933    
934  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
# Line 907  c*************************************** Line 994  c***************************************
994    
995        subroutine smooth_horiz (        subroutine smooth_horiz (
996       I     k, bi, bj,       I     k, bi, bj,
997       U     fld )       U     fld,
998         I     myThid )
999    
1000  c     Apply horizontal smoothing to global _RL 2-D array  c     Apply horizontal smoothing to global _RL 2-D array
1001    
# Line 919  c     Apply horizontal smoothing to glob Line 1007  c     Apply horizontal smoothing to glob
1007  c     input  c     input
1008  c     bi, bj : array indices  c     bi, bj : array indices
1009  c     k      : vertical index used for masking  c     k      : vertical index used for masking
1010    c     myThid : thread number for this instance of the routine
1011          INTEGER myThid
1012        integer k, bi, bj        integer k, bi, bj
1013    
1014  c     input/output  c     input/output
# Line 989  c*************************************** Line 1079  c***************************************
1079        subroutine blmix (        subroutine blmix (
1080       I       ustar, bfsfc, hbl, stable, casea, diffus, kbl       I       ustar, bfsfc, hbl, stable, casea, diffus, kbl
1081       O     , dkm1, blmc, ghat, sigma, ikppkey       O     , dkm1, blmc, ghat, sigma, ikppkey
1082       &     )       I     , myThid )
1083    
1084  c     mixing coefficients within boundary layer depend on surface  c     mixing coefficients within boundary layer depend on surface
1085  c     forcing and the magnitude and gradient of interior mixing below  c     forcing and the magnitude and gradient of interior mixing below
# Line 1012  c     stable(imt)                 = 1 in Line 1102  c     stable(imt)                 = 1 in
1102  c     casea (imt)                 = 1 in case A  c     casea (imt)                 = 1 in case A
1103  c     diffus(imt,0:Nrp1,mdiff)    vertical diffusivities              (m^2/s)  c     diffus(imt,0:Nrp1,mdiff)    vertical diffusivities              (m^2/s)
1104  c     kbl   (imt)                 -1 of first grid level below hbl  c     kbl   (imt)                 -1 of first grid level below hbl
1105    c     myThid               thread number for this instance of the routine
1106          integer myThid
1107        _RL ustar (imt)        _RL ustar (imt)
1108        _RL bfsfc (imt)        _RL bfsfc (imt)
1109        _RL hbl   (imt)        _RL hbl   (imt)
# Line 1061  c--------------------------------------- Line 1153  c---------------------------------------
1153  CADJ STORE sigma = comlev1_kpp, key = ikppkey  CADJ STORE sigma = comlev1_kpp, key = ikppkey
1154        call wscale (        call wscale (
1155       I        sigma, hbl, ustar, bfsfc,       I        sigma, hbl, ustar, bfsfc,
1156       O        wm, ws )       O        wm, ws, myThid )
1157  CADJ STORE wm = comlev1_kpp, key = ikppkey  CADJ STORE wm = comlev1_kpp, key = ikppkey
1158  CADJ STORE ws = comlev1_kpp, key = ikppkey  CADJ STORE ws = comlev1_kpp, key = ikppkey
1159    
# Line 1154  CADJ STORE ws = comlev1_kpp_k, key = kkp Line 1246  CADJ STORE ws = comlev1_kpp_k, key = kkp
1246  CADJ STORE sigma = comlev1_kpp_k, key = kkppkey  CADJ STORE sigma = comlev1_kpp_k, key = kkppkey
1247           call wscale (           call wscale (
1248       I        sigma, hbl, ustar, bfsfc,       I        sigma, hbl, ustar, bfsfc,
1249       O        wm, ws )       O        wm, ws, myThid )
1250  CADJ STORE wm = comlev1_kpp_k, key = kkppkey  CADJ STORE wm = comlev1_kpp_k, key = kkppkey
1251  CADJ STORE ws = comlev1_kpp_k, key = kkppkey  CADJ STORE ws = comlev1_kpp_k, key = kkppkey
1252    
# Line 1207  CADJ STORE ws = comlev1_kpp, key = ikppk Line 1299  CADJ STORE ws = comlev1_kpp, key = ikppk
1299  CADJ STORE sigma = comlev1_kpp, key = ikppkey  CADJ STORE sigma = comlev1_kpp, key = ikppkey
1300        call wscale (        call wscale (
1301       I        sigma, hbl, ustar, bfsfc,       I        sigma, hbl, ustar, bfsfc,
1302       O        wm, ws )       O        wm, ws, myThid )
1303  CADJ STORE wm = comlev1_kpp, key = ikppkey  CADJ STORE wm = comlev1_kpp, key = ikppkey
1304  CADJ STORE ws = comlev1_kpp, key = ikppkey  CADJ STORE ws = comlev1_kpp, key = ikppkey
1305    
# Line 1235  c*************************************** Line 1327  c***************************************
1327       I       dkm1, hbl, kbl, diffus, casea       I       dkm1, hbl, kbl, diffus, casea
1328       U     , ghat       U     , ghat
1329       O     , blmc       O     , blmc
1330       &     )       &     , myThid )
1331    
1332  c enhance the diffusivity at the kbl-.5 interface  c enhance the diffusivity at the kbl-.5 interface
1333    
# Line 1250  c     hbl(imt)                  boundary Line 1342  c     hbl(imt)                  boundary
1342  c     kbl(imt)                  grid above hbl  c     kbl(imt)                  grid above hbl
1343  c     diffus(imt,0:Nrp1,mdiff) vertical diffusivities           (m^2/s)  c     diffus(imt,0:Nrp1,mdiff) vertical diffusivities           (m^2/s)
1344  c     casea(imt)                = 1 in caseA, = 0 in case B  c     casea(imt)                = 1 in caseA, = 0 in case B
1345    c     myThid                    thread number for this instance of the routine
1346          integer   myThid
1347        _RL dkm1  (imt,mdiff)        _RL dkm1  (imt,mdiff)
1348        _RL hbl   (imt)        _RL hbl   (imt)
1349        integer kbl   (imt)        integer kbl   (imt)
# Line 1296  c     fraction hbl lies beteen zgrid nei Line 1390  c     fraction hbl lies beteen zgrid nei
1390  c*************************************************************************  c*************************************************************************
1391    
1392        SUBROUTINE STATEKPP (        SUBROUTINE STATEKPP (
1393       I     ikppkey, bi, bj, myThid,       O     RHO1, DBLOC, DBSFC, TTALPHA, SSBETA,
1394       O     RHO1, DBLOC, DBSFC, TTALPHA, SSBETA)       I     ikppkey, bi, bj, myThid )
1395  c  c
1396  c-----------------------------------------------------------------------  c-----------------------------------------------------------------------
1397  c     "statekpp" computes all necessary input arrays  c     "statekpp" computes all necessary input arrays
# Line 1389  CADJ STORE salt (:,:,1,bi,bj) = comlev1_ Line 1483  CADJ STORE salt (:,:,1,bi,bj) = comlev1_
1483    
1484        call FIND_ALPHA(        call FIND_ALPHA(
1485       I     bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, 1, 1,       I     bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, 1, 1,
1486       O     WORK2 )       O     WORK2, myThid )
1487    
1488        call FIND_BETA(        call FIND_BETA(
1489       I     bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, 1, 1,       I     bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, 1, 1,
1490       O     WORK3 )       O     WORK3, myThid )
1491    
1492        DO J = 1-OLy, sNy+OLy        DO J = 1-OLy, sNy+OLy
1493           DO I = 1-OLx, sNx+OLx           DO I = 1-OLx, sNx+OLx
# Line 1410  c     work3 - density of t(1)-.8 & s(1 Line 1504  c     work3 - density of t(1)-.8 & s(1
1504           DO J = 1, sNy           DO J = 1, sNy
1505              DO I = 1, sNx              DO I = 1, sNx
1506                 KPPMLD(I,J) = ABS(R_low(I,J,bi,bj))                 KPPMLD(I,J) = ABS(R_low(I,J,bi,bj))
1507                 WORK3 (I,J) = WORK1(I,J) - 0.8 * WORK2(I,J)                 WORK3 (I,J) = WORK1(I,J) - 0.8 _d 0 * WORK2(I,J)
1508              END DO              END DO
1509           END DO           END DO
1510        ENDIF        ENDIF
# Line 1461  CADJ STORE rho1k (:,:)          = comlev Line 1555  CADJ STORE rho1k (:,:)          = comlev
1555    
1556           call FIND_ALPHA(           call FIND_ALPHA(
1557       I        bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, K, K,       I        bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, K, K,
1558       O        WORK1 )       O        WORK1, myThid )
1559    
1560           call FIND_BETA(           call FIND_BETA(
1561       I        bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, K, K,       I        bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy, K, K,
1562       O        WORK2 )       O        WORK2, myThid )
1563    
1564           DO J = 1-OLy, sNy+OLy           DO J = 1-OLy, sNy+OLy
1565              DO I = 1-OLx, sNx+OLx              DO I = 1-OLx, sNx+OLx
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22