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.
icethd_da.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icethd_da.F90 @ 8488

Last change on this file since 8488 was 8486, checked in by clem, 7 years ago

changes in style - part1 - (now the code looks better txs to Gurvan's comments)

File size: 9.3 KB
Line 
1MODULE icethd_da
2   !!======================================================================
3   !!                       ***  MODULE icethd_da ***
4   !! LIM-3 sea-ice :  computation of lateral melting in the ice
5   !!======================================================================
6   !! History :  4.0  ! 2016-03 (C. Rousset)  original code
7   !!---------------------------------------------------------------------
8#if defined key_lim3
9   !!----------------------------------------------------------------------
10   !!   'key_lim3'                                      LIM-3 sea-ice model
11   !!----------------------------------------------------------------------
12   !!   ice_thd_da    : sea ice lateral melting
13   !!----------------------------------------------------------------------
14   USE par_oce        ! ocean parameters
15   USE phycst         ! physical constants (ocean directory)
16   USE ice            ! sea-ice: variables
17   USE ice1D          ! sea-ice: thermodynamic 1D variables
18   !
19   USE lib_mpp        ! MPP library
20   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   ice_thd_da   ! called by icethd.F90
26
27   !!----------------------------------------------------------------------
28   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
29   !! $Id: icethd_da.F90 5123 2015-03-04 16:06:03Z clem $
30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34!!gm  even comment line of more than 130 character may cause compilation errors
35!!gm         ===>>> reformat the text
36   SUBROUTINE ice_thd_da
37      !!-------------------------------------------------------------------
38      !!                ***  ROUTINE ice_thd_da  ***   
39      !!   
40      !! ** Purpose :   computes sea ice lateral melting
41      !!
42      !! ** Method  :   dA/dt = - P * W   [s-1]
43      !!                   W = melting velocity [m.s-1]
44      !!                   P = perimeter of ice-ocean lateral interface normalized by grid cell area [m.m-2]
45      !!
46      !!                   W = m1 * (Tw -Tf)**m2                    --- originally from Josberger 1979 ---
47      !!                      (Tw - Tf) = elevation of water temp above freezing
48      !!                      m1 and m2 = (1.6e-6 , 1.36) best fit from field experiment near the coast of Prince Patrick Island (Perovich 1983) => static ice
49      !!                      m1 and m2 = (3.0e-6 , 1.36) best fit from MIZEX 84 experiment (Maykut and Perovich 1987) => moving ice
50      !!
51      !!                   P = N * pi * D                           --- from Rothrock and Thorndike 1984 ---
52      !!                      D = mean floe caliper diameter
53      !!                      N = number of floes = ice area / floe area(average) = A / (Cs * D**2)
54      !!                         A = ice concentration
55      !!                         Cs = deviation from a square (square:Cs=1 ; circle:Cs=pi/4 ; floe:Cs=0.66)
56      !!
57      !!                   D = Dmin * ( Astar / (Astar-A) )**beta   --- from Lupkes et al., 2012 (eq. 26-27) ---
58      !!                                                             
59      !!                      Astar = 1 / ( 1 - (Dmin/Dmax)**(1/beta) )
60      !!                      Dmin = minimum floe diameter (recommended to be 8m +- 20%)
61      !!                      Dmax = maximum floe diameter (recommended to be 300m, but it does not impact melting much except for Dmax<100m)
62      !!                      beta = 1.0 +-20% (recommended value)
63      !!                           = 0.3 best fit for western Fram Strait and Antarctica
64      !!                           = 1.4 best fit for eastern Fram Strait
65      !!
66      !! ** Tunable parameters  :   We propose to tune the lateral melting via 2 parameters
67      !!                               Dmin [6-10m]   => 6  vs 8m = +40% melting at the peak (A~0.5)
68      !!                                                 10 vs 8m = -20% melting
69      !!                               beta [0.8-1.2] => decrease = more melt and melt peaks toward higher concentration
70      !!                                                                  (A~0.5 for beta=1 ; A~0.8 for beta=0.2)
71      !!                                                 0.3 = best fit for western Fram Strait and Antarctica
72      !!                                                 1.4 = best fit for eastern Fram Strait
73      !!
74      !! ** Note   :   Former and more simple formulations for floe diameters can be found in Mai (1995),
75      !!               Birnbaum and Lupkes (2002), Lupkes and Birnbaum (2005). They are reviewed in Lupkes et al 2012
76      !!               A simpler implementation for CICE can be found in Bitz et al (2001) and Tsamados et al (2015)
77      !!
78      !! ** References
79      !!    Bitz, C. M., Holland, M. M., Weaver, A. J., & Eby, M. (2001).
80      !!              Simulating the ice‐thickness distribution in a coupled climate model.
81      !!              Journal of Geophysical Research: Oceans, 106(C2), 2441-2463.
82      !!    Josberger, E. G. (1979).
83      !!              Laminar and turbulent boundary layers adjacent to melting vertical ice walls in salt water
84      !!              (No. SCIENTIFIC-16). WASHINGTON UNIV SEATTLE DEPT OF ATMOSPHERIC SCIENCES.
85      !!    Lüpkes, C., Gryanik, V. M., Hartmann, J., & Andreas, E. L. (2012).
86      !!              A parametrization, based on sea ice morphology, of the neutral atmospheric drag coefficients
87      !!              for weather prediction and climate models.
88      !!              Journal of Geophysical Research: Atmospheres, 117(D13).
89      !!    Maykut, G. A., & Perovich, D. K. (1987).
90      !!              The role of shortwave radiation in the summer decay of a sea ice cover.
91      !!              Journal of Geophysical Research: Oceans, 92(C7), 7032-7044.
92      !!    Perovich, D. K. (1983).
93      !!              On the summer decay of a sea ice cover. (Doctoral dissertation, University of Washington).
94      !!    Rothrock, D. A., & Thorndike, A. S. (1984).
95      !!              Measuring the sea ice floe size distribution.
96      !!              Journal of Geophysical Research: Oceans, 89(C4), 6477-6486.
97      !!    Tsamados, M., Feltham, D., Petty, A., Schroeder, D., & Flocco, D. (2015).
98      !!              Processes controlling surface, bottom and lateral melt of Arctic sea ice in a state of the art sea ice model.
99      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167.
100      !!---------------------------------------------------------------------
101      INTEGER  ::   ji     ! dummy loop indices
102      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda
103      REAL(wp), PARAMETER ::   zdmax = 300._wp
104      REAL(wp), PARAMETER ::   zcs   = 0.66_wp
105      REAL(wp), PARAMETER ::   zm1   = 3.e-6_wp
106      REAL(wp), PARAMETER ::   zm2   = 1.36_wp
107      !
108      REAL(wp), DIMENSION(jpij) ::   zda_tot
109      !!---------------------------------------------------------------------
110      !
111      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )
112      DO ji = 1, nidx   
113         ! --- Calculate reduction of total sea ice concentration --- !
114         zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta         ! Mean floe caliper diameter [m]
115         zperi  = at_i_1d(ji) * rpi / ( zcs * zdfloe )                             ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2]
116         zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s]
117         
118         zda_tot(ji) = MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0)
119     
120         ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !
121         IF( a_i_1d(ji) > 0._wp ) THEN
122            ! decrease of concentration for the category jl
123            !    each category contributes to melting in proportion to its concentration
124            zda = MIN( a_i_1d(ji), zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) )
125           
126            ! Contribution to salt flux
127            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoic *  ht_i_1d(ji) * zda * sm_i_1d(ji) * r1_rdtice
128           
129            ! Contribution to heat flux into the ocean [W.m-2], (<0) 
130            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_rdtice * ( ht_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  &
131                                                                + ht_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) ) 
132           
133            ! Contribution to mass flux
134            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) )
135           
136            ! new concentration
137            a_i_1d(ji) = a_i_1d(ji) - zda
138
139            ! ensure that ht_i = 0 where a_i = 0
140            IF( a_i_1d(ji) == 0._wp ) THEN
141               ht_i_1d(ji) = 0._wp
142               ht_s_1d(ji) = 0._wp
143            ENDIF
144         ENDIF
145      END DO
146      !
147   END SUBROUTINE ice_thd_da
148   
149#else
150   !!----------------------------------------------------------------------
151   !!   Default option         Dummy Module          No LIM-3 sea-ice model
152   !!----------------------------------------------------------------------
153#endif
154
155   !!======================================================================
156END MODULE icethd_da
Note: See TracBrowser for help on using the repository browser.