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_pnd.F90 in NEMO/trunk/src/ICE – NEMO

source: NEMO/trunk/src/ICE/icethd_pnd.F90 @ 10345

Last change on this file since 10345 was 10069, checked in by nicolasmartin, 6 years ago

Fix mistakes of previous commit on SVN keywords property

  • Property svn:keywords set to Id
File size: 12.5 KB
RevLine 
[8637]1MODULE icethd_pnd 
2   !!======================================================================
3   !!                     ***  MODULE  icethd_pnd   ***
[9604]4   !!   sea-ice: Melt ponds on top of sea ice
[8637]5   !!======================================================================
[9656]6   !! history :       !  2012     (O. Lecomte)       Adaptation from Flocco and Turner
[9604]7   !!                 !  2017     (M. Vancoppenolle, O. Lecomte, C. Rousset) Implementation
8   !!            4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
[8637]9   !!----------------------------------------------------------------------
[9570]10#if defined key_si3
[8637]11   !!----------------------------------------------------------------------
[9570]12   !!   'key_si3' :                                     SI3 sea-ice model
[8637]13   !!----------------------------------------------------------------------
[9169]14   !!   ice_thd_pnd_init : some initialization and namelist read
15   !!   ice_thd_pnd      : main calling routine
[8637]16   !!----------------------------------------------------------------------
17   USE phycst         ! physical constants
18   USE dom_oce        ! ocean space and time domain
19   USE ice            ! sea-ice: variables
20   USE ice1D          ! sea-ice: thermodynamics variables
21   USE icetab         ! sea-ice: 1D <==> 2D transformation
22   !
23   USE in_out_manager ! I/O manager
24   USE lib_mpp        ! MPP library
25   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
26   USE timing         ! Timing
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   ice_thd_pnd_init    ! routine called by icestp.F90
32   PUBLIC   ice_thd_pnd         ! routine called by icestp.F90
33
[9169]34   INTEGER ::              nice_pnd    ! choice of the type of pond scheme
35   !                                   ! associated indices:
[8637]36   INTEGER, PARAMETER ::   np_pndNO  = 0   ! No pond scheme
37   INTEGER, PARAMETER ::   np_pndCST = 1   ! Constant pond scheme
38   INTEGER, PARAMETER ::   np_pndH12 = 2   ! Evolutive pond scheme (Holland et al. 2012)
39
40   !! * Substitutions
41#  include "vectopt_loop_substitute.h90"
42   !!----------------------------------------------------------------------
[9598]43   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
[10069]44   !! $Id$
[10068]45   !! Software governed by the CeCILL license (see ./LICENSE)
[8637]46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE ice_thd_pnd
50      !!-------------------------------------------------------------------
51      !!               ***  ROUTINE ice_thd_pnd   ***
52      !!               
53      !! ** Purpose :   change melt pond fraction
54      !!               
55      !! ** Method  :   brut force
56      !!-------------------------------------------------------------------
[9169]57      !
[8637]58      SELECT CASE ( nice_pnd )
[9169]59      !
60      CASE (np_pndCST)   ;   CALL pnd_CST    !==  Constant melt ponds  ==!
61         !
62      CASE (np_pndH12)   ;   CALL pnd_H12    !==  Holland et al 2012 melt ponds  ==!
63         !
[8637]64      END SELECT
[9169]65      !
[8637]66   END SUBROUTINE ice_thd_pnd 
67
[9169]68
[8637]69   SUBROUTINE pnd_CST 
70      !!-------------------------------------------------------------------
71      !!                ***  ROUTINE pnd_CST  ***
72      !!
[9169]73      !! ** Purpose :   Compute melt pond evolution
[8637]74      !!
[9169]75      !! ** Method  :   Melt pond fraction and thickness are prescribed
[9604]76      !!                to non-zero values when t_su = 0C
[8637]77      !!
78      !! ** Tunable parameters : pond fraction (rn_apnd), pond depth (rn_hpnd)
79      !!               
[9169]80      !! ** Note   : Coupling with such melt ponds is only radiative
[9604]81      !!             Advection, ridging, rafting... are bypassed
[8637]82      !!
83      !! ** References : Bush, G.W., and Trump, D.J. (2017)
84      !!-------------------------------------------------------------------
85      INTEGER  ::   ji        ! loop indices
86      !!-------------------------------------------------------------------
87      DO ji = 1, npti
[9169]88         !
[8637]89         IF( a_i_1d(ji) > 0._wp .AND. t_su_1d(ji) >= rt0 ) THEN
90            a_ip_frac_1d(ji) = rn_apnd
91            h_ip_1d(ji)      = rn_hpnd   
92            a_ip_1d(ji)      = a_ip_frac_1d(ji) * a_i_1d(ji)
93         ELSE
94            a_ip_frac_1d(ji) = 0._wp
95            h_ip_1d(ji)      = 0._wp   
96            a_ip_1d(ji)      = 0._wp
97         ENDIF
[9169]98         !
[8637]99      END DO
[9169]100      !
[8637]101   END SUBROUTINE pnd_CST
102
[9169]103
[8637]104   SUBROUTINE pnd_H12
105      !!-------------------------------------------------------------------
106      !!                ***  ROUTINE pnd_H12  ***
107      !!
108      !! ** Purpose    : Compute melt pond evolution
109      !!
110      !! ** Method     : Empirical method. A fraction of meltwater is accumulated in ponds
111      !!                 and sent to ocean when surface is freezing
112      !!
113      !!                 pond growth:      Vp = Vp + dVmelt
114      !!                    with dVmelt = R/rhow * ( rhoi*dh_i + rhos*dh_s ) * a_i
115      !!                 pond contraction: Vp = Vp * exp(0.01*MAX(Tp-Tsu,0)/Tp)
116      !!                    with Tp = -2degC
[8906]117      !! 
[8637]118      !! ** Tunable parameters : (no real expertise yet, ideas?)
119      !!
120      !! ** Note       : Stolen from CICE for quick test of the melt pond
121      !!                 radiation and freshwater interfaces
122      !!                 Coupling can be radiative AND freshwater
123      !!                 Advection, ridging, rafting are called
124      !!
125      !! ** References : Holland, M. M. et al (J Clim 2012)
126      !!-------------------------------------------------------------------
[8906]127      REAL(wp), PARAMETER ::   zrmin       = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding
[9169]128      REAL(wp), PARAMETER ::   zrmax       = 0.70_wp  ! maximum     -           -         -         -            -
[8906]129      REAL(wp), PARAMETER ::   zpnd_aspect = 0.8_wp   ! pond aspect ratio
130      REAL(wp), PARAMETER ::   zTp         = -2._wp   ! reference temperature
[9169]131      !
[8906]132      REAL(wp) ::   zfr_mlt          ! fraction of available meltwater retained for melt ponding
[8637]133      REAL(wp) ::   zdv_mlt          ! available meltwater for melt ponding
[8906]134      REAL(wp) ::   z1_Tp            ! inverse reference temperature
[9935]135      REAL(wp) ::   z1_rhow          ! inverse freshwater density
[8906]136      REAL(wp) ::   z1_zpnd_aspect   ! inverse pond aspect ratio
[8637]137      REAL(wp) ::   zfac, zdum
[9169]138      !
[8906]139      INTEGER  ::   ji   ! loop indices
[8637]140      !!-------------------------------------------------------------------
[9935]141      z1_rhow        = 1._wp / rhow 
[9169]142      z1_zpnd_aspect = 1._wp / zpnd_aspect
[8637]143      z1_Tp          = 1._wp / zTp 
144
145      DO ji = 1, npti
146         !                                                        !--------------------------------!
147         IF( h_i_1d(ji) < rn_himin) THEN                          ! Case ice thickness < rn_himin  !
148            !                                                     !--------------------------------!
[8906]149            !--- Remove ponds on thin ice
[8637]150            a_ip_1d(ji)      = 0._wp
151            a_ip_frac_1d(ji) = 0._wp
152            h_ip_1d(ji)      = 0._wp
153            !                                                     !--------------------------------!
154         ELSE                                                     ! Case ice thickness >= rn_himin !
155            !                                                     !--------------------------------!
156            v_ip_1d(ji) = h_ip_1d(ji) * a_ip_1d(ji)   ! record pond volume at previous time step
[9169]157            !
[8637]158            ! available meltwater for melt ponding [m, >0] and fraction
[9935]159            zdv_mlt = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji)
[8906]160            zfr_mlt = zrmin + ( zrmax - zrmin ) * a_i_1d(ji)  ! from CICE doc
161            !zfr_mlt = zrmin + zrmax * a_i_1d(ji)             ! from Holland paper
[9169]162            !
[8906]163            !--- Pond gowth ---!
[8637]164            ! v_ip should never be negative, otherwise code crashes
165            v_ip_1d(ji) = MAX( 0._wp, v_ip_1d(ji) + zfr_mlt * zdv_mlt )
[9169]166            !
[8906]167            ! melt pond mass flux (<0)
[8637]168            IF( ln_pnd_fwb .AND. zdv_mlt > 0._wp ) THEN
[9935]169               zfac = zfr_mlt * zdv_mlt * rhow * r1_rdtice
[8637]170               wfx_pnd_1d(ji) = wfx_pnd_1d(ji) - zfac
[9169]171               !
[8906]172               ! adjust ice/snow melting flux to balance melt pond flux (>0)
[8637]173               zdum = zfac / ( wfx_snw_sum_1d(ji) + wfx_sum_1d(ji) )
174               wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) * (1._wp + zdum)
175               wfx_sum_1d(ji)     = wfx_sum_1d(ji)     * (1._wp + zdum)
176            ENDIF
[9169]177            !
[8906]178            !--- Pond contraction (due to refreezing) ---!
179            v_ip_1d(ji) = v_ip_1d(ji) * EXP( 0.01_wp * MAX( zTp+rt0 - t_su_1d(ji), 0._wp ) * z1_Tp )
[9169]180            !
[8906]181            ! Set new pond area and depth assuming linear relation between h_ip and a_ip_frac
182            !    h_ip = zpnd_aspect * a_ip_frac = zpnd_aspect * a_ip/a_i
[8637]183            a_ip_1d(ji)      = SQRT( v_ip_1d(ji) * z1_zpnd_aspect * a_i_1d(ji) )
184            a_ip_frac_1d(ji) = a_ip_1d(ji) / a_i_1d(ji)
185            h_ip_1d(ji)      = zpnd_aspect * a_ip_frac_1d(ji)
[9169]186            !
[8637]187         ENDIF
188      END DO
[9169]189      !
[8637]190   END SUBROUTINE pnd_H12
191
[9169]192
[8637]193   SUBROUTINE ice_thd_pnd_init 
194      !!-------------------------------------------------------------------
195      !!                  ***  ROUTINE ice_thd_pnd_init   ***
196      !!
197      !! ** Purpose : Physical constants and parameters linked to melt ponds
198      !!              over sea ice
199      !!
200      !! ** Method  :  Read the namthd_pnd  namelist and check the melt pond 
201      !!               parameter values called at the first timestep (nit000)
202      !!
203      !! ** input   :   Namelist namthd_pnd 
204      !!-------------------------------------------------------------------
[9169]205      INTEGER  ::   ios, ioptio   ! Local integer
206      !!
[8637]207      NAMELIST/namthd_pnd/  ln_pnd_H12, ln_pnd_fwb, ln_pnd_CST, rn_apnd, rn_hpnd, ln_pnd_alb
208      !!-------------------------------------------------------------------
[9169]209      !
[8637]210      REWIND( numnam_ice_ref )              ! Namelist namthd_pnd  in reference namelist : Melt Ponds 
211      READ  ( numnam_ice_ref, namthd_pnd, IOSTAT = ios, ERR = 901)
[9169]212901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namthd_pnd  in reference namelist', lwp )
[8637]213      REWIND( numnam_ice_cfg )              ! Namelist namthd_pnd  in configuration namelist : Melt Ponds
214      READ  ( numnam_ice_cfg, namthd_pnd, IOSTAT = ios, ERR = 902 )
[9169]215902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namthd_pnd in configuration namelist', lwp )
[8637]216      IF(lwm) WRITE ( numoni, namthd_pnd )
[9169]217      !
[8637]218      IF(lwp) THEN                        ! control print
219         WRITE(numout,*)
220         WRITE(numout,*) 'ice_thd_pnd_init: ice parameters for melt ponds'
221         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
222         WRITE(numout,*) '   Namelist namicethd_pnd:'
223         WRITE(numout,*) '      Evolutive melt pond fraction and depth (Holland et al 2012)  ln_pnd_H12 = ', ln_pnd_H12
224         WRITE(numout,*) '         Melt ponds store fresh water or not                       ln_pnd_fwb = ', ln_pnd_fwb
225         WRITE(numout,*) '      Prescribed melt pond fraction and depth                      ln_pnd_Cst = ', ln_pnd_CST
226         WRITE(numout,*) '         Prescribed pond fraction                                  rn_apnd    = ', rn_apnd
227         WRITE(numout,*) '         Prescribed pond depth                                     rn_hpnd    = ', rn_hpnd
228         WRITE(numout,*) '      Melt ponds affect albedo or not                              ln_pnd_alb = ', ln_pnd_alb
229      ENDIF
230      !
231      !                             !== set the choice of ice pond scheme ==!
232      ioptio = 0
233                                                            nice_pnd = np_pndNO
234      IF( ln_pnd_CST ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndCST    ;   ENDIF
235      IF( ln_pnd_H12 ) THEN   ;   ioptio = ioptio + 1   ;   nice_pnd = np_pndH12    ;   ENDIF
236      IF( ioptio > 1 )   CALL ctl_stop( 'ice_thd_pnd_init: choose one and only one pond scheme (ln_pnd_H12 or ln_pnd_CST)' )
[9169]237      !
[8637]238      SELECT CASE( nice_pnd )
239      CASE( np_pndNO )         
240         IF(ln_pnd_fwb) THEN ; ln_pnd_fwb = .FALSE. ; CALL ctl_warn( 'ln_pnd_fwb=false when no ponds' ) ; ENDIF
241         IF(ln_pnd_alb) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF
242      CASE( np_pndCST)
243         IF(ln_pnd_fwb) THEN ; ln_pnd_fwb = .FALSE. ; CALL ctl_warn( 'ln_pnd_fwb=false when ln_pnd_CST=true' ) ; ENDIF
244      END SELECT
245      !
246   END SUBROUTINE ice_thd_pnd_init
247   
248#else
249   !!----------------------------------------------------------------------
[9570]250   !!   Default option          Empty module          NO SI3 sea-ice model
[8637]251   !!----------------------------------------------------------------------
252#endif 
253
254   !!======================================================================
255END MODULE icethd_pnd 
Note: See TracBrowser for help on using the repository browser.