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/trunk/NEMOGCM/NEMO/ICE_SRC – NEMO

source: NEMO/trunk/NEMOGCM/NEMO/ICE_SRC/icethd_da.F90 @ 9594

Last change on this file since 9594 was 9570, checked in by nicolasmartin, 6 years ago

Global renaming for core routines (./NEMO)

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