Changeset 14072 for NEMO/trunk/src/ICE/icethd.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/icethd.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icethd.F90
r14005 r14072 69 69 SUBROUTINE ice_thd( kt ) 70 70 !!------------------------------------------------------------------- 71 !! *** ROUTINE ice_thd *** 72 !! 71 !! *** ROUTINE ice_thd *** 72 !! 73 73 !! ** Purpose : This routine manages ice thermodynamics 74 !! 74 !! 75 75 !! ** Action : - computation of oceanic sensible heat flux at the ice base 76 76 !! energy budget in the leads … … 114 114 ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 115 115 ENDIF 116 116 117 117 !---------------------------------------------! 118 118 ! computation of friction velocity at T points … … 157 157 ! --- Sensible ocean-to-ice heat flux (W/m2) --- ! 158 158 ! (mostly>0 but <0 if supercooling) 159 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 159 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 160 160 qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 161 162 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 161 162 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 163 163 ! the freezing point, so that we do not have SST < T_freeze 164 164 ! This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg … … 210 210 ! 211 211 END_2D 212 212 213 213 ! In case we bypass open-water ice formation 214 214 IF( .NOT. ln_icedO ) qlead(:,:) = 0._wp … … 227 227 npti = 0 ; nptidx(:) = 0 228 228 DO_2D( 1, 1, 1, 1 ) 229 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 229 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 230 230 npti = npti + 1 231 231 nptidx(npti) = (jj - 1) * jpi + ji … … 234 234 235 235 IF( npti > 0 ) THEN ! If there is no ice, do nothing. 236 ! 236 ! 237 237 CALL ice_thd_1d2d( jl, 1 ) ! --- Move to 1D arrays --- ! 238 238 ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 239 239 ! 240 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 241 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 240 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 241 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 242 242 dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp 243 243 dh_snowice(1:npti) = 0._wp ; dh_s_mlt(1:npti) = 0._wp 244 ! 244 ! 245 245 CALL ice_thd_zdf ! --- Ice-Snow temperature --- ! 246 246 ! 247 247 IF( ln_icedH ) THEN ! --- Growing/Melting --- ! 248 CALL ice_thd_dh ! Ice-Snow thickness 248 CALL ice_thd_dh ! Ice-Snow thickness 249 249 CALL ice_thd_ent( e_i_1d(1:npti,:) ) ! Ice enthalpy remapping 250 250 ENDIF 251 CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! 251 CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! 252 252 ! 253 253 CALL ice_thd_temp ! --- Temperature update --- ! … … 266 266 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 267 267 IF( ln_icediachk ) CALL ice_cons2D (1, 'icethd', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 268 ! 268 ! 269 269 IF ( ln_pnd .AND. ln_icedH ) & 270 & CALL ice_thd_pnd ! --- Melt ponds 270 & CALL ice_thd_pnd ! --- Melt ponds 271 271 ! 272 272 IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- ! … … 276 276 CALL ice_cor( kt , 2 ) ! --- Corrections --- ! 277 277 ! 278 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice ! ice natural aging incrementation 278 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice ! ice natural aging incrementation 279 279 ! 280 280 ! convergence tests … … 290 290 IF( ln_timing ) CALL timing_stop('icethd') ! timing 291 291 ! 292 END SUBROUTINE ice_thd 293 294 292 END SUBROUTINE ice_thd 293 294 295 295 SUBROUTINE ice_thd_temp 296 296 !!----------------------------------------------------------------------- 297 !! *** ROUTINE ice_thd_temp *** 298 !! 297 !! *** ROUTINE ice_thd_temp *** 298 !! 299 299 !! ** Purpose : Computes sea ice temperature (Kelvin) from enthalpy 300 300 !! … … 302 302 !!------------------------------------------------------------------- 303 303 INTEGER :: ji, jk ! dummy loop indices 304 REAL(wp) :: ztmelts, zbbb, zccc ! local scalar 304 REAL(wp) :: ztmelts, zbbb, zccc ! local scalar 305 305 !!------------------------------------------------------------------- 306 306 ! Recover ice temperature … … 312 312 zccc = SQRT( MAX( zbbb * zbbb - 4._wp * rcpi * rLfus * ztmelts, 0._wp ) ) 313 313 t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_rcpi 314 314 315 315 ! mask temperature 316 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 316 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - h_i_1d(ji) ) ) 317 317 t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0 318 END DO 319 END DO 318 END DO 319 END DO 320 320 ! 321 321 END SUBROUTINE ice_thd_temp … … 324 324 SUBROUTINE ice_thd_mono 325 325 !!----------------------------------------------------------------------- 326 !! *** ROUTINE ice_thd_mono *** 327 !! 326 !! *** ROUTINE ice_thd_mono *** 327 !! 328 328 !! ** Purpose : Lateral melting in case virtual_itd 329 329 !! ( dA = A/2h dh ) … … 332 332 REAL(wp) :: zhi_bef ! ice thickness before thermo 333 333 REAL(wp) :: zdh_mel, zda_mel ! net melting 334 REAL(wp) :: zvi, zvs ! ice/snow volumes 334 REAL(wp) :: zvi, zvs ! ice/snow volumes 335 335 !!----------------------------------------------------------------------- 336 336 ! … … 344 344 rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 345 345 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 346 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 346 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 347 347 ! adjust thickness 348 h_i_1d(ji) = zvi / a_i_1d(ji) 349 h_s_1d(ji) = zvs / a_i_1d(ji) 348 h_i_1d(ji) = zvi / a_i_1d(ji) 349 h_s_1d(ji) = zvs / a_i_1d(ji) 350 350 ! retrieve total concentration 351 351 at_i_1d(ji) = a_i_1d(ji) … … 358 358 SUBROUTINE ice_thd_1d2d( kl, kn ) 359 359 !!----------------------------------------------------------------------- 360 !! *** ROUTINE ice_thd_1d2d *** 361 !! 360 !! *** ROUTINE ice_thd_1d2d *** 361 !! 362 362 !! ** Purpose : move arrays from 1d to 2d and the reverse 363 363 !!----------------------------------------------------------------------- 364 INTEGER, INTENT(in) :: kl ! index of the ice category 364 INTEGER, INTENT(in) :: kl ! index of the ice category 365 365 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 366 366 ! … … 394 394 CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) ) 395 395 CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d (1:npti), t_bo ) 396 CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d (1:npti), sprecip ) 396 CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d (1:npti), sprecip ) 397 397 CALL tab_2d_1d( npti, nptidx(1:npti), qsb_ice_bot_1d(1:npti), qsb_ice_bot ) 398 398 CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d (1:npti), fhld ) 399 399 400 400 CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d (1:npti), qml_ice (:,:,kl) ) 401 401 CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d (1:npti), qcn_ice (:,:,kl) ) … … 471 471 sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 472 472 oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 473 473 474 474 CALL tab_1d_2d( npti, nptidx(1:npti), at_i_1d(1:npti), at_i ) 475 475 CALL tab_1d_2d( npti, nptidx(1:npti), a_i_1d (1:npti), a_i (:,:,kl) ) … … 532 532 CALL tab_1d_2d( npti, nptidx(1:npti), dh_i_sum (1:npti) , dh_i_sum_2d(:,:,kl) ) 533 533 CALL tab_1d_2d( npti, nptidx(1:npti), dh_s_mlt (1:npti) , dh_s_mlt_2d(:,:,kl) ) 534 ! SIMIP diagnostics 534 ! SIMIP diagnostics 535 535 CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d (1:npti), t_si (:,:,kl) ) 536 536 CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) … … 554 554 SUBROUTINE ice_thd_init 555 555 !!------------------------------------------------------------------- 556 !! *** ROUTINE ice_thd_init *** 557 !! 556 !! *** ROUTINE ice_thd_init *** 557 !! 558 558 !! ** Purpose : Physical constants and parameters associated with 559 559 !! ice thermodynamics
Note: See TracChangeset
for help on using the changeset viewer.
