Changeset 2135 for branches/devmercator2010_1/NEMO/LIM_SRC_2/limsbc_2.F90
- Timestamp:
- 2010-09-29T19:31:33+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/devmercator2010_1/NEMO/LIM_SRC_2/limsbc_2.F90
r1756 r2135 4 4 !! computation of the flux at the sea ice/ocean interface 5 5 !!====================================================================== 6 !! History : 00-01 (H. Goosse) Original code 7 !! 02-07 (C. Ethe, G. Madec) re-writing F90 8 !! 06-07 (G. Madec) surface module 6 !! History : LIM ! 2000-01 (H. Goosse) Original code 7 !! 1.0 ! 2002-07 (C. Ethe, G. Madec) re-writing F90 8 !! 3.0 ! 2006-07 (G. Madec) surface module 9 !! 3.3 ! 2009-05 (G.Garric, C. Bricaud) addition of the lim2_evp case 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim2 11 12 !!---------------------------------------------------------------------- 12 13 !! 'key_lim2' LIM 2.0 sea-ice model 13 !!----------------------------------------------------------------------14 14 !!---------------------------------------------------------------------- 15 15 !! lim_sbc_2 : flux at the ice / ocean interface … … 17 17 USE par_oce ! ocean parameters 18 18 USE dom_oce ! ocean domain 19 USE sbc_ice ! surface boundary condition 20 USE sbc_oce ! surface boundary condition 19 USE sbc_ice ! surface boundary condition: ice 20 USE sbc_oce ! surface boundary condition: ocean 21 21 USE phycst ! physical constants 22 USE ice_2 ! LIM sea-ice variables23 24 USE lbclnk ! ocean lateral boundary condition 22 USE ice_2 ! LIM2: ice variables 23 24 USE lbclnk ! ocean lateral boundary condition - MPP exchanges 25 25 USE in_out_manager ! I/O manager 26 26 USE diaar5, ONLY : lk_diaar5 27 USE iom ! 27 USE iom ! IOM library 28 28 USE albedo ! albedo parameters 29 29 USE prtctl ! Print control … … 33 33 PRIVATE 34 34 35 PUBLIC lim_sbc_2 ! called by sbc_ice_lim_2 36 37 REAL(wp) :: epsi16 = 1.e-16 ! constant values 38 REAL(wp) :: rzero = 0.e0 39 REAL(wp) :: rone = 1.e0 40 REAL(wp), DIMENSION(jpi,jpj) :: soce_r 41 REAL(wp), DIMENSION(jpi,jpj) :: sice_r 35 PUBLIC lim_sbc_2 ! called by sbc_ice_lim_2 36 37 REAL(wp) :: r1_rdtice ! constant values 38 REAL(wp) :: epsi16 = 1.e-16 ! - - 39 REAL(wp) :: rzero = 0.e0 ! - - 40 REAL(wp) :: rone = 1.e0 ! - - 41 ! 42 REAL(wp), DIMENSION(jpi,jpj) :: soce_r, sice_r ! constant SSS and ice salinity used in levitating sea-ice case 42 43 43 44 !! * Substitutions 44 45 # include "vectopt_loop_substitute.h90" 45 46 !!---------------------------------------------------------------------- 46 !! LIM 2.0, UCL-LOCEAN-IPSL (2006)47 !! NEMO/LIM2 3.3, UCL-LOCEAN-IPSL (2010) 47 48 !! $Id$ 48 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 50 !!---------------------------------------------------------------------- 50 51 51 CONTAINS 52 52 … … 78 78 !! 79 79 INTEGER :: ji, jj ! dummy loop indices 80 INTEGER :: ifvt, i1mfr, idfr ! some switches 81 INTEGER :: iflt, ial, iadv, ifral, ifrdv 82 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 83 REAL(wp) :: zrdtir ! 1. / rdt_ice 84 REAL(wp) :: zqsr , zqns ! solar & non solar heat flux 85 REAL(wp) :: zinda ! switch for testing the values of ice concentration 86 REAL(wp) :: zfons ! salt exchanges at the ice/ocean interface 87 REAL(wp) :: zemp ! freshwater exchanges at the ice/ocean interface 88 REAL(wp) :: zfrldu, zfrldv ! lead fraction at U- & V-points 89 REAL(wp) :: zutau , zvtau ! lead fraction at U- & V-points 90 REAL(wp) :: zu_io , zv_io ! 2 components of the ice-ocean velocity 91 ! interface 2D --> 3D 92 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb ! albedo of ice under overcast sky 93 REAL(wp), DIMENSION(jpi,jpj,1) :: zalbp ! albedo of ice under clear sky 94 REAL(wp) :: zsang, zmod, zztmp, zfm 95 REAL(wp), DIMENSION(jpi,jpj) :: ztio_u, ztio_v ! component of ocean stress below sea-ice at I-point 96 REAL(wp), DIMENSION(jpi,jpj) :: ztiomi ! module of ocean stress below sea-ice at I-point 97 REAL(wp), DIMENSION(jpi,jpj) :: zqnsoce ! save qns before its modification by ice model 98 80 INTEGER :: ii0, ii1, ij0, ij1 ! local integers 81 INTEGER :: ifvt, i1mfr, idfr, iflt ! - - 82 INTEGER :: ial, iadv, ifral, ifrdv ! - - 83 REAL(wp) :: zqsr, zqns, zsang, zmod, zfm ! local scalars 84 REAL(wp) :: zinda, zfons, zemp, zztmp ! - - 85 REAL(wp) :: zfrldu, zutau, zu_io ! - - 86 REAL(wp) :: zfrldv, zvtau, zv_io ! - - 87 REAL(wp), DIMENSION(jpi,jpj) :: ztio_u, ztio_v ! 2D workspace 88 REAL(wp), DIMENSION(jpi,jpj) :: ztiomi, zqnsoce ! - - 89 REAL(wp), DIMENSION(jpi,jpj,1) :: zalb, zalbp ! 2D/3D workspace 99 90 !!--------------------------------------------------------------------- 100 91 101 zrdtir = 1. / rdt_ice102 92 103 93 IF( kt == nit000 ) THEN … … 105 95 IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice - surface boundary condition' 106 96 IF(lwp) WRITE(numout,*) '~~~~~~~~~ ' 107 97 ! 98 r1_rdtice = 1. / rdt_ice 99 ! 108 100 soce_r(:,:) = soce 109 101 sice_r(:,:) = sice 110 102 ! 111 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 112 ! ! ======================= 113 ! ! ORCA_R2 configuration 114 ! ! ======================= 103 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 115 104 ii0 = 145 ; ii1 = 180 ! Baltic Sea 116 105 ij0 = 113 ; ij1 = 130 ; soce_r(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 … … 175 164 !!$ 176 165 177 ! computation thesolar flux at ocean surface166 ! solar flux at ocean surface 178 167 #if defined key_coupled 179 168 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) … … 181 170 zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 182 171 #endif 183 ! computation thenon solar heat flux at ocean surface172 ! non solar heat flux at ocean surface 184 173 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 185 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) &186 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * zrdtir&187 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * zrdtir188 174 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 175 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 176 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice 177 ! 189 178 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! ??? 190 179 ! 191 180 qsr (ji,jj) = zqsr ! solar heat flux 192 181 qns (ji,jj) = zqns - fdtcn(ji,jj) ! non solar heat flux … … 194 183 END DO 195 184 196 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )197 CALL iom_put( 'qns_io_cea' , qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )198 CALL iom_put( 'qsr_io_cea' , fstric(:,:) * (1. - pfrld(:,:)))185 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) 186 CALL iom_put( 'qns_io_cea' , qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 187 CALL iom_put( 'qsr_io_cea' , fstric(:,:) * ( 1.e0 - pfrld(:,:) ) ) 199 188 200 189 !------------------------------------------! 201 190 ! mass flux at the ocean surface ! 202 191 !------------------------------------------! 203 204 !!gm205 !!gm CAUTION206 !!gm re-verifies the emp & emps expression, especially the absence of 1-frld on zfm207 !!gm208 192 DO jj = 1, jpj 209 193 DO ji = 1, jpi 210 211 194 #if defined key_coupled 212 zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 213 & + rdmsnif(ji,jj) * zrdtir ! freshwaterflux due to snow melting 195 ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode) 196 zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! atmosphere-ocean freshwater flux 197 & + rdmsnif(ji,jj) * r1_rdtice ! freshwater flux due to snow melting 214 198 #else 215 !!$ ! computing freshwater exchanges at the ice/ocean interface 216 !!$ zpme = - evap(ji,jj) * frld(ji,jj) & ! evaporation over oceanic fraction 217 !!$ & + tprecip(ji,jj) & ! total precipitation 218 !!$ & - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! remov. snow precip over ice 219 !!$ & - rdmsnif(ji,jj) / rdt_ice ! freshwaterflux due to snow melting 220 ! computing freshwater exchanges at the ice/ocean interface 221 zemp = + emp(ji,jj) * frld(ji,jj) & ! e-p budget over open ocean fraction 222 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precipitation reaches directly the ocean 223 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! taking into account change in ice cover within the time step 224 & + rdmsnif(ji,jj) * zrdtir ! freshwaterflux due to snow melting 225 ! ! ice-covered fraction: 199 ! freshwater exchanges at the ice-atmosphere / ocean interface (forced mode) 200 zemp = + emp(ji,jj) * frld(ji,jj) & ! e-p budget over open ocean fraction 201 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precipitation reaches directly the ocean 202 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! (account for change in ice cover within the timestep 203 & + rdmsnif(ji,jj) * r1_rdtice ! freshwaterflux due to snow melting 226 204 #endif 227 228 ! computing salt exchanges at the ice/ocean interface 229 zfons = ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * zrdtir ) 230 231 ! converting the salt flux from ice to a freshwater flux from ocean 205 ! salt exchanges at the ice/ocean interface 206 zfons = ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice ) 207 ! 208 ! convert the salt flux from ice into a freshwater flux from ocean 232 209 zfm = zfons / ( sss_m(ji,jj) + epsi16 ) 233 210 ! 234 211 emps(ji,jj) = zemp + zfm ! surface ocean concentration/dilution effect (use on SSS evolution) 235 212 emp (ji,jj) = zemp ! surface ocean volume flux (use on sea-surface height evolution) 236 237 213 END DO 238 214 END DO 239 215 ! 240 216 IF( lk_diaar5 ) THEN 241 CALL iom_put( 'isnwmlt_cea' , rdmsnif(:,:) * zrdtir)242 CALL iom_put( 'fsal_virt_cea', soce_r(:,:) * rdmicif(:,:) * zrdtir)243 CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * zrdtir)217 CALL iom_put( 'isnwmlt_cea' , rdmsnif(:,:) * r1_rdtice ) 218 CALL iom_put( 'fsal_virt_cea', soce_r(:,:) * rdmicif(:,:) * r1_rdtice ) 219 CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * r1_rdtice ) 244 220 ENDIF 245 221 … … 275 251 DO ji = 2, jpim1 ! NO vector opt. 276 252 ! ... components of ice-ocean stress at U and V-points (from I-point values) 277 zutau = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 253 #if defined key_lim2_vp 254 zutau = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) ! VP rheology 278 255 zvtau = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 256 #else 257 zutau = ztio_u(ji,jj) ! EVP rheology 258 zvtau = ztio_v(ji,jj) 259 #endif 279 260 ! ... open-ocean (lead) fraction at U- & V-points (from T-point values) 280 261 zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj ) ) … … 290 271 END DO 291 272 END DO 292 293 ! boundary condition on the stress (utau,vtau,taum) 294 CALL lbc_lnk( utau, 'U', -1. ) 295 CALL lbc_lnk( vtau, 'V', -1. ) 273 CALL lbc_lnk( utau, 'U', -1. ) ; CALL lbc_lnk( vtau, 'V', -1. ) ! lateral boundary condition 296 274 CALL lbc_lnk( taum, 'T', 1. ) 297 275 298 276 ENDIF 299 277 278 IF( lk_cpl ) THEN 300 279 !-----------------------------------------------! 301 280 ! Coupling variables ! 302 281 !-----------------------------------------------! 303 304 IF ( lk_cpl ) THEN 305 ! Ice surface temperature 306 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 307 ! Computation of snow/ice and ocean albedo 282 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 283 ! ! snow/ice and ocean albedo 308 284 CALL albedo_ice( tn_ice, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalbp, zalb ) 309 285 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) … … 318 294 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice : ') 319 295 ENDIF 320 321 296 ! 297 END SUBROUTINE lim_sbc_2 322 298 323 299 #else
Note: See TracChangeset
for help on using the changeset viewer.
