MODULE icecor !!====================================================================== !! *** MODULE icecor *** !! LIM-3 : Update of sea-ice global variables at the end of the time step !!====================================================================== !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning !!---------------------------------------------------------------------- #if defined key_lim3 !!---------------------------------------------------------------------- !! 'key_lim3' LIM3 sea-ice model !!---------------------------------------------------------------------- !! ice_cor : computes update of sea-ice global variables from trend terms !!---------------------------------------------------------------------- USE dom_oce ! ocean domain USE phycst ! physical constants USE ice ! sea-ice: variable USE ice1D ! sea-ice: thermodynamic sea-ice variables USE iceitd ! sea-ice: rebining USE icevar ! sea-ice: operations USE icectl ! sea-ice: control prints ! USE in_out_manager ! I/O manager USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) USE lbclnk ! lateral boundary condition - MPP link USE lib_mpp ! MPP library USE timing ! Timing USE iom ! IMPLICIT NONE PRIVATE PUBLIC ice_cor ! called by icestp.F90 !! * Substitutions # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/ICE 4.0 , NEMO Consortium (2017) !! $Id: icecor.F90 8378 2017-07-26 13:55:59Z clem $ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE ice_cor( kt, kn ) !!---------------------------------------------------------------------- !! *** ROUTINE ice_cor *** !! !! ** Purpose : Computes corrections on sea-ice global variables at !! the end of the dynamics. !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! number of iteration INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo ! INTEGER :: ji, jj, jk, jl ! dummy loop indices REAL(wp) :: zsal, zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b, zzc REAL(wp), DIMENSION(jpi,jpj) :: zafx ! concentration trends diag !!---------------------------------------------------------------------- IF( nn_timing == 1 ) CALL timing_start('icecor') ! IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN WRITE(numout,*) WRITE(numout,*) 'ice_cor: correct sea ice variables if out of bounds ' WRITE(numout,*) '~~~~~~~' ENDIF ! !--- conservation test IF( ln_limdiachk ) CALL ice_cons_hsm(0, 'icecor', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) ! ! IF( kn == 2 ) THEN ! !----------------------------------------------------- ! ! thickness of the smallest category above himin ! ! !----------------------------------------------------- WHERE( a_i(:,:,1) >= epsi20 ) ; ht_i(:,:,1) = v_i (:,:,1) / a_i(:,:,1) ELSEWHERE ; ht_i(:,:,1) = 0._wp END WHERE WHERE( ht_i(:,:,1) < rn_himin ) a_i (:,:,1) = a_i (:,:,1) * ht_i(:,:,1) / rn_himin ! ENDIF ! !----------------------------------------------------- ! ! ice concentration should not exceed amax ! ! !----------------------------------------------------- at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) DO jl = 1, jpl WHERE( at_i(:,:) > rn_amax_2d(:,:) ) a_i(:,:,jl) = a_i(:,:,jl) * rn_amax_2d(:,:) / at_i(:,:) END DO ! !----------------------------------------------------- IF ( nn_icesal == 2 ) THEN ! salinity stays in bounds [Simin,Simax] ! ! !----------------------------------------------------- zzc = rhoic * r1_rdtice DO jl = 1, jpl DO jj = 1, jpj DO ji = 1, jpi zsal = smv_i(ji,jj,jl) smv_i(ji,jj,jl) = MIN( MAX( rn_simin*v_i(ji,jj,jl) , smv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl) ) sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * zzc ! associated salt flux END DO END DO END DO ENDIF ! !----------------------------------------------------- ! ! Rebin categories with thickness out of bounds ! ! !----------------------------------------------------- IF ( jpl > 1 ) CALL ice_itd_reb( kt ) ! !----------------------------------------------------- CALL ice_var_zapsmall ! Zap small values ! ! !----------------------------------------------------- ! !----------------------------------------------------- IF( kn == 2 ) THEN ! Ice drift case: Corrections to avoid wrong values ! DO jj = 2, jpjm1 !----------------------------------------------------- DO ji = 2, jpim1 IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj ) = 0._wp ! upper side IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side ENDIF END DO END DO CALL lbc_lnk_multi( u_ice, 'U', -1., v_ice, 'V', -1. ) ! lateral boundary conditions ENDIF !!gm I guess the trends are only out on demand !! So please, only do this is it exite an iom_use of on a these variables !! furthermore, only allocate the diag_ arrays in this case !! and do the iom_put here so that it is only a local allocation !!gm ! !----------------------------------------------------- SELECT CASE( kn ) ! Diagnostics ! ! !----------------------------------------------------- CASE( 1 ) !--- dyn trend diagnostics ! !!gm here I think the number of ice cat is too small to use a SUM instruction... DO jj = 1, jpj DO ji = 1, jpi ! ! heat content variation (W.m-2) diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) & & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice ! ! salt, volume diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice END DO END DO ! ! concentration tendency (dynamics) zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice afx_tot(:,:) = zafx(:,:) IF( iom_use('afxdyn') ) CALL iom_put( 'afxdyn' , zafx(:,:) ) ! CASE( 2 ) !--- thermo trend diagnostics & ice aging ! oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice ! ice natural aging incrementation ! !!gm here I think the number of ice cat is too small to use a SUM instruction... DO jj = 1, jpj DO ji = 1, jpi ! ! heat content variation (W.m-2) diag_heat(ji,jj) = diag_heat(ji,jj) - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) & & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice ! ! salt, volume diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice END DO END DO ! ! concentration tendency (total + thermo) zafx (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) IF( iom_use('afxthd') ) CALL iom_put( 'afxthd' , zafx(:,:) ) IF( iom_use('afxtot') ) CALL iom_put( 'afxtot' , afx_tot(:,:) ) ! END SELECT ! ! !--- conservation test IF( ln_limdiachk ) CALL ice_cons_hsm(1, 'icecor', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) ! ! !--- control prints IF( ln_ctl ) CALL ice_prt3D( 'icecor' ) IF( ln_limctl .AND. kn == 2 ) CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! IF( nn_timing == 1 ) CALL timing_stop('icecor') ! END SUBROUTINE ice_cor #else !!---------------------------------------------------------------------- !! Default option Dummy module NO LIM 3.0 sea-ice model !!---------------------------------------------------------------------- #endif !!====================================================================== END MODULE icecor