MODULE isfcav !!====================================================================== !! *** MODULE sbcisf *** !! Surface module : update surface ocean boundary condition under ice !! shelf !!====================================================================== !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav !! X.X ! 2006-02 (C. Wang ) Original code bg03 !! 3.4 ! 2013-03 (P. Mathiot) Merging + parametrization !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! sbc_isf : update sbc under ice shelf !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE isf ! USE isftbl ! USE isfcavmlt USE isfgammats USE isfdiags USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE eosbn2 ! equation of state USE zdfdrg ! vertical physics: top/bottom drag coef. ! USE in_out_manager ! I/O manager USE iom ! I/O library USE fldread ! read input field at current time step USE lbclnk ! IMPLICIT NONE PRIVATE PUBLIC isf_cav, isf_cav_init ! routine called in isfmlt !!---------------------------------------------------------------------- !! NEMO/OCE 4.0 , NEMO Consortium (2018) !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $ !! Software governed by the CeCILL license (see ./LICENSE) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE isf_cav( kt, ptsc, pqfwf ) !!--------------------------------------------------------------------- !! *** ROUTINE sbc_isf_cav *** !! !! ** Purpose : handle surface boundary condition under ice shelf !! !! ** Method : - !! !! ** Action : utau, vtau : remain unchanged !! taum, wndm : remain unchanged !! qns : update heat flux below ice shelf !! emp, emps : update freshwater flux below ice shelf !!--------------------------------------------------------------------- !!-------------------------- OUT -------------------------------------- REAL(wp), DIMENSION(jpi,jpj) , INTENT(inout) :: pqfwf REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc !!-------------------------- IN -------------------------------------- INTEGER, INTENT(in) :: kt ! ocean time step !!--------------------------------------------------------------------- LOGICAL :: lit INTEGER :: nit REAL(wp) :: zerr REAL(wp), DIMENSION(jpi,jpj) :: zqlat, zqoce, zqhc, zqh REAL(wp), DIMENSION(jpi,jpj) :: zqoce_b REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas REAL(wp), DIMENSION(jpi,jpj) :: zttbl, zstbl !!--------------------------------------------------------------------- ! ! compute misfkb_par, rhisf_tbl rhisf_tbl_cav(:,:) = rn_htbl CALL isf_tbl_lvl( ht_n, e3t_n, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) ! ! compute T/S/U/V for the top boundary layer CALL isf_tbl(tsn(:,:,:,jp_tem),zttbl(:,:),'T', misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) CALL isf_tbl(tsn(:,:,:,jp_sal),zstbl(:,:),'T', misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) ! ! output T/S/U/V for the top boundary layer CALL iom_put('ttbl_cav',zttbl(:,:)) CALL iom_put('stbl' ,zstbl(:,:)) ! ! initialisation IF (TRIM(cn_gammablk) == 'HJ99' ) zqoce_b (:,:) = ptsc(:,:,jp_tem) * rau0_rcp ! last time step total heat fluxes (to speed up convergence) ! ! compute ice shelf melting nit = 1 ; lit = .TRUE. DO WHILE ( lit ) ! maybe just a constant number of iteration as in blk_core is fine ! ! compute gammat every where (2d) ! useless if melt specified IF ( TRIM(cn_isfcav_mlt) .NE. 'spe' ) THEN CALL isfcav_gammats( zttbl, zstbl, zqoce , pqfwf, & & zgammat, zgammas ) END IF ! ! compute tfrz, latent heat and melt (2d) CALL isfcav_mlt(kt, zgammat, zgammas, zttbl, zstbl, & & zqhc , zqoce, pqfwf ) ! ! define if we need to iterate (nn_gammablk 0/1 do not need iteration) SELECT CASE ( cn_gammablk ) CASE ( 'spe','ad15' ) ! no convergence needed lit = .FALSE. CASE ( 'hj99' ) ! compute error between 2 iterations zerr = MAXVAL(ABS(zqoce(:,:) - zqoce_b(:,:))) ! ! define if iteration needed IF (nit >= 100) THEN ! too much iteration CALL ctl_stop( 'STOP', 'isf_cav: HJ99 gamma formulation had too many iterations ...' ) ELSE IF ( zerr <= 0.01_wp ) THEN ! convergence is achieve lit = .FALSE. ELSE ! converge is not yet achieve nit = nit + 1 zqoce_b(:,:) = zqoce(:,:) END IF END SELECT END DO ! ! compute heat and water flux (change signe directly in the melt subroutine) pqfwf(:,:) = pqfwf(:,:) * mskisf_cav(:,:) zqoce(:,:) = zqoce(:,:) * mskisf_cav(:,:) zqhc (:,:) = zqhc(:,:) * mskisf_cav(:,:) ! ! compute heat content flux zqlat(:,:) = - pqfwf(:,:) * rLfusisf ! 2d latent heat flux (W/m2) ( > 0 out ) ! ! total heat flux ( >0 out ) zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) ) ! ! lbclnk on melt CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.) ! ! output fluxes CALL isf_diags_flx( misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, 'cav', pqfwf, zqoce, zqlat, zqhc) ! ! set temperature content ptsc(:,:,jp_tem) = - zqh(:,:) * r1_rau0_rcp ! END SUBROUTINE isf_cav SUBROUTINE isf_cav_init !!--------------------------------------------------------------------- !! *** ROUTINE isf_diags_2dto3d *** !! !! ** Purpose : !! !!---------------------------------------------------------------------- INTEGER :: ierr !!--------------------------------------------------------------------- ! allocation isfcav gamtisf, gamsisf, CALL isf_alloc_cav() ! ! cav misfkt_cav(:,:) = mikt(:,:) ; misfkb_cav(:,:) = 1 rhisf_tbl_cav(:,:) = 0.0_wp ; rfrac_tbl_cav(:,:) = 0.0_wp ! SELECT CASE ( TRIM(cn_isfcav_mlt) ) CASE( 'spe' ) ALLOCATE( sf_isfcav_fwf(1), STAT=ierr ) ALLOCATE( sf_isfcav_fwf(1)%fnow(jpi,jpj,1), sf_isfcav_fwf(1)%fdta(jpi,jpj,1,2) ) CALL fld_fill( sf_isfcav_fwf, (/ sn_isfcav_fwf /), cn_dirisf, 'isf_cav_init', 'read fresh water flux isf data', 'namisf' ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' ==>> The ice shelf melt inside the cavity is read from forcing files' CASE( '2eq' ) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' ==>> The original ISOMIP melt formulation is used to compute melt under the ice shelves' CASE( '3eq' ) ! coeficient for linearisation of potential tfreez ! Crude approximation for pressure (but commonly used) IF ( l_useCT ) THEN ! linearisation from Jourdain et al. (2017) risf_lamb1 =-0.0564_wp risf_lamb2 = 0.0773_wp risf_lamb3 =-7.8633e-8 * grav * rau0 ELSE ! linearisation from table 4 (Asay-Davis et al., 2015) risf_lamb1 =-0.0573_wp risf_lamb2 = 0.0832_wp risf_lamb3 =-7.5300e-8 * grav * rau0 ENDIF IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' ==>> The 3 equations melt formulation is used to compute melt under the ice shelves' CASE DEFAULT CALL ctl_stop(' cn_isfcav_mlt method unknown (spe, 2eq, 3eq), check namelist') END SELECT ! END SUBROUTINE isf_cav_init END MODULE isfcav