MODULE sbcice_lim_2 !!====================================================================== !! *** MODULE sbcice_lim_2 *** !! Surface module : update surface ocean boundary condition over ice !! covered area using LIM sea-ice model !! Sea-Ice model : LIM 2.0 Sea ice model time-stepping !!====================================================================== !! History : 9.0 ! 06-06 (G. Madec) from icestp_2.F90 !!---------------------------------------------------------------------- #if defined key_lim2 !!---------------------------------------------------------------------- !! 'key_lim2' : LIM 2.0 sea-ice model !!---------------------------------------------------------------------- !! sbc_ice_lim_2 : sea-ice model time-stepping and !! update ocean sbc over ice-covered area !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE c1d ! 1d configuration USE dom_oce ! ocean space and time domain USE ice_2 USE iceini_2 USE ice_oce ! ice variables USE dom_ice_2 USE cpl_oce USE sbc_oce ! Surface boundary condition: ocean fields USE sbc_ice ! Surface boundary condition: ice fields USE sbcblk_core ! Surface boundary condition: CORE bulk USE sbcblk_clio ! Surface boundary condition: CLIO bulk USE albedo USE daymod ! day calendar USE phycst ! Define parameters for the routines USE eosbn2 ! equation of state USE limdyn_2 USE limtrp_2 USE limdmp_2 USE limthd_2 USE limsbc_2 ! sea surface boundary condition USE limdia_2 USE limwri_2 USE limrst_2 USE lbclnk USE iom ! I/O manager library USE in_out_manager ! I/O manager USE prtctl ! Print control IMPLICIT NONE PRIVATE PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 CHARACTER(len=1) :: cl_grid = 'B' ! type of grid used in ice dynamics !! * Substitutions # include "domzgr_substitute.h90" # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/SBC 3.0 , LOCEAN-IPSL (2008) !! $Id: $ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE sbc_ice_lim_2( kt, kblk ) !!--------------------------------------------------------------------- !! *** ROUTINE sbc_ice_lim_2 *** !! !! ** Purpose : update the ocean surface boundary condition via the !! Louvain la Neuve Sea Ice Model time stepping !! !! ** Method : ice model time stepping !! - call the ice dynamics routine !! - call the ice advection/diffusion routine !! - call the ice thermodynamics routine !! - call the routine that computes mass and !! heat fluxes at the ice/ocean interface !! - save the outputs !! - save the outputs for restart when necessary !! !! ** Action : - time evolution of the LIM sea-ice model !! - update all sbc variables below sea-ice: !! utau, vtau, qns , qsr, emp , emps !!--------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! ocean time step INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE) !! INTEGER :: ji, jj ! dummy loop indices REAL(wp) :: zinda REAL(wp), DIMENSION(jpi,jpj,1) :: alb_ice_os ! albedo of the ice under overcast sky REAL(wp), DIMENSION(jpi,jpj,1) :: alb_ice_cs ! albedo of ice under clear sky REAL(wp), DIMENSION(jpi,jpj,1) :: zsist ! surface ice temperature (K) REAL(wp), DIMENSION(jpi,jpj,1) :: zhicif ! ice thickness REAL(wp), DIMENSION(jpi,jpj,1) :: zhsnif ! snow thickness REAL(wp), DIMENSION(jpi,jpj,1) :: zqns_ice ! non solar sea-ice heat flux REAL(wp), DIMENSION(jpi,jpj,1) :: zqsr_ice ! solar sea-ice heat flux REAL(wp), DIMENSION(jpi,jpj,1) :: zqla_ice ! ice latent heat flux REAL(wp), DIMENSION(jpi,jpj,1) :: zdqns_ice ! sensitivity ice net heat flux REAL(wp), DIMENSION(jpi,jpj,1) :: zdqla_ice ! sensitivity ice latent heat flux !!---------------------------------------------------------------------- IF( kt == nit000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition' IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM) time stepping' CALL ice_init_2 ENDIF IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! ! ... mean surface ocean current at ice dynamics point ! B-grid dynamics : I-point (F-point with sea-ice indexation) DO jj = 2, jpj DO ji = fs_2, jpi ! vector opt. ui_oce(ji,jj) = 0.5 * ( ssu_m(ji-1,jj ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj) vi_oce(ji,jj) = 0.5 * ( ssv_m(ji ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj) END DO END DO CALL lbc_lnk( ui_oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices) CALL lbc_lnk( vi_oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices) ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land) tfu(:,:) = tfreez( sss_m ) + rt0 zsist (:,:,1) = sist (:,:) zhicif(:,:,1) = hicif(:,:) ; zhsnif(:,:,1) = hsnif(:,:) ! ... ice albedo CALL albedo_ice( zsist, zhicif, zhsnif, alb_ice_cs, alb_ice_os ) ! ... Sea-ice surface boundary conditions output from bulk formulae : ! - utaui_ice ! surface ice stress i-component (I-point) [N/m2] ! - vtaui_ice ! surface ice stress j-component (I-point) [N/m2] ! - qns_ice ! non solar heat flux over ice (T-point) [W/m2] ! - qsr_ice ! solar heat flux over ice (T-point) [W/m2] ! - qla_ice ! latent heat flux over ice (T-point) [W/m2] ! - dqns_ice ! non solar heat sensistivity (T-point) [W/m2] ! - dqla_ice ! latent heat sensistivity (T-point) [W/m2] ! - tprecip ! total precipitation (T-point) [Kg/m2/s] ! - sprecip ! solid precipitation (T-point) [Kg/m2/s] ! - fr1_i0 ! 1sr fraction of qsr penetration in ice [%] ! - fr2_i0 ! 2nd fraction of qsr penetration in ice [%] ! SELECT CASE( kblk ) CASE( 3 ) ! CLIO bulk formulation CALL blk_ice_clio( zsist , ui_ice , vi_ice , alb_ice_cs , alb_ice_os , & & utaui_ice , vtaui_ice , zqns_ice , zqsr_ice, & & zqla_ice , zdqns_ice , zdqla_ice , & & tprecip , sprecip , & & fr1_i0 , fr2_i0 , cl_grid ) CASE( 4 ) ! CORE bulk formulation CALL blk_ice_core( zsist , ui_ice , vi_ice , alb_ice_cs , & & utaui_ice , vtaui_ice , zqns_ice , zqsr_ice, & & zqla_ice , zdqns_ice , zdqla_ice , & & tprecip , sprecip , & & fr1_i0 , fr2_i0 , cl_grid) END SELECT qsr_ice(:,:) = zqsr_ice(:,:,1) qns_ice(:,:) = zqns_ice(:,:,1) ; dqns_ice(:,:) = zdqns_ice(:,:,1) qla_ice(:,:) = zqla_ice(:,:,1) ; dqla_ice(:,:) = zdqla_ice(:,:,1) IF(ln_ctl) THEN ! print mean trends (used for debugging) CALL prt_ctl_info( 'Ice Forcings ' ) CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip : ', tab2d_2=sprecip , clinfo2=' Snow : ' ) CALL prt_ctl( tab2d_1=utaui_ice,clinfo1=' sbc_ice_lim: utaui_ice: ', tab2d_2=vtaui_ice, clinfo2=' vtaui_ice: ' ) CALL prt_ctl( tab2d_1=sst_m ,clinfo1=' sbc_ice_lim: sst : ', tab2d_2=sss_m , clinfo2=' sss : ' ) CALL prt_ctl( tab2d_1=ui_oce ,clinfo1=' sbc_ice_lim: u_io : ', tab2d_2=vi_oce , clinfo2=' v_io : ' ) CALL prt_ctl( tab2d_1=hsnif ,clinfo1=' sbc_ice_lim: hsnif 1 : ', tab2d_2=hicif , clinfo2=' hicif : ' ) CALL prt_ctl( tab2d_1=frld ,clinfo1=' sbc_ice_lim: frld 1 : ', tab2d_2=sist , clinfo2=' sist : ' ) ENDIF ! ---------------- ! ! Ice model step ! ! ---------------- ! CALL lim_rst_opn_2 ( kt ) ! Open Ice restart file IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (not in 1D case) CALL lim_dyn_2 ( kt ) ! Ice dynamics ( rheology/dynamics ) CALL lim_trp_2 ( kt ) ! Ice transport ( Advection/diffusion ) IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping ENDIF CALL lim_thd_2 ( kt ) ! Ice thermodynamics CALL lim_sbc_2 ( kt ) ! Ice/Ocean Mass & Heat fluxes IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. & & ntmoy == 1 ) CALL lim_dia_2 ( kt ) ! Ice Diagnostics CALL lim_wri_2 ( kt ) ! Ice outputs IF( lrst_ice ) CALL lim_rst_write_2( kt ) ! Ice restart file ! ENDIF ! END SUBROUTINE sbc_ice_lim_2 #else !!---------------------------------------------------------------------- !! Default option Dummy module NO LIM 2.0 sea-ice model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE sbc_ice_lim_2 ( kt, kblk ) ! Dummy routine WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, kblk END SUBROUTINE sbc_ice_lim_2 #endif !!====================================================================== END MODULE sbcice_lim_2