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/trunk/tests/ISOMIP+/MY_SRC – NEMO

source: NEMO/trunk/tests/ISOMIP+/MY_SRC/isfcavgam.F90

Last change on this file was 15109, checked in by clem, 3 years ago

restore isomip+

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