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 NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE – NEMO

source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/ICE/icethd_da.F90 @ 12749

Last change on this file since 12749 was 12489, checked in by davestorkey, 4 years ago

Preparation for new timestepping scheme #2390.
Main changes:

  1. Initial euler timestep now handled in stp and not in TRA/DYN routines.
  2. Renaming of all timestep parameters. In summary, the namelist parameter is now rn_Dt and the current timestep is rDt (and rDt_ice, rDt_trc etc).
  3. Renaming of a few miscellaneous parameters, eg. atfp -> rn_atfp (namelist parameter used everywhere) and rau0 -> rho0.

This version gives bit-comparable results to the previous version of the trunk.

  • Property svn:keywords set to Id
File size: 11.4 KB
Line 
1MODULE icethd_da
2   !!======================================================================
3   !!                       ***  MODULE icethd_da ***
4   !!   sea-ice : lateral melting
5   !!======================================================================
6   !! History :  3.7  !  2016-03  (C. Rousset)       Original code
7   !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
8   !!---------------------------------------------------------------------
9#if defined key_si3
10   !!----------------------------------------------------------------------
11   !!   'key_si3'                                       SI3 sea-ice model
12   !!----------------------------------------------------------------------
13   !!   ice_thd_da      : sea ice lateral melting
14   !!   ice_thd_da_init : sea ice lateral melting initialization
15   !!----------------------------------------------------------------------
16   USE par_oce        ! ocean parameters
17   USE phycst         ! physical constants (ocean directory)
18   USE ice            ! sea-ice: variables
19   USE ice1D          ! sea-ice: thermodynamic 1D variables
20   !
21   USE in_out_manager ! I/O manager
22   USE lib_mpp        ! MPP library
23   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   ice_thd_da        ! called by icethd.F90
29   PUBLIC   ice_thd_da_init   ! called by icestp.F90
30
31   !                      !!** namelist (namthd_da) **
32   REAL(wp) ::   rn_beta   ! coef. beta for lateral melting param.
33   REAL(wp) ::   rn_dmin   ! minimum floe diameter for lateral melting param.
34
35   !!----------------------------------------------------------------------
36   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
37   !! $Id$
38   !! Software governed by the CeCILL license (see ./LICENSE)
39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE ice_thd_da
43      !!-------------------------------------------------------------------
44      !!                ***  ROUTINE ice_thd_da  ***   
45      !!   
46      !! ** Purpose :   computes sea ice lateral melting
47      !!
48      !! ** Method  :   dA/dt = - P * W   [s-1]
49      !!                   W = melting velocity [m.s-1]
50      !!                   P = perimeter of ice-ocean lateral interface normalized by grid cell area [m.m-2]
51      !!
52      !!                   W = m1 * (Tw -Tf)**m2                    --- originally from Josberger 1979 ---
53      !!                      (Tw - Tf) = elevation of water temp above freezing
54      !!                      m1 and m2 = (1.6e-6 , 1.36) best fit from field experiment near the coast of Prince Patrick Island
55      !!                                                                                           (Perovich 1983) => static ice
56      !!                      m1 and m2 = (3.0e-6 , 1.36) best fit from MIZEX 84 experiment
57      !!                                                                                (Maykut and Perovich 1987) => moving ice
58      !!
59      !!                   P = N * pi * D                           --- from Rothrock and Thorndike 1984 ---
60      !!                      D = mean floe caliper diameter
61      !!                      N = number of floes = ice area / floe area(average) = A / (Cs * D**2)
62      !!                         A = ice concentration
63      !!                         Cs = deviation from a square (square:Cs=1 ; circle:Cs=pi/4 ; floe:Cs=0.66)
64      !!
65      !!                   D = Dmin * ( Astar / (Astar-A) )**beta   --- from Lupkes et al., 2012 (eq. 26-27) ---
66      !!                                                             
67      !!                      Astar = 1 / ( 1 - (Dmin/Dmax)**(1/beta) )
68      !!                      Dmin = minimum floe diameter (recommended to be 8m +- 20%)
69      !!                      Dmax = maximum floe diameter (recommended to be 300m,
70      !!                                                    but it does not impact melting much except for Dmax<100m)
71      !!                      beta = 1.0 +-20% (recommended value)
72      !!                           = 0.3 best fit for western Fram Strait and Antarctica
73      !!                           = 1.4 best fit for eastern Fram Strait
74      !!
75      !! ** Tunable parameters  :   We propose to tune the lateral melting via 2 parameters
76      !!                               Dmin [6-10m]   => 6  vs 8m = +40% melting at the peak (A~0.5)
77      !!                                                 10 vs 8m = -20% melting
78      !!                               beta [0.8-1.2] => decrease = more melt and melt peaks toward higher concentration
79      !!                                                                  (A~0.5 for beta=1 ; A~0.8 for beta=0.2)
80      !!                                                 0.3 = best fit for western Fram Strait and Antarctica
81      !!                                                 1.4 = best fit for eastern Fram Strait
82      !!
83      !! ** Note   :   Former and more simple formulations for floe diameters can be found in Mai (1995),
84      !!               Birnbaum and Lupkes (2002), Lupkes and Birnbaum (2005). They are reviewed in Lupkes et al 2012
85      !!               A simpler implementation for CICE can be found in Bitz et al (2001) and Tsamados et al (2015)
86      !!
87      !! ** References
88      !!    Bitz, C. M., Holland, M. M., Weaver, A. J., & Eby, M. (2001).
89      !!              Simulating the ice‐thickness distribution in a coupled climate model.
90      !!              Journal of Geophysical Research: Oceans, 106(C2), 2441-2463.
91      !!    Josberger, E. G. (1979).
92      !!              Laminar and turbulent boundary layers adjacent to melting vertical ice walls in salt water
93      !!              (No. SCIENTIFIC-16). WASHINGTON UNIV SEATTLE DEPT OF ATMOSPHERIC SCIENCES.
94      !!    Lüpkes, C., Gryanik, V. M., Hartmann, J., & Andreas, E. L. (2012).
95      !!              A parametrization, based on sea ice morphology, of the neutral atmospheric drag coefficients
96      !!              for weather prediction and climate models.
97      !!              Journal of Geophysical Research: Atmospheres, 117(D13).
98      !!    Maykut, G. A., & Perovich, D. K. (1987).
99      !!              The role of shortwave radiation in the summer decay of a sea ice cover.
100      !!              Journal of Geophysical Research: Oceans, 92(C7), 7032-7044.
101      !!    Perovich, D. K. (1983).
102      !!              On the summer decay of a sea ice cover. (Doctoral dissertation, University of Washington).
103      !!    Rothrock, D. A., & Thorndike, A. S. (1984).
104      !!              Measuring the sea ice floe size distribution.
105      !!              Journal of Geophysical Research: Oceans, 89(C4), 6477-6486.
106      !!    Tsamados, M., Feltham, D., Petty, A., Schroeder, D., & Flocco, D. (2015).
107      !!              Processes controlling surface, bottom and lateral melt of Arctic sea ice in a state of the art sea ice model.
108      !!              Phil. Trans. R. Soc. A, 373(2052), 20140167.
109      !!---------------------------------------------------------------------
110      INTEGER  ::   ji     ! dummy loop indices
111      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda
112      REAL(wp), PARAMETER ::   zdmax = 300._wp
113      REAL(wp), PARAMETER ::   zcs   = 0.66_wp
114      REAL(wp), PARAMETER ::   zm1   = 3.e-6_wp
115      REAL(wp), PARAMETER ::   zm2   = 1.36_wp
116      !
117      REAL(wp), DIMENSION(jpij) ::   zda_tot
118      !!---------------------------------------------------------------------
119      !
120      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )
121      !
122      DO ji = 1, npti   
123         ! --- Calculate reduction of total sea ice concentration --- !
124         zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta         ! Mean floe caliper diameter [m]
125         !
126         zperi  = at_i_1d(ji) * rpi / ( zcs * zdfloe )                             ! Mean perimeter of the floe [m.m-2]
127         !                                                                         !    = N*pi*D = (A/cs*D^2)*pi*D
128         zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s]
129         !
130         zda_tot(ji) = MIN( zwlat * zperi * rDt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0)
131     
132         ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !
133         IF( a_i_1d(ji) > 0._wp ) THEN
134            ! decrease of concentration for the category jl
135            !    each category contributes to melting in proportion to its concentration
136            zda = MIN( a_i_1d(ji), zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) )
137           
138            ! Contribution to salt flux
139            sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoi *  h_i_1d(ji) * zda * s_i_1d(ji) * r1_Dt_ice
140           
141            ! Contribution to heat flux into the ocean [W.m-2], (<0) 
142            hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_Dt_ice * ( h_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) )  &
143                                                                + h_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) ) 
144           
145            ! Contribution to mass flux
146            wfx_lam_1d(ji) =  wfx_lam_1d(ji) + zda * r1_Dt_ice * ( rhoi * h_i_1d(ji) + rhos * h_s_1d(ji) )
147           
148            ! new concentration
149            a_i_1d(ji) = a_i_1d(ji) - zda
150
151            ! ensure that h_i = 0 where a_i = 0
152            IF( a_i_1d(ji) == 0._wp ) THEN
153               h_i_1d(ji) = 0._wp
154               h_s_1d(ji) = 0._wp
155            ENDIF
156         ENDIF
157      END DO
158      !
159   END SUBROUTINE ice_thd_da
160
161
162   SUBROUTINE ice_thd_da_init
163      !!-----------------------------------------------------------------------
164      !!                   ***  ROUTINE ice_thd_da_init ***
165      !!                 
166      !! ** Purpose :   Physical constants and parameters associated with
167      !!                ice thermodynamics
168      !!
169      !! ** Method  :   Read the namthd_da namelist and check the parameters
170      !!                called at the first timestep (nit000)
171      !!
172      !! ** input   :   Namelist namthd_da
173      !!-------------------------------------------------------------------
174      INTEGER  ::   ios   ! Local integer
175      !!
176      NAMELIST/namthd_da/ rn_beta, rn_dmin
177      !!-------------------------------------------------------------------
178      !
179      READ  ( numnam_ice_ref, namthd_da, IOSTAT = ios, ERR = 901)
180901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_da in reference namelist' )
181      READ  ( numnam_ice_cfg, namthd_da, IOSTAT = ios, ERR = 902 )
182902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_da in configuration namelist' )
183      IF(lwm) WRITE( numoni, namthd_da )
184      !
185      IF(lwp) THEN                          ! control print
186         WRITE(numout,*)
187         WRITE(numout,*) 'ice_thd_da_init: Ice lateral melting'
188         WRITE(numout,*) '~~~~~~~~~~~~~~~'
189         WRITE(numout,*) '   Namelist namthd_da:'
190         WRITE(numout,*) '      Coef. beta for lateral melting param.               rn_beta = ', rn_beta
191         WRITE(numout,*) '      Minimum floe diameter for lateral melting param.    rn_dmin = ', rn_dmin
192      ENDIF
193      !
194   END SUBROUTINE ice_thd_da_init
195 
196#else
197   !!----------------------------------------------------------------------
198   !!   Default option         Dummy Module           NO SI3 sea-ice model
199   !!----------------------------------------------------------------------
200#endif
201
202   !!======================================================================
203END MODULE icethd_da
Note: See TracBrowser for help on using the repository browser.