- Timestamp:
- 2020-09-15T09:27:47+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/temporary_r4_trunk/src/ICE/icethd.F90
r11536 r13466 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 … … 102 107 WRITE(numout,*) '~~~~~~~' 103 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 114 ENDIF 104 115 105 116 !---------------------------------------------! … … 164 175 ! If the grid cell is fully covered by ice (no leads) => transfer energy from the lead budget to the ice bottom budget 165 176 IF( ( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) .OR. at_i(ji,jj) >= (1._wp - epsi10) ) THEN 166 fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 177 IF( ln_leadhfx ) THEN ; fhld(ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 178 ELSE ; fhld(ji,jj) = 0._wp 179 ENDIF 167 180 qlead(ji,jj) = 0._wp 168 181 ELSE … … 216 229 ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 217 230 ! 218 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here)231 s_i_new (1:npti) = 0._wp ; dh_s_tot(1:npti) = 0._wp ! --- some init --- ! (important to have them here) 219 232 dh_i_sum (1:npti) = 0._wp ; dh_i_bom(1:npti) = 0._wp ; dh_i_itm (1:npti) = 0._wp 220 233 dh_i_sub (1:npti) = 0._wp ; dh_i_bog(1:npti) = 0._wp … … 249 262 ! 250 263 IF( ln_icedO ) CALL ice_thd_do ! --- Frazil ice growth in leads --- ! 264 ! 265 ! convergence tests 266 IF( ln_zdf_chkcvg ) THEN 267 CALL iom_put( 'tice_cvgerr', ztice_cvgerr ) ; DEALLOCATE( ztice_cvgerr ) 268 CALL iom_put( 'tice_cvgstp', ztice_cvgstp ) ; DEALLOCATE( ztice_cvgstp ) 269 ENDIF 251 270 ! 252 271 ! controls … … 354 373 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) ) 355 374 CALL tab_2d_1d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) ) 356 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )375 CALL tab_2d_1d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) ) 357 376 ! 358 377 CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice ) … … 406 425 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 407 426 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 408 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )409 427 CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 410 428 ! … … 441 459 sv_i_1d(1:npti) = s_i_1d (1:npti) * v_i_1d (1:npti) 442 460 v_ip_1d(1:npti) = h_ip_1d(1:npti) * a_ip_1d(1:npti) 461 v_il_1d(1:npti) = h_il_1d(1:npti) * a_ip_1d(1:npti) 443 462 oa_i_1d(1:npti) = o_i_1d (1:npti) * a_i_1d (1:npti) 444 463 … … 460 479 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_1d (1:npti), a_ip (:,:,kl) ) 461 480 CALL tab_1d_2d( npti, nptidx(1:npti), h_ip_1d (1:npti), h_ip (:,:,kl) ) 462 CALL tab_1d_2d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) )481 CALL tab_1d_2d( npti, nptidx(1:npti), h_il_1d (1:npti), h_il (:,:,kl) ) 463 482 ! 464 483 CALL tab_1d_2d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) … … 498 517 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 499 518 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 500 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem )501 519 CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 502 520 ! … … 515 533 CALL tab_1d_2d( npti, nptidx(1:npti), sv_i_1d(1:npti), sv_i(:,:,kl) ) 516 534 CALL tab_1d_2d( npti, nptidx(1:npti), v_ip_1d(1:npti), v_ip(:,:,kl) ) 535 CALL tab_1d_2d( npti, nptidx(1:npti), v_il_1d(1:npti), v_il(:,:,kl) ) 517 536 CALL tab_1d_2d( npti, nptidx(1:npti), oa_i_1d(1:npti), oa_i(:,:,kl) ) 537 ! check convergence of heat diffusion scheme 538 IF( ln_zdf_chkcvg ) THEN 539 CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgerr_1d(1:npti), ztice_cvgerr(:,:,kl) ) 540 CALL tab_1d_2d( npti, nptidx(1:npti), tice_cvgstp_1d(1:npti), ztice_cvgstp(:,:,kl) ) 541 ENDIF 518 542 ! 519 543 END SELECT … … 536 560 INTEGER :: ios ! Local integer output status for namelist read 537 561 !! 538 NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS 562 NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS, ln_leadhfx 539 563 !!------------------------------------------------------------------- 540 564 ! … … 552 576 WRITE(numout,*) '~~~~~~~~~~~~' 553 577 WRITE(numout,*) ' Namelist namthd:' 554 WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH 555 WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA 556 WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO 557 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS 578 WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH 579 WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA 580 WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO 581 WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS 582 WRITE(numout,*) ' heat in the leads is used to melt sea-ice before warming the ocean ln_leadhfx = ', ln_leadhfx 558 583 ENDIF 559 584 !
Note: See TracChangeset
for help on using the changeset viewer.
