Changeset 5034 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
- Timestamp:
- 2015-01-15T14:48:42+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4614 r5034 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 33 32 USE sbc_oce ! Surface boundary condition: ocean fields 34 33 USE sbccpl 35 USE cpl_oasis3, ONLY : lk_cpl 36 USE oce , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 34 USE oce , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 37 35 USE albedo ! albedo parameters 38 36 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 43 41 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 42 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 43 USE iom 44 USE domvvl ! Variable volume 45 45 46 46 IMPLICIT NONE … … 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 (lk_cpl=T) 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 ! 105 INTEGER :: ji, jj, jl, jk ! dummy loop indices 106 ! 107 REAL(wp) :: zemp ! local scalars 108 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 109 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 110 ! 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace 114 112 !!--------------------------------------------------------------------- 115 116 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 117 118 !------------------------------------------! 119 ! heat flux at the ocean surface ! 120 !------------------------------------------! 113 114 ! make calls for heat fluxes before it is modified 115 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 116 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 117 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 118 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 119 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 120 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 121 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 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) ) 126 127 !------------------------------------------! 128 ! heat flux at the ocean surface ! 129 !------------------------------------------! 130 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 131 !--------------------------------------------------- 132 IF( lk_cpl ) THEN 133 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 134 zfcm1 = qsr_tot(ji,jj) 154 135 DO jl = 1, jpl 155 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl)136 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 156 137 END DO 157 138 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) ) 139 !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 140 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 141 DO jl = 1, jpl 142 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 143 END DO 160 144 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 145 146 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 147 !--------------------------------------------------- 148 zf_mass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 149 hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 150 151 ! New qsr and qns used to compute the oceanic heat flux at the next time step 152 !--------------------------------------------------- 153 qsr(ji,jj) = zfcm1 154 qns(ji,jj) = hfx_out(ji,jj) - zfcm1 155 156 !------------------------------------------! 157 ! mass flux at the ocean surface ! 158 !------------------------------------------! 202 159 ! case of realistic freshwater flux (Tartinville et al., 2001) (presently ACTIVATED) 203 160 ! ------------------------------------------------------------------------------------- … … 208 165 ! Even if i see Ice melting as a FW and SALT flux 209 166 ! 210 211 167 ! computing freshwater exchanges at the ice/ocean interface 212 IF (lk_cpl) THEN168 IF( lk_cpl ) THEN 213 169 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 214 & - rdm_snw(ji,jj) / rdt_ice170 & + wfx_snw(ji,jj) 215 171 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 172 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction 173 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean 174 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**betas ) ! except solid precip intercepted by sea-ice 220 175 ENDIF 221 176 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)177 ! mass flux from ice/ocean 178 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 179 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 180 181 ! mass flux at the ocean/ice interface 182 fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 183 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 229 184 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 185 END DO 234 186 END DO … … 237 189 ! salt flux at the ocean surface ! 238 190 !------------------------------------------! 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 191 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 192 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 193 194 !-------------------------------------------------------------! 195 ! mass of snow and ice per unit area for embedded sea-ice ! 196 !-------------------------------------------------------------! 197 IF( nn_ice_embd /= 0 ) THEN 198 ! save mass from the previous ice time step 199 snwice_mass_b(:,:) = snwice_mass(:,:) 200 ! new mass per unit area 251 201 snwice_mass (:,:) = tms(:,:) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:) ) 252 ! !time evolution of snow+ice mass202 ! time evolution of snow+ice mass 253 203 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 254 204 ENDIF … … 261 211 262 212 !------------------------------------------------! 263 ! Computation of snow/ice and ocean albedo!213 ! Snow/ice albedo (only if sent to coupler) ! 264 214 !------------------------------------------------! 265 215 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 216 217 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 218 219 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 220 221 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 222 223 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 224 225 ENDIF 226 270 227 271 228 IF(ln_ctl) THEN … … 275 232 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 276 233 ENDIF 277 ! 278 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 279 ! 234 280 235 END SUBROUTINE lim_sbc_flx 281 236 … … 390 345 ! clem modif 391 346 IF( .NOT. ln_rstart ) THEN 392 iatte(:,:) = 1._wp 393 oatte(:,:) = 1._wp 347 fraqsr_1lev(:,:) = 1._wp 394 348 ENDIF 395 349 !
Note: See TracChangeset
for help on using the changeset viewer.