New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
isfcavgam.F90 in NEMO/branches/UKMO/NEMO_4.0.2_GO8_package_ENHANCE-02_ISF_nemo/src/ISF – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.2_GO8_package_ENHANCE-02_ISF_nemo/src/ISF/isfcavgam.F90 @ 12721

Last change on this file since 12721 was 12721, checked in by mathiot, 4 years ago

NEMO_4.0.2_GO8_package_ENHANCE-02_ISF_nemo: add last year isf dev
File size: 12.5 KB
Line 
1MODULE isfcavgam
2   !!======================================================================
3   !!                       ***  MODULE  isfgammats  ***
4   !! Ice shelf gamma module :  compute exchange coeficient at the ice/ocean interface
5   !!======================================================================
6   !! History :  4.1  !  (P. Mathiot) original
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   isfcav_gammats       : compute exchange coeficient gamma
11   !!----------------------------------------------------------------------
12   USE isf_oce
13   USE isfutils, ONLY: debug
14   USE isftbl  , ONLY: isf_tbl
15
16   USE oce     , ONLY: un, vn, rn2         ! ocean dynamics and tracers
17   USE phycst  , ONLY: grav, vkarmn        ! physical constant
18   USE eosbn2  , ONLY: eos_rab             ! equation of state
19   USE zdfdrg  , ONLY: rCd0_top, r_ke0_top ! vertical physics: top/bottom drag coef.
20   USE iom     , ONLY: iom_put             !
21   USE lib_mpp , ONLY: ctl_stop
22
23   USE dom_oce        ! ocean space and time domain
24   USE in_out_manager ! I/O manager
25   !
26   IMPLICIT NONE
27   !
28   PRIVATE
29   !
30   PUBLIC   isfcav_gammats
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
34   !! $Id$
35   !! Software governed by the CeCILL license (see ./LICENSE)
36   !!----------------------------------------------------------------------
37CONTAINS
38   !
39   !!-----------------------------------------------------------------------------------------------------
40   !!                              PUBLIC SUBROUTINES
41   !!-----------------------------------------------------------------------------------------------------
42   !
43   SUBROUTINE isfcav_gammats( pttbl, pstbl, pqoce, pqfwf, pgt, pgs )
44      !!----------------------------------------------------------------------
45      !! ** Purpose    : compute the coefficient echange for heat and fwf flux
46      !!
47      !! ** Method     : select the gamma formulation
48      !!                 3 method available (cst, vel and vel_stab)
49      !!---------------------------------------------------------------------
50      !!-------------------------- OUT -------------------------------------
51      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pgt  , pgs      ! gamma t and gamma s
52      !!-------------------------- IN  -------------------------------------
53      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pqoce, pqfwf    ! isf heat and fwf
54      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl    ! top boundary layer tracer
55      !!---------------------------------------------------------------------
56      REAL(wp), DIMENSION(jpi,jpj)                :: zutbl, zvtbl    ! top boundary layer velocity
57      !!---------------------------------------------------------------------
58      !
59      !==========================================
60      ! 1.: compute velocity in the tbl if needed
61      !==========================================
62      !
63      SELECT CASE ( cn_gammablk )
64      CASE ( 'spe'  ) 
65         ! gamma is constant (specified in namelist)
66         ! nothing to do
67      CASE ('vel', 'vel_stab')
68         ! compute velocity in tbl
69         CALL isf_tbl(un(:,:,:) ,zutbl(:,:),'U', miku, rhisf_tbl_cav)
70         CALL isf_tbl(vn(:,:,:) ,zvtbl(:,:),'V', mikv, rhisf_tbl_cav)
71         !
72         ! mask velocity in tbl with ice shelf mask
73         zutbl(:,:) = zutbl(:,:) * mskisf_cav(:,:)
74         zvtbl(:,:) = zvtbl(:,:) * mskisf_cav(:,:)
75         !
76         ! output
77         CALL iom_put('utbl',zutbl(:,:))
78         CALL iom_put('vtbl',zvtbl(:,:))
79      CASE DEFAULT
80         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
81      END SELECT
82      !
83      !==========================================
84      ! 2.: compute gamma
85      !==========================================
86      !
87      SELECT CASE ( cn_gammablk )
88      CASE ( 'spe'  ) ! gamma is constant (specified in namelist)
89         pgt(:,:) = rn_gammat0
90         pgs(:,:) = rn_gammas0
91      CASE ( 'vel' ) ! gamma is proportional to u*
92         CALL gammats_vel      (              zutbl, zvtbl, rCd0_top, r_ke0_top,               pgt, pgs )
93      CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u*
94         CALL gammats_vel_stab (pttbl, pstbl, zutbl, zvtbl, rCd0_top, r_ke0_top, pqoce, pqfwf, pgt, pgs )
95      CASE DEFAULT
96         CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)')
97      END SELECT
98      !
99      !==========================================
100      ! 3.: output and debug
101      !==========================================
102      !
103      CALL iom_put('isfgammat', pgt(:,:))
104      CALL iom_put('isfgammas', pgs(:,:))
105      !
106      IF (ln_isfdebug) THEN
107         CALL debug( 'isfcav_gam pgt:', pgt(:,:) )
108         CALL debug( 'isfcav_gam pgs:', pgs(:,:) )
109      END IF
110      !
111   END SUBROUTINE isfcav_gammats
112   !
113   !!-----------------------------------------------------------------------------------------------------
114   !!                              PRIVATE SUBROUTINES
115   !!-----------------------------------------------------------------------------------------------------
116   !
117   SUBROUTINE gammats_vel( putbl, pvtbl, pCd, pke2, &   ! <<== in
118      &                                  pgt, pgs   )   ! ==>> out gammats [m/s]
119      !!----------------------------------------------------------------------
120      !! ** Purpose    : compute the coefficient echange coefficient
121      !!
122      !! ** Method     : gamma is velocity dependent ( gt= gt0 * Ustar )
123      !!
124      !! ** Reference  : Asay-Davis et al., Geosci. Model Dev., 9, 2471-2497, 2016
125      !!---------------------------------------------------------------------
126      !!-------------------------- OUT -------------------------------------
127      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pgt, pgs     ! gammat and gammas [m/s]
128      !!-------------------------- IN  -------------------------------------
129      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: putbl, pvtbl ! velocity in the losch top boundary layer
130      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pCd          ! drag coefficient
131      REAL(wp),                     INTENT(in   ) :: pke2         ! background velocity
132      !!---------------------------------------------------------------------
133      REAL(wp), DIMENSION(jpi,jpj) :: zustar
134      !!---------------------------------------------------------------------
135      !
136      ! compute ustar (AD15 eq. 27)
137      zustar(:,:) = SQRT( pCd(:,:) * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) ) * mskisf_cav(:,:)
138      !
139      ! Compute gammats
140      pgt(:,:) = zustar(:,:) * rn_gammat0
141      pgs(:,:) = zustar(:,:) * rn_gammas0
142      !
143      ! output ustar
144      CALL iom_put('isfustar',zustar(:,:))
145      !
146   END SUBROUTINE gammats_vel
147
148   SUBROUTINE gammats_vel_stab( pttbl, pstbl, putbl, pvtbl, pCd, pke2, pqoce, pqfwf, &  ! <<== in
149      &                                                                pgt  , pgs    )  ! ==>> out gammats [m/s]
150      !!----------------------------------------------------------------------
151      !! ** Purpose    : compute the coefficient echange coefficient
152      !!
153      !! ** Method     : gamma is velocity dependent and stability dependent
154      !!
155      !! ** Reference  : Holland and Jenkins, 1999, JPO, p1787-1800
156      !!---------------------------------------------------------------------
157      !!-------------------------- OUT -------------------------------------
158      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pgt, pgs     ! gammat and gammas
159      !!-------------------------- IN  -------------------------------------
160      REAL(wp),                     INTENT(in   ) :: pke2           ! background velocity squared
161      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pqoce, pqfwf   ! surface heat flux and fwf flux
162      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pCd            ! drag coeficient
163      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: putbl, pvtbl   ! velocity in the losch top boundary layer
164      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pttbl, pstbl   ! tracer   in the losch top boundary layer
165      !!---------------------------------------------------------------------
166      INTEGER  :: ji, jj                     ! loop index
167      INTEGER  :: ikt                        ! local integer
168      REAL(wp) :: zdku, zdkv                 ! U, V shear
169      REAL(wp) :: zPr, zSc, zRc              ! Prandtl, Scmidth and Richardson number
170      REAL(wp) :: zmob, zmols                ! Monin Obukov length, coriolis factor at T point
171      REAL(wp) :: zbuofdep, zhnu             ! Bouyancy length scale, sublayer tickness
172      REAL(wp) :: zhmax                      ! limitation of mol
173      REAL(wp) :: zetastar                   ! stability parameter
174      REAL(wp) :: zgmolet, zgmoles, zgturb   ! contribution of modelecular sublayer and turbulence
175      REAL(wp) :: zcoef                      ! temporary coef
176      REAL(wp) :: zdep
177      REAL(wp) :: zeps = 1.0e-20_wp   
178      REAL(wp), PARAMETER :: zxsiN = 0.052_wp   ! dimensionless constant
179      REAL(wp), PARAMETER :: znu   = 1.95e-6_wp ! kinamatic viscosity of sea water (m2.s-1)
180      REAL(wp), DIMENSION(2) :: zts, zab
181      REAL(wp), DIMENSION(jpi,jpj) :: zustar    ! friction velocity
182      !!---------------------------------------------------------------------
183      !
184      ! compute ustar
185      zustar(:,:) = SQRT( pCd * ( putbl(:,:) * putbl(:,:) + pvtbl(:,:) * pvtbl(:,:) + pke2 ) )
186      !
187      ! output ustar
188      CALL iom_put('isfustar',zustar(:,:))
189      !
190      ! compute Pr and Sc number (eq ??)
191      zPr =   13.8_wp
192      zSc = 2432.0_wp
193      !
194      ! compute gamma mole (eq ??)
195      zgmolet = 12.5_wp * zPr ** (2.0/3.0) - 6.0_wp
196      zgmoles = 12.5_wp * zSc ** (2.0/3.0) - 6.0_wp
197      !
198      ! compute gamma
199      DO ji = 2, jpi
200         DO jj = 2, jpj
201            ikt = mikt(ji,jj)
202
203            IF( zustar(ji,jj) == 0._wp ) THEN           ! only for kt = 1 I think
204               pgt = rn_gammat0
205               pgs = rn_gammas0
206            ELSE
207               ! compute Rc number (as done in zdfric.F90)
208!!gm better to do it like in the new zdfric.F90   i.e. avm weighted Ri computation
209               zcoef = 0.5_wp / e3w_n(ji,jj,ikt+1)
210               !                                            ! shear of horizontal velocity
211               zdku = zcoef * (  un(ji-1,jj  ,ikt  ) + un(ji,jj,ikt  )  &
212                  &             -un(ji-1,jj  ,ikt+1) - un(ji,jj,ikt+1)  )
213               zdkv = zcoef * (  vn(ji  ,jj-1,ikt  ) + vn(ji,jj,ikt  )  &
214                  &             -vn(ji  ,jj-1,ikt+1) - vn(ji,jj,ikt+1)  )
215               !                                            ! richardson number (minimum value set to zero)
216               zRc = MAX(rn2(ji,jj,ikt+1), 0._wp) / MAX( zdku*zdku + zdkv*zdkv, zeps )
217
218               ! compute bouyancy
219               zts(jp_tem) = pttbl(ji,jj)
220               zts(jp_sal) = pstbl(ji,jj)
221               zdep        = gdepw_n(ji,jj,ikt)
222               !
223               CALL eos_rab( zts, zdep, zab )
224               !
225               ! compute length scale (Eq ??)
226               zbuofdep = grav * ( zab(jp_tem) * pqoce(ji,jj) - zab(jp_sal) * pqfwf(ji,jj) )
227               !
228               ! compute Monin Obukov Length
229               ! Maximum boundary layer depth (Eq ??)
230               zhmax = gdept_n(ji,jj,mbkt(ji,jj)) - gdepw_n(ji,jj,mikt(ji,jj)) -0.001_wp
231               !
232               ! Compute Monin obukhov length scale at the surface and Ekman depth: (Eq ??)
233               zmob   = zustar(ji,jj) ** 3 / (vkarmn * (zbuofdep + zeps))
234               zmols  = SIGN(1._wp, zmob) * MIN(ABS(zmob), zhmax) * tmask(ji,jj,ikt)
235               !
236               ! compute eta* (stability parameter) (Eq ??)
237               zetastar = 1._wp / ( SQRT(1._wp + MAX(zxsiN * zustar(ji,jj) / ( ABS(ff_f(ji,jj)) * zmols * zRc ), 0._wp)))
238               !
239               ! compute the sublayer thickness (Eq ??)
240               zhnu = 5 * znu / zustar(ji,jj)
241               !
242               ! compute gamma turb (Eq ??)
243               zgturb = 1._wp / vkarmn * LOG(zustar(ji,jj) * zxsiN * zetastar * zetastar / ( ABS(ff_f(ji,jj)) * zhnu )) &
244               &      + 1._wp / ( 2 * zxsiN * zetastar ) - 1._wp / vkarmn
245               !
246               ! compute gammats
247               pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet)
248               pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles)
249            END IF
250         END DO
251      END DO
252
253   END SUBROUTINE gammats_vel_stab
254
255END MODULE isfcavgam
Note: See TracBrowser for help on using the repository browser.