- Timestamp:
- 2014-11-28T18:24:01+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4614 r4924 27 27 USE par_ice ! ice parameters 28 28 USE dom_oce ! ocean domain 29 USE domvvl ! ocean vertical scale factors 30 USE dom_ice, ONLY : tms 29 USE dom_ice, ONLY : tms, area 31 30 USE ice ! LIM sea-ice variables 32 31 USE sbc_ice ! Surface boundary condition: sea-ice fields … … 43 42 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 43 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 44 USE iom 45 USE domvvl ! Variable volume 45 46 46 47 IMPLICIT NONE … … 51 52 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 52 53 53 REAL(wp) :: rzero = 0._wp54 REAL(wp) :: rone = 1._wp54 REAL(wp) :: epsi10 = 1.e-10 ! 55 REAL(wp) :: epsi20 = 1.e-20 ! 55 56 56 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] … … 104 105 INTEGER, INTENT(in) :: kt ! number of iteration 105 106 ! 106 INTEGER :: ji, jj, jl ! dummy loop indices 107 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 108 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - 109 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 110 REAL(wp) :: zemp_snw ! - - 111 REAL(wp) :: zfcm1 , zfcm2 ! - - 107 INTEGER :: ji, jj, jl, jk ! dummy loop indices 108 REAL(wp) :: zinda, zemp ! local scalars 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 112 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 113 REAL(wp) :: zzfcm1, zfscmbq ! clem: for light penetration114 112 !!--------------------------------------------------------------------- 115 113 116 114 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 117 115 118 !------------------------------------------! 119 ! heat flux at the ocean surface ! 120 !------------------------------------------! 116 ! make calls for heat fluxes before it is modified 117 CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 118 CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 119 CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 120 CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 121 CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 122 CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 123 CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 124 121 125 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) 122 ! changed to old_frld and old ht_i123 124 126 DO jj = 1, jpj 125 127 DO ji = 1, jpi 126 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 127 ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) ) !subscripts are bad here 128 i1mfr = 1.0 - MAX( rzero , SIGN( rone , - at_i(ji,jj) ) ) 129 idfr = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 130 iflt = zinda * (1 - i1mfr) * (1 - ifvt ) 131 ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 132 iadv = ( 1 - i1mfr ) * zinda 133 ifral = ( 1 - i1mfr * ( 1 - ial ) ) 134 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 135 136 ! switch --- 1.0 ---------------- 0.0 -------------------- 137 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 138 ! zinda | if pfrld = 1 | if pfrld < 1 | 139 ! -> ifvt| if pfrld old_ht_i 140 ! i1mfr | if frld = 1 | if frld < 1 | 141 ! idfr | if frld <= pfrld | if frld > pfrld | 142 ! iflt | 143 ! ial | 144 ! iadv | 145 ! ifral 146 ! ifrdv 147 148 ! computation the solar flux at ocean surface 149 IF (lk_cpl) THEN ! be carfeful: not been tested yet 128 129 !------------------------------------------! 130 ! heat flux at the ocean surface ! 131 !------------------------------------------! 132 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice 133 134 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 135 !--------------------------------------------------- 136 IF( lk_cpl ) THEN ! be carfeful: not been tested yet 150 137 ! original line 151 !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 152 ! new line to include solar penetration (not tested) 153 zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 138 zfcm1 = qsr_tot(ji,jj) 139 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 154 140 DO jl = 1, jpl 155 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl)141 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 156 142 END DO 157 143 ELSE 158 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 159 & ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 144 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 145 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 146 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 147 DO jl = 1, jpl 148 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 149 END DO 160 150 ENDIF 161 ! fstric Solar flux transmitted trough the ice 162 ! qsr Net short wave heat flux on free ocean 163 ! new line 164 fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 165 166 ! solar flux and fscmbq with light penetration (clem) 167 zzfcm1 = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 168 zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 169 170 ! computation the non solar heat flux at ocean surface 171 zfcm2 = - zzfcm1 & ! 172 & + iflt * zfscmbq & ! total ablation: heat given to the ocean 173 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 174 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 175 & + fhmec(ji,jj) & ! snow melt when ridging 176 & + fheat_mec(ji,jj) & ! ridge formation 177 & + fheat_res(ji,jj) ! residual heat flux 178 ! qcmif Energy needed to bring the ocean surface layer until its freezing (ok) 179 ! qldif heat balance of the lead (or of the open ocean) 180 ! qfvbq latent heat uptake/release after accretion/ablation 181 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 182 183 IF( num_sal == 2 ) zfcm2 = zfcm2 + fhbri(ji,jj) ! add contribution due to brine drainage 184 185 ! bottom radiative component is sent to the computation of the oceanic heat flux 186 fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj) 187 188 ! used to compute the oceanic heat flux at the next time step 189 qsr(ji,jj) = zfcm1 ! solar heat flux 190 qns(ji,jj) = zfcm2 - fdtcn(ji,jj) ! non solar heat flux 191 ! ! fdtcn : turbulent oceanic heat flux 192 END DO 193 END DO 194 195 !------------------------------------------! 196 ! mass flux at the ocean surface ! 197 !------------------------------------------! 198 199 !!gm optimisation: this loop have to be merged with the previous one 200 DO jj = 1, jpj 201 DO ji = 1, jpi 151 152 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 153 !--------------------------------------------------- 154 zf_mass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 155 hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 156 157 ! New qsr and qns used to compute the oceanic heat flux at the next time step 158 !--------------------------------------------------- 159 qsr(ji,jj) = zfcm1 160 qns(ji,jj) = hfx_out(ji,jj) - zfcm1 161 162 !------------------------------------------! 163 ! mass flux at the ocean surface ! 164 !------------------------------------------! 202 165 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 203 166 ! ------------------------------------------------------------------------------------- … … 208 171 ! Even if i see Ice melting as a FW and SALT flux 209 172 ! 210 211 173 ! computing freshwater exchanges at the ice/ocean interface 212 IF (lk_cpl) THEN174 IF( lk_cpl ) THEN 213 175 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 214 & - rdm_snw(ji,jj) / rdt_ice176 & + wfx_snw(ji,jj) 215 177 ELSE 216 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 217 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 218 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 219 & - fmmec(ji,jj) ! snow falling when ridging 178 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction 179 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean 180 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas ) ! except solid precip intercepted by sea-ice 220 181 ENDIF 221 182 222 ! mass flux at the ocean/ice interface (sea ice fraction)223 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean224 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus melting225 226 fmmflx(ji,jj) = zfmm ! F/M mass flux save at least for biogeochemical model227 228 emp(ji,jj) = zemp + zemp_snw + zfmm! mass flux + F/M mass flux (always ice/ocean mass exchange)183 ! mass flux from ice/ocean 184 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 185 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 186 187 ! mass flux at the ocean/ice interface 188 fmmflx(ji,jj) = - wfx_ice(ji,jj) * rdt_ice ! F/M mass flux save at least for biogeochemical model 189 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 229 190 230 ! correcting brine salt fluxes (zinda = 1 if pfrld=1 , =0 otherwise)231 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )232 sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj)233 191 END DO 234 192 END DO … … 237 195 ! salt flux at the ocean surface ! 238 196 !------------------------------------------! 239 240 IF( num_sal == 2 ) THEN ! variable ice salinity: brine drainage included in the salt flux 241 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 242 ELSE ! constant ice salinity: 243 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 244 ENDIF 245 !-----------------------------------------------! 246 ! mass of snow and ice per unit area ! 247 !-----------------------------------------------! 248 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 249 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 250 ! ! new mass per unit area 197 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 198 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 199 200 !-------------------------------------------------------------! 201 ! mass of snow and ice per unit area for embedded sea-ice ! 202 !-------------------------------------------------------------! 203 IF( nn_ice_embd /= 0 ) THEN 204 ! save mass from the previous ice time step 205 snwice_mass_b(:,:) = snwice_mass(:,:) 206 ! new mass per unit area 251 207 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 252 ! !time evolution of snow+ice mass208 ! time evolution of snow+ice mass 253 209 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 254 210 ENDIF … … 265 221 IF( lk_cpl ) THEN ! coupled case 266 222 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 267 !268 223 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 269 224 ENDIF 225 270 226 271 227 IF(ln_ctl) THEN
Note: See TracChangeset
for help on using the changeset viewer.