- Timestamp:
- 2020-04-29T17:10:26+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icethd_pnd.F90
r12811 r12831 35 35 ! ! associated indices: 36 36 INTEGER, PARAMETER :: np_pndNO = 0 ! No pond scheme 37 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant pond scheme38 INTEGER, PARAMETER :: np_pnd H12 = 2 ! Evolutive pond scheme (Holland et al. 2012)37 INTEGER, PARAMETER :: np_pndCST = 1 ! Constant ice pond scheme 38 INTEGER, PARAMETER :: np_pndLEV = 2 ! Level ice pond scheme 39 39 40 40 !! * Substitutions … … 51 51 !! *** ROUTINE ice_thd_pnd *** 52 52 !! 53 !! ** Purpose : change melt pond fraction 53 !! ** Purpose : change melt pond fraction and thickness 54 54 !! 55 !! ** Method : brut force56 55 !!------------------------------------------------------------------- 57 56 ! … … 60 59 CASE (np_pndCST) ; CALL pnd_CST !== Constant melt ponds ==! 61 60 ! 62 CASE (np_pnd H12) ; CALL pnd_H12 !== Holland et al 2012melt ponds ==!61 CASE (np_pndLEV) ; CALL pnd_LEV !== Level ice melt ponds ==! 63 62 ! 64 63 END SELECT … … 102 101 103 102 104 SUBROUTINE pnd_ H12105 !!------------------------------------------------------------------- 106 !! *** ROUTINE pnd_ H12***103 SUBROUTINE pnd_LEV 104 !!------------------------------------------------------------------- 105 !! *** ROUTINE pnd_LEV *** 107 106 !! 108 107 !! ** Purpose : Compute melt pond evolution … … 196 195 !--- available meltwater for melt ponding ---! 197 196 zdum = -( dh_i_sum(ji)*rhoi + dh_s_mlt(ji)*rhos ) * z1_rhow * a_i_1d(ji) 198 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) in H12= fraction of melt water that is not flushed197 zfr_mlt = rn_apnd_min + ( rn_apnd_max - rn_apnd_min ) * at_i_1d(ji) ! = ( 1 - r ) = fraction of melt water that is not flushed 199 198 zdv_mlt = MAX( 0._wp, zfr_mlt * zdum ) ! max for roundoff errors? 200 199 ! … … 261 260 ! Pond flushing ! 262 261 !---------------! 263 IF( ln_pnd_flush ) THEN 264 ! height of top of the pond above sea-level 265 zhp = ( h_i_1d(ji) * ( rau0 - rhoi ) + h_ip_1d(ji) * ( rau0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rau0 266 267 ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 268 DO jk = 1, nlay_i 269 zsbr = - 1.2_wp & 270 & - 21.8_wp * ( t_i_1d(ji,jk) - rt0 ) & 271 & - 0.919_wp * ( t_i_1d(ji,jk) - rt0 )**2 & 272 & - 0.0178_wp * ( t_i_1d(ji,jk) - rt0 )**3 273 ztmp(jk) = sz_i_1d(ji,jk) / zsbr 274 END DO 275 zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 276 277 ! Do the drainage using Darcy's law 278 zdv_flush = -zperm * rau0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 279 zdv_flush = MAX( zdv_flush, -v_ip_1d(ji) ) 280 v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 281 282 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 283 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 284 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 285 286 ENDIF 262 ! height of top of the pond above sea-level 263 zhp = ( h_i_1d(ji) * ( rau0 - rhoi ) + h_ip_1d(ji) * ( rau0 - rhow * a_ip_1d(ji) / a_i_1d(ji) ) ) * r1_rau0 264 265 ! Calculate the permeability of the ice (Assur 1958, see Flocco 2010) 266 DO jk = 1, nlay_i 267 zsbr = - 1.2_wp & 268 & - 21.8_wp * ( t_i_1d(ji,jk) - rt0 ) & 269 & - 0.919_wp * ( t_i_1d(ji,jk) - rt0 )**2 & 270 & - 0.0178_wp * ( t_i_1d(ji,jk) - rt0 )**3 271 ztmp(jk) = sz_i_1d(ji,jk) / zsbr 272 END DO 273 zperm = MAX( 0._wp, 3.e-08_wp * MINVAL(ztmp)**3 ) 274 275 ! Do the drainage using Darcy's law 276 zdv_flush = -zperm * rau0 * grav * zhp * rdt_ice / (zvisc * h_i_1d(ji)) * a_ip_1d(ji) 277 zdv_flush = MAX( zdv_flush, -v_ip_1d(ji) ) 278 v_ip_1d(ji) = v_ip_1d(ji) + zdv_flush 279 280 !--- Set new pond area and depth ---! assuming linear relation between h_ip and a_ip_frac 281 a_ip_1d(ji) = MIN( a_i_1d(ji), SQRT( v_ip_1d(ji) * z1_aspect * a_i_1d(ji) ) ) ! make sure a_ip < a_i 282 h_ip_1d(ji) = zaspect * a_ip_1d(ji) / a_i_1d(ji) 287 283 288 284 !--- Corrections and lid thickness ---! … … 304 300 END DO 305 301 ! 306 END SUBROUTINE pnd_ H12302 END SUBROUTINE pnd_LEV 307 303 308 304 … … 321 317 INTEGER :: ios, ioptio ! Local integer 322 318 !! 323 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_ H12, ln_pnd_lids, ln_pnd_flush, rn_apnd_min, rn_apnd_max, &324 & ln_pnd_CST , rn_apnd, rn_hpnd,&325 & ln_pnd_ alb319 NAMELIST/namthd_pnd/ ln_pnd, ln_pnd_LEV , rn_apnd_min, rn_apnd_max, & 320 & ln_pnd_CST , rn_apnd, rn_hpnd, & 321 & ln_pnd_lids, ln_pnd_alb 326 322 !!------------------------------------------------------------------- 327 323 ! … … 340 336 WRITE(numout,*) ' Namelist namicethd_pnd:' 341 337 WRITE(numout,*) ' Melt ponds activated or not ln_pnd = ', ln_pnd 342 WRITE(numout,*) ' Evolutive melt pond fraction and depth ln_pnd_H12 = ', ln_pnd_H12 343 WRITE(numout,*) ' Melt ponds can have frozen lids ln_pnd_lids = ', ln_pnd_lids 344 WRITE(numout,*) ' Allow ponds to flush thru the ice ln_pnd_flush = ', ln_pnd_flush 338 WRITE(numout,*) ' Level ice melt pond scheme ln_pnd_LEV = ', ln_pnd_LEV 345 339 WRITE(numout,*) ' Minimum ice fraction that contributes to melt ponds rn_apnd_min = ', rn_apnd_min 346 340 WRITE(numout,*) ' Maximum ice fraction that contributes to melt ponds rn_apnd_max = ', rn_apnd_max 347 WRITE(numout,*) ' Prescribed melt pond fraction and depthln_pnd_CST = ', ln_pnd_CST341 WRITE(numout,*) ' Constant ice melt pond scheme ln_pnd_CST = ', ln_pnd_CST 348 342 WRITE(numout,*) ' Prescribed pond fraction rn_apnd = ', rn_apnd 349 343 WRITE(numout,*) ' Prescribed pond depth rn_hpnd = ', rn_hpnd 344 WRITE(numout,*) ' Frozen lids on top of melt ponds ln_pnd_lids = ', ln_pnd_lids 350 345 WRITE(numout,*) ' Melt ponds affect albedo or not ln_pnd_alb = ', ln_pnd_alb 351 346 ENDIF … … 355 350 IF( .NOT.ln_pnd ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndNO ; ENDIF 356 351 IF( ln_pnd_CST ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndCST ; ENDIF 357 IF( ln_pnd_ H12 ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndH12; ENDIF352 IF( ln_pnd_LEV ) THEN ; ioptio = ioptio + 1 ; nice_pnd = np_pndLEV ; ENDIF 358 353 IF( ioptio /= 1 ) & 359 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_ H12or ln_pnd_CST)' )354 & CALL ctl_stop( 'ice_thd_pnd_init: choose either none (ln_pnd=F) or only one pond scheme (ln_pnd_LEV or ln_pnd_CST)' ) 360 355 ! 361 356 SELECT CASE( nice_pnd ) 362 357 CASE( np_pndNO ) 363 IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 358 IF( ln_pnd_alb ) THEN ; ln_pnd_alb = .FALSE. ; CALL ctl_warn( 'ln_pnd_alb=false when no ponds' ) ; ENDIF 359 IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when no ponds' ) ; ENDIF 360 CASE( np_pndCST ) 361 IF( ln_pnd_lids ) THEN ; ln_pnd_lids = .FALSE. ; CALL ctl_warn( 'ln_pnd_lids=false when constant ponds' ) ; ENDIF 364 362 END SELECT 365 363 !
Note: See TracChangeset
for help on using the changeset viewer.
