Changeset 5837 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
- Timestamp:
- 2015-10-26T15:59:39+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4614 r5837 25 25 USE par_oce ! ocean parameters 26 26 USE phycst ! physical constants 27 USE par_ice ! ice parameters28 27 USE dom_oce ! ocean domain 29 USE domvvl ! ocean vertical scale factors30 USE dom_ice, ONLY : tms31 28 USE ice ! LIM sea-ice variables 32 29 USE sbc_ice ! Surface boundary condition: sea-ice fields 33 30 USE sbc_oce ! Surface boundary condition: ocean fields 34 31 USE sbccpl 35 USE cpl_oasis3, ONLY : lk_cpl 36 USE oce , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 37 33 USE albedo ! albedo parameters 38 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 42 38 USE prtctl ! Print control 43 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 40 USE traqsr ! add penetration of solar flux in the calculation of heat budget 41 USE iom 42 USE domvvl ! Variable volume 43 USE limctl 44 USE limcons 45 45 46 46 IMPLICIT NONE 47 47 PRIVATE 48 48 49 PUBLIC lim_sbc_init ! called by ice_init49 PUBLIC lim_sbc_init ! called by sbc_lim_init 50 50 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 51 51 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 52 53 REAL(wp) :: rzero = 0._wp54 REAL(wp) :: rone = 1._wp55 52 56 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] … … 97 94 !! - fr_i : ice fraction 98 95 !! - tn_ice : sea-ice surface temperature 99 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)96 !! - alb_ice : sea-ice albedo (only useful in coupled mode) 100 97 !! 101 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 102 99 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 100 !! These refs are now obsolete since everything has been revised 101 !! The ref should be Rousset et al., 2015 103 102 !!--------------------------------------------------------------------- 104 INTEGER, INTENT(in) :: kt ! number of iteration 105 ! 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 ! - - 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 113 REAL(wp) :: zzfcm1, zfscmbq ! clem: for light penetration 103 INTEGER, INTENT(in) :: kt ! number of iteration 104 INTEGER :: ji, jj, jl, jk ! dummy loop indices 105 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 106 REAL(wp) :: zqsr ! New solar flux received by the ocean 107 ! 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace 114 109 !!--------------------------------------------------------------------- 115 116 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 117 118 !------------------------------------------! 119 ! heat flux at the ocean surface ! 120 !------------------------------------------! 110 111 ! make calls for heat fluxes before it is modified 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 113 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 114 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 115 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface 116 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 117 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 118 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 119 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 120 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 121 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 122 121 123 ! 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 124 DO jj = 1, jpj 125 125 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 150 ! 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) ) 154 DO jl = 1, jpl 155 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 156 END DO 157 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) ) 160 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 126 127 !------------------------------------------! 128 ! heat flux at the ocean surface ! 129 !------------------------------------------! 130 ! Solar heat flux reaching the ocean = zqsr (W.m-2) 131 !--------------------------------------------------- 132 zqsr = qsr_tot(ji,jj) 133 DO jl = 1, jpl 134 zqsr = zqsr - a_i_b(ji,jj,jl) * ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 135 END DO 136 137 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 138 !--------------------------------------------------- 139 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 140 hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 141 142 ! Add the residual from heat diffusion equation (W.m-2) 143 !------------------------------------------------------- 144 hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 145 146 ! New qsr and qns used to compute the oceanic heat flux at the next time step 147 !--------------------------------------------------- 148 qsr(ji,jj) = zqsr 149 qns(ji,jj) = hfx_out(ji,jj) - zqsr 150 151 !------------------------------------------! 152 ! mass flux at the ocean surface ! 153 !------------------------------------------! 202 154 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 203 155 ! ------------------------------------------------------------------------------------- … … 208 160 ! Even if i see Ice melting as a FW and SALT flux 209 161 ! 210 211 ! computing freshwater exchanges at the ice/ocean interface 212 IF (lk_cpl) THEN 213 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 214 & - rdm_snw(ji,jj) / rdt_ice 215 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 220 ENDIF 221 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 ocean 224 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus melting 225 226 fmmflx(ji,jj) = zfmm ! F/M mass flux save at least for biogeochemical model 227 228 emp(ji,jj) = zemp + zemp_snw + zfmm ! mass flux + F/M mass flux (always ice/ocean mass exchange) 162 ! mass flux from ice/ocean 163 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 164 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 165 166 ! mass flux at the ocean/ice interface 167 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 168 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 229 169 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 170 END DO 234 171 END DO … … 237 174 ! salt flux at the ocean surface ! 238 175 !------------------------------------------! 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 251 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 252 ! ! time evolution of snow+ice mass 176 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 177 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 178 179 !-------------------------------------------------------------! 180 ! mass of snow and ice per unit area for embedded sea-ice ! 181 !-------------------------------------------------------------! 182 IF( nn_ice_embd /= 0 ) THEN 183 ! save mass from the previous ice time step 184 snwice_mass_b(:,:) = snwice_mass(:,:) 185 ! new mass per unit area 186 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 187 ! time evolution of snow+ice mass 253 188 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 254 189 ENDIF … … 260 195 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 261 196 262 !------------------------------------------------! 263 ! Computation of snow/ice and ocean albedo ! 264 !------------------------------------------------! 265 IF( lk_cpl ) THEN ! coupled case 266 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 267 ! 268 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 269 ENDIF 197 !------------------------------------------------------------------------! 198 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 199 !------------------------------------------------------------------------! 200 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 201 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 202 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 203 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 204 205 ! conservation test 206 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 207 208 ! control prints 209 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 270 210 271 211 IF(ln_ctl) THEN … … 275 215 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 276 216 ENDIF 277 ! 278 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 279 ! 217 280 218 END SUBROUTINE lim_sbc_flx 281 219 … … 315 253 ! 316 254 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step) 317 !CDIR NOVERRCHK318 255 DO jj = 2, jpjm1 !* update the modulus of stress at ocean surface (T-point) 319 !CDIR NOVERRCHK320 256 DO ji = fs_2, fs_jpim1 321 257 ! ! 2*(U_ice-U_oce) at T-point … … 367 303 !! ** input : Namelist namicedia 368 304 !!------------------------------------------------------------------- 369 REAL(wp) :: zsum, zarea370 !371 305 INTEGER :: ji, jj, jk ! dummy loop indices 372 306 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar … … 388 322 END WHERE 389 323 ENDIF 390 ! clem modif 391 IF( .NOT. ln_rstart ) THEN 392 iatte(:,:) = 1._wp 393 oatte(:,:) = 1._wp 394 ENDIF 395 ! 396 ! clem: snwice_mass in the restart file now 324 ! 397 325 IF( .NOT. ln_rstart ) THEN 398 326 ! ! embedded sea ice 399 327 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 400 snwice_mass (:,:) = tm s(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) )328 snwice_mass (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 401 329 snwice_mass_b(:,:) = snwice_mass(:,:) 402 330 ELSE
Note: See TracChangeset
for help on using the changeset viewer.