Changeset 13472 for NEMO/trunk/src/ICE/icethd.F90
- Timestamp:
- 2020-09-16T15:05:19+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icethd.F90
r13295 r13472 35 35 ! 36 36 USE in_out_manager ! I/O manager 37 USE iom ! I/O manager library 37 38 USE lib_mpp ! MPP library 38 39 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) … … 51 52 LOGICAL :: ln_icedO ! activate ice growth in open-water (T) or not (F) 52 53 LOGICAL :: ln_icedS ! activate gravity drainage and flushing (T) or not (F) 54 LOGICAL :: ln_leadhfx ! heat in the leads is used to melt sea-ice before warming the ocean 55 56 !! for convergence tests 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztice_cvgerr, ztice_cvgstp 53 58 54 59 !! * Substitutions … … 101 106 WRITE(numout,*) 'ice_thd: sea-ice thermodynamics' 102 107 WRITE(numout,*) '~~~~~~~' 108 ENDIF 109 110 ! convergence tests 111 IF( ln_zdf_chkcvg ) THEN 112 ALLOCATE( ztice_cvgerr(jpi,jpj,jpl) , ztice_cvgstp(jpi,jpj,jpl) ) 113 ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 103 114 ENDIF 104 115 … … 159 170 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 160 171 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 161 fhld (ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 172 IF( ln_leadhfx ) THEN ; fhld(ji,jj) = rswitch * zqld * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 173 ELSE ; fhld(ji,jj) = 0._wp 174 ENDIF 162 175 qlead(ji,jj) = 0._wp 163 176 ELSE … … 208 221 ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 209 222 ! 210 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here)223 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 211 224 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 212 225 dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp … … 242 255 IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- ! 243 256 ! 257 ! convergence tests 258 IF( ln_zdf_chkcvg ) THEN 259 CALL iom_put( 'tice_cvgerr', ztice_cvgerr ) ; DEALLOCATE( ztice_cvgerr ) 260 CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) 261 ENDIF 262 ! 244 263 ! controls 245 264 IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints … … 347 366 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) ) 348 367 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) ) 349 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )368 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) ) 350 369 ! 351 370 CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice ) … … 399 418 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 400 419 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 401 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )402 420 CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 403 421 ! … … 434 452 sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 435 453 v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 454 v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 436 455 oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 437 456 … … 453 472 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) ) 454 473 CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) ) 455 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )474 CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) ) 456 475 ! 457 476 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) … … 491 510 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 492 511 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 493 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )494 512 CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 495 513 ! … … 508 526 CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 509 527 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 528 CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 510 529 CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 530 ! check convergence of heat diffusion scheme 531 IF( ln_zdf_chkcvg ) THEN 532 CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) 533 CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) 534 ENDIF 511 535 ! 512 536 END SELECT … … 529 553 INTEGER :: ios ! Local integer output status for namelist read 530 554 !! 531 NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 555 NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 532 556 !!------------------------------------------------------------------- 533 557 ! … … 543 567 WRITE(numout,*) '~~~~~~~~~~~~' 544 568 WRITE(numout,*) ' Namelist namthd:' 545 WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH 546 WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA 547 WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO 548 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS 569 WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH 570 WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA 571 WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO 572 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS 573 WRITE(numout,*) ' heat in the leads is used to melt sea-ice before warming the ocean ln_leadhfx = ', ln_leadhfx 549 574 ENDIF 550 575 !
Note: See TracChangeset
for help on using the changeset viewer.