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.
Changeset 8060 – NEMO

Changeset 8060


Ignore:
Timestamp:
2017-05-23T16:32:58+02:00 (7 years ago)
Author:
vancop
Message:

Simple melt ponds for interface test

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6859_LIM3_meltponds/NEMOGCM/NEMO/LIM_SRC_3/limmp.F90

    r7325 r8060  
    128128      IF( nn_timing == 1 )  CALL timing_start('lim_mp') 
    129129 
    130       CALL lim_mp_topo    (at_i, a_i,                                       & 
    131                 &          vt_i, v_i, v_s,            t_i, s_i, a_ip_frac,  & 
    132                 &          h_ip,     t_su) 
     130      CALL lim_mp_cesm ! test routine with hyper simple melt ponds 
     131 
     132      !CALL lim_mp_topo    (at_i, a_i,                                       & 
     133      !          &          vt_i, v_i, v_s,            t_i, s_i, a_ip_frac,  & 
     134      !          &          h_ip,     t_su) 
     135 
    133136 
    134137      ! we should probably not aggregate here since we do it in lim_var_agg 
     
    139142 
    140143   END SUBROUTINE lim_mp  
     144 
     145   SUBROUTINE lim_mp_cesm 
     146       !!------------------------------------------------------------------- 
     147       !!                ***  ROUTINE lim_mp_cesm  *** 
     148       !! 
     149       !! ** Purpose    : Compute melt pond evolution 
     150       !! 
     151       !! ** Method     : Accumulation of meltwater and exponential release 
     152       !! 
     153       !! ** Tunable parameters : 
     154       !!                 
     155       !!  
     156       !! ** Note       : Stolen from CICE for quick test of the melt pond 
     157       !!                 interface 
     158       !! 
     159       !! ** References : Holland, M. M. et al (J Clim 2012) 
     160       !!     
     161       !!------------------------------------------------------------------- 
     162 
     163       INTEGER, POINTER, DIMENSION(:,:)    :: indxi             ! compressed indices for cells with ice melting 
     164       INTEGER, POINTER, DIMENSION(:,:)    :: indxj             ! 
     165 
     166       REAL(wp), POINTER, DIMENSION(:,:)   :: zwfx_mlw          ! available meltwater for melt ponding 
     167       REAL(wp), POINTER, DIMENSION(:,:,:) :: zrfrac            ! fraction of available meltwater retained for melt ponding 
     168 
     169       REAL(wp), PARAMETER                 :: zrmin  = 0.15_wp  ! minimum fraction of available meltwater retained for melt ponding 
     170       REAL(wp), PARAMETER                 :: zrmax  = 0.70_wp  ! maximum   ''           ''       ''        ''            '' 
     171       REAL(wp), PARAMETER                 :: zrexp  = 0.01_wp  ! rate constant to refreeze melt ponds 
     172       REAL(wp), PARAMETER                 :: zpnd_aspect = 0.8_wp ! pond aspect ratio 
     173 
     174       REAL(wp)                            :: zhi               ! dummy ice thickness 
     175       REAL(wp)                            :: zhs               ! dummy snow depth 
     176       REAL(wp)                            :: zTp               ! reference temperature 
     177       REAL(wp)                            :: zrexp             ! rate constant to refreeze melt ponds 
     178       REAL(wp)                            :: zdTs              ! dummy temperature difference 
     179       REAL(wp)                            :: z1_rhofw          ! inverse freshwater density 
     180       REAL(wp)                            :: z1_zpnd_aspect    ! inverse pond aspect ratio 
     181 
     182       !!------------------------------------------------------------------- 
     183 
     184       CALL wrk_alloc( jpi,jpj, zwfx_mlw ) 
     185       CALL wrk_alloc( jpi*jpj, indxi, indxj) 
     186 
     187       z1_rhofw       = 1. / rhofw  
     188       z1_zpnd_aspect = 1. / zpnd_aspect 
     189       zTp            = -2 + rt0. 
     190 
     191       !------------------------------------------------------------------ 
     192       ! Available melt water for melt ponding and corresponding fraction 
     193       !------------------------------------------------------------------ 
     194 
     195       zwfx_mlw(:,:) = wfx_sum(:,:) + wfx_snw(:,:)        ! available meltwater for melt ponding 
     196 
     197       zrfrac(:,:,:) = zrmin + ( zrmax - zrmin ) * a_i(:,:,:)   
     198 
     199       DO jl = 1, jpl    
     200 
     201          ! v_ip(:,:,jl) ! Initialize things 
     202          ! a_ip(:,:,jl) 
     203          ! volpn(:,:) = hpnd(:,:) * apnd(:,:) * aicen(:,:) 
     204 
     205          !------------------------------------------------------------------------------ 
     206          ! Identify grid cells where ponds should be updated (can probably be improved) 
     207          !------------------------------------------------------------------------------ 
     208 
     209          indxi(:) = 0 
     210          indxj(:) = 0 
     211          icells   = 0 
     212 
     213          DO jj = 1, jpj 
     214            DO ji = 1, jpi 
     215               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
     216                  icells = icells + 1 
     217                  indxi(icells) = i 
     218                  indxj(icells) = j 
     219               ENDIF 
     220            END DO                 ! ji 
     221         END DO                    ! jj 
     222 
     223         DO ij = 1, icells 
     224 
     225            ji = indxi(ij) 
     226            jj = indxj(ij) 
     227 
     228            zhi = v_i(ji,jj,jl) / a_i(ji,jj,jl) 
     229            zhs = v_s(ji,jj,jl) / a_i(ji,jj,jl) 
     230 
     231            IF ( zhi < rn_himin) THEN   !--- Remove ponds on thin ice if ice is too thin 
     232 
     233               wfx_pnd(ji,jj)   = wfx_pnd(ji,jj) + v_ip(ji,jj,jl) !--- Give freshwater to the ocean 
     234 
     235               a_ip(ji,jj,jl)      = 0._wp                        !--- Dump ponds 
     236               v_ip(ji,jj,jl)      = 0._wp 
     237               a_ip_frac(ji,jj,jl) = 0._wp 
     238               h_ip(ji,jj,jl)      = 0._wp 
     239 
     240            ELSE                        !--- Update pond characteristics 
     241 
     242               !--- Add retained melt water 
     243               v_ip(ji,jj,jl) = v_ip(ji,jj,jl) + rfrac(ji,jj,jl) * z1_rhofw * zwfx_mlw(ji,jj) * a_i(ji,jj,jl) 
     244 
     245               !--- Shrink pond due to refreezing 
     246               zdTs = MAX ( zTp - t_su(ji,jj,jl) , 0. ) 
     247                
     248               v_ip(ji,jj,jl) = v_ip(ji,jj,jl) * EXP( rexp * zdTs / zTp ) 
     249            
     250               a_ip_frac(ji,jj,jl) = MIN( 1._wp , SQRT( v_ip(ji,jj,jl) * z1_zpnd_aspect / a_i(ji,jj,jl) ) ) 
     251 
     252               h_ip(ji,jj,jl)      = zpnd_aspect * a_ip_frac(ji,jj,jl) 
     253 
     254               a_ip(ji,jj,jl)      = a_ip_frac(ji,jj,jl) * a_i(ji,jj,jl) 
     255 
     256            !----------------------------------------------------------- 
     257            ! Limit pond depth 
     258            !----------------------------------------------------------- 
     259            ! hpondn = min(hpondn, dpthhi*hi) 
     260 
     261            !--- Give freshwater to the ocean ? 
     262 
     263            ENDIF 
     264 
     265         END DO 
     266 
     267      END DO ! jpl 
     268 
     269   END SUBROUTINE lim_mp_cesm 
    141270 
    142271   SUBROUTINE lim_mp_topo    (aice,      aicen,     & 
     
    304433          wfx_pnd(i,j) = wfx_pnd(i,j) + zdvn ! update flux from ponds to ocean 
    305434  
    306           ! mean surface temperature 
    307           zTavg = z0 
    308           DO n = 1, jpl 
    309              zTavg = zTavg + zTsfcn(i,j,n)*aicen(i,j,n) 
    310           END DO 
    311           zTavg = zTavg / aice(i,j) 
     435          ! mean surface temperature MV - why do we need that ? --> for the lid 
     436 
     437          ! zTavg = z0 
     438          ! DO n = 1, jpl 
     439          !   zTavg = zTavg + zTsfcn(i,j,n)*aicen(i,j,n) 
     440          ! END DO 
     441          ! zTavg = zTavg / aice(i,j) 
    312442  
    313443       END DO ! ij 
     
    438568                                  * (-0.024_wp*hicen(n) + 0.832_wp)  
    439569             asnon(n) = reduced_aicen(n)  ! effective snow fraction (empirical) 
     570             ! MV should check whether this makes sense to have the same effective snow fraction in here 
    440571          END IF 
    441572  
     
    448579 ! alfan = 60% of the ice volume) in each category lies above the reference line,  
    449580 ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required. 
    450   
    451           alfan(n) = p6 * hicen(n) 
    452           betan(n) = p4 * hicen(n) 
     581 
     582 ! MV:   
     583 ! Note that this choice is not in the original FF07 paper and has been adopted in CICE 
     584 ! No reason why is explained in the doc, but I guess there is a reason. I'll try to investigate, maybe 
     585 
     586 ! Where does that choice come from 
     587  
     588          alfan(n) = 0.6 * hicen(n) 
     589          betan(n) = 0.4 * hicen(n) 
    453590         
    454591          cum_max_vol(n)     = z0 
     
    18742011   SUBROUTINE lim_mp_topo     ! Empty routine 
    18752012   END SUBROUTINE lim_mp_topo 
     2013   SUBROUTINE lim_mp_cesm     ! Empty routine 
     2014   END SUBROUTINE lim_mp_cesm 
    18762015   SUBROUTINE lim_mp_area     ! Empty routine 
    18772016   END SUBROUTINE lim_mp_area 
Note: See TracChangeset for help on using the changeset viewer.