[8426] | 1 | MODULE icecor |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE icecor *** |
---|
| 4 | !! LIM-3 : Update of sea-ice global variables at the end of the time step |
---|
| 5 | !!====================================================================== |
---|
| 6 | !! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code |
---|
| 7 | !! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning |
---|
| 8 | !!---------------------------------------------------------------------- |
---|
| 9 | #if defined key_lim3 |
---|
| 10 | !!---------------------------------------------------------------------- |
---|
[8486] | 11 | !! 'key_lim3' LIM3 sea-ice model |
---|
[8426] | 12 | !!---------------------------------------------------------------------- |
---|
[8486] | 13 | !! ice_cor : computes update of sea-ice global variables from trend terms |
---|
[8426] | 14 | !!---------------------------------------------------------------------- |
---|
[8486] | 15 | USE dom_oce ! ocean domain |
---|
| 16 | USE phycst ! physical constants |
---|
| 17 | USE ice ! sea-ice: variable |
---|
| 18 | USE ice1D ! sea-ice: thermodynamic sea-ice variables |
---|
| 19 | USE iceitd ! sea-ice: rebining |
---|
| 20 | USE icevar ! sea-ice: operations |
---|
| 21 | USE icectl ! sea-ice: control prints |
---|
[8426] | 22 | ! |
---|
[8486] | 23 | USE in_out_manager ! I/O manager |
---|
| 24 | USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) |
---|
| 25 | USE lbclnk ! lateral boundary condition - MPP link |
---|
| 26 | USE lib_mpp ! MPP library |
---|
| 27 | USE timing ! Timing |
---|
[8426] | 28 | |
---|
| 29 | IMPLICIT NONE |
---|
| 30 | PRIVATE |
---|
| 31 | |
---|
[8486] | 32 | PUBLIC ice_cor ! called by icestp.F90 |
---|
[8426] | 33 | |
---|
| 34 | !! * Substitutions |
---|
| 35 | # include "vectopt_loop_substitute.h90" |
---|
| 36 | !!---------------------------------------------------------------------- |
---|
[8486] | 37 | !! NEMO/ICE 4.0 , NEMO Consortium (2017) |
---|
[8426] | 38 | !! $Id: icecor.F90 8378 2017-07-26 13:55:59Z clem $ |
---|
| 39 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
| 40 | !!---------------------------------------------------------------------- |
---|
| 41 | CONTAINS |
---|
| 42 | |
---|
[8486] | 43 | SUBROUTINE ice_cor( kt, kn ) |
---|
| 44 | !!---------------------------------------------------------------------- |
---|
[8426] | 45 | !! *** ROUTINE ice_cor *** |
---|
| 46 | !! |
---|
[8486] | 47 | !! ** Purpose : Computes corrections on sea-ice global variables at |
---|
| 48 | !! the end of the dynamics. |
---|
| 49 | !!---------------------------------------------------------------------- |
---|
[8426] | 50 | INTEGER, INTENT(in) :: kt ! number of iteration |
---|
| 51 | INTEGER, INTENT(in) :: kn ! 1 = after dyn ; 2 = after thermo |
---|
[8486] | 52 | ! |
---|
[8426] | 53 | INTEGER :: ji, jj, jk, jl ! dummy loop indices |
---|
[8486] | 54 | REAL(wp) :: zsal, zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b, zzc |
---|
| 55 | !!---------------------------------------------------------------------- |
---|
| 56 | IF( nn_timing == 1 ) CALL timing_start('icecor') |
---|
| 57 | ! |
---|
[8426] | 58 | IF( kt == nit000 .AND. lwp .AND. kn == 2 ) THEN |
---|
| 59 | WRITE(numout,*) |
---|
[8486] | 60 | WRITE(numout,*)' icecor : correct sea ice variables if out of bounds ' |
---|
| 61 | WRITE(numout,*)' ~~~~~~~' |
---|
[8426] | 62 | ENDIF |
---|
[8486] | 63 | ! !--- conservation test |
---|
| 64 | IF( ln_limdiachk ) CALL ice_cons_hsm(0, 'icecor', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) |
---|
| 65 | ! |
---|
| 66 | ! |
---|
| 67 | ! !----------------------------------------------------- |
---|
| 68 | IF( kn == 2 ) THEN ! thickness of the smallest category above himin ! |
---|
| 69 | ! !----------------------------------------------------- |
---|
| 70 | ! |
---|
[8426] | 71 | DO jj = 1, jpj |
---|
| 72 | DO ji = 1, jpi |
---|
[8486] | 73 | !!gm replace this |
---|
[8426] | 74 | rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) ) !0 if no ice and 1 if yes |
---|
| 75 | ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch |
---|
[8486] | 76 | !!gm by more readable coding (not slower coding since already a IF in the loop): |
---|
| 77 | ! IF( a_i(ji,jj,1) >= epsi20 ) ht_i(ji,jj,1) = v_i (ji,jj,1) / a_i(ji,jj,1) |
---|
| 78 | !!gm |
---|
[8426] | 79 | IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN |
---|
| 80 | a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin |
---|
| 81 | ENDIF |
---|
| 82 | END DO |
---|
| 83 | END DO |
---|
[8486] | 84 | ! |
---|
| 85 | ENDIF |
---|
[8426] | 86 | |
---|
[8486] | 87 | ! !----------------------------------------------------- |
---|
| 88 | at_i(:,:) = a_i(:,:,1) ! ice concentration should not exceed amax ! |
---|
| 89 | DO jl = 2, jpl !----------------------------------------------------- |
---|
[8426] | 90 | at_i(:,:) = a_i(:,:,jl) + at_i(:,:) |
---|
| 91 | END DO |
---|
[8486] | 92 | ! |
---|
| 93 | !!gm Question it seams to me that we have the following equality (dropping the "(ji,jj)": |
---|
| 94 | ! ( 1. - ( 1. - rn_amax_2d / at_i ) ) = ( 1. - ( at_i - rn_amax_2d ) / at_i ) |
---|
| 95 | ! = ( at_i - ( at_i - rn_amax_2d ) ) / at_i |
---|
| 96 | ! = ( + rn_amax_2d ) / at_i |
---|
| 97 | ! = rn_amax_2d / at_i |
---|
| 98 | ! No ? if yes see "!!gm better" juste below |
---|
| 99 | !gm |
---|
[8426] | 100 | DO jl = 1, jpl |
---|
| 101 | DO jj = 1, jpj |
---|
| 102 | DO ji = 1, jpi |
---|
| 103 | IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN |
---|
[8486] | 104 | a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) ) |
---|
| 105 | !!gm better: a_i(ji,jj,jl) = a_i(ji,jj,jl) * rn_amax_2d(ji,jj) / at_i(ji,jj) |
---|
[8426] | 106 | ENDIF |
---|
| 107 | END DO |
---|
| 108 | END DO |
---|
| 109 | END DO |
---|
[8486] | 110 | !!gm Other question: why testing a_i(ji,jj,jl) > 0._wp ? a_i is >=0, a multiplication by 0 does not change the results.... |
---|
| 111 | !!gm so at the end, the loop can be recoded without IF as: |
---|
| 112 | ! WHERE( at_i(:,:) > rn_amax_2d(:,:) ) |
---|
| 113 | ! DO jl = 1, jpl |
---|
| 114 | ! a_i(:,:,jl) = a_i(:,:,jl) * MAX( rn_amax_2d(:,:), at_i(:,:) ) / at_i(:,:) |
---|
| 115 | ! END DO |
---|
| 116 | ! END WHERE |
---|
| 117 | !!gm No? |
---|
[8426] | 118 | |
---|
[8486] | 119 | ! !----------------------------------------------------- |
---|
| 120 | IF ( nn_icesal == 2 ) THEN ! Ice salinity bounds ! |
---|
| 121 | ! !----------------------------------------------------- |
---|
| 122 | zzc = rhoic * r1_rdtice |
---|
| 123 | DO jl = 1, jpl ! salinity stays in bounds [Simin,Simax] |
---|
[8426] | 124 | DO jj = 1, jpj |
---|
| 125 | DO ji = 1, jpi |
---|
[8486] | 126 | zsal = smv_i(ji,jj,jl) |
---|
| 127 | 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) ) |
---|
[8426] | 128 | ! associated salt flux |
---|
[8486] | 129 | sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * zzc |
---|
[8426] | 130 | END DO |
---|
| 131 | END DO |
---|
| 132 | END DO |
---|
| 133 | ENDIF |
---|
| 134 | |
---|
[8486] | 135 | ! !----------------------------------------------------- |
---|
| 136 | ! ! Rebin categories with thickness out of bounds ! |
---|
| 137 | ! !----------------------------------------------------- |
---|
| 138 | IF ( jpl > 1 ) CALL ice_itd_reb |
---|
[8426] | 139 | |
---|
[8486] | 140 | ! !----------------------------------------------------- |
---|
| 141 | CALL ice_var_zapsmall ! Zap small values ! |
---|
| 142 | ! !----------------------------------------------------- |
---|
[8426] | 143 | |
---|
[8486] | 144 | ! !----------------------------------------------------- |
---|
| 145 | IF( kn == 2 ) THEN ! Ice drift case: Corrections to avoid wrong values ! |
---|
| 146 | DO jj = 2, jpjm1 !----------------------------------------------------- |
---|
[8426] | 147 | DO ji = 2, jpim1 |
---|
[8486] | 148 | IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice |
---|
| 149 | IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji ,jj) = 0._wp ! right side |
---|
| 150 | IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side |
---|
| 151 | IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj ) = 0._wp ! upper side |
---|
| 152 | IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side |
---|
[8426] | 153 | ENDIF |
---|
| 154 | END DO |
---|
| 155 | END DO |
---|
[8486] | 156 | CALL lbc_lnk_multi( u_ice, 'U', -1., v_ice, 'V', -1. ) ! lateral boundary conditions |
---|
| 157 | ! |
---|
| 158 | !!gm I think masking here is unnecessary, u_ice already masked and we only introduce zeros in the field |
---|
| 159 | u_ice(:,:) = u_ice(:,:) * umask(:,:,1) ! mask velocities |
---|
[8426] | 160 | v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) |
---|
| 161 | ENDIF |
---|
[8486] | 162 | |
---|
| 163 | !!gm I guess the trends are only out on demand |
---|
| 164 | !! So please, only do this is it exite an iom_use of on a these variables |
---|
| 165 | !! furthermore, only allocate the diag_ arrays in this case |
---|
| 166 | !! and do the iom_put here so that it is only a local allocation |
---|
| 167 | !!gm |
---|
| 168 | ! !----------------------------------------------------- |
---|
| 169 | SELECT CASE( kn ) ! Diagnostics ! |
---|
| 170 | ! !----------------------------------------------------- |
---|
| 171 | CASE( 1 ) !--- dyn trend diagnostics |
---|
[8426] | 172 | DO jl = 1, jpl |
---|
| 173 | afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice |
---|
| 174 | END DO |
---|
[8486] | 175 | ! |
---|
| 176 | !!gm here I think the number of ice cat is too small to use a SUM instruction... |
---|
[8426] | 177 | DO jj = 1, jpj |
---|
| 178 | DO ji = 1, jpi |
---|
[8486] | 179 | ! ! heat content variation (W.m-2) |
---|
| 180 | diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) & |
---|
| 181 | & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice |
---|
| 182 | ! ! salt, volume |
---|
[8426] | 183 | diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice |
---|
| 184 | diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice |
---|
| 185 | diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice |
---|
| 186 | END DO |
---|
| 187 | END DO |
---|
[8486] | 188 | ! |
---|
| 189 | CASE( 2 ) !--- thermo trend diagnostics & ice aging |
---|
| 190 | ! |
---|
[8426] | 191 | DO jl = 1, jpl |
---|
[8486] | 192 | oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice ! ice natural aging incrementation |
---|
| 193 | afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice ! thermo tendancy |
---|
[8426] | 194 | END DO |
---|
[8486] | 195 | afx_tot(:,:) = afx_thd(:,:) + afx_dyn(:,:) |
---|
| 196 | ! |
---|
| 197 | !!gm here I think the number of ice cat is too small to use a SUM instruction... |
---|
[8426] | 198 | DO jj = 1, jpj |
---|
| 199 | DO ji = 1, jpi |
---|
[8486] | 200 | ! ! heat content variation (W.m-2) |
---|
| 201 | diag_heat(ji,jj) = diag_heat(ji,jj) - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) & |
---|
| 202 | & + SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) ) * r1_rdtice |
---|
| 203 | ! ! salt, volume |
---|
[8426] | 204 | diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice |
---|
| 205 | diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice |
---|
| 206 | diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice |
---|
| 207 | END DO |
---|
| 208 | END DO |
---|
[8486] | 209 | ! |
---|
| 210 | END SELECT |
---|
| 211 | ! |
---|
| 212 | ! !--- conservation test |
---|
| 213 | IF( ln_limdiachk ) CALL ice_cons_hsm(1, 'icecor', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) |
---|
| 214 | ! |
---|
| 215 | ! !--- control prints |
---|
| 216 | IF( ln_ctl ) CALL ice_prt3D( 'icecor' ) |
---|
| 217 | IF( ln_limctl .AND. kn == 2 ) CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) |
---|
| 218 | ! |
---|
| 219 | IF( nn_timing == 1 ) CALL timing_stop('icecor') |
---|
| 220 | ! |
---|
[8426] | 221 | END SUBROUTINE ice_cor |
---|
| 222 | |
---|
[8486] | 223 | #else |
---|
| 224 | !!---------------------------------------------------------------------- |
---|
| 225 | !! Default option Dummy module NO LIM 3.0 sea-ice model |
---|
| 226 | !!---------------------------------------------------------------------- |
---|
[8426] | 227 | #endif |
---|
| 228 | |
---|
[8486] | 229 | !!====================================================================== |
---|
[8426] | 230 | END MODULE icecor |
---|