- Timestamp:
- 2012-11-21T14:19:18+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r3294 r3625 9 9 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 10 10 !! - ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step 11 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 11 !! 3.3.1 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 12 !! 3.5 ! 2012-11 ((G. Madec, Y. Aksenov, A. Coward) salt and heat fluxes associated with e-p 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_lim2 … … 28 29 USE sbc_oce ! surface boundary condition: ocean 29 30 USE sbccpl 30 31 USE cpl_oasis3, ONLY : lk_cpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 31 33 USE albedo ! albedo parameters 32 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 37 39 USE iom ! I/O library 38 40 USE prtctl ! Print control 39 USE cpl_oasis3, ONLY : lk_cpl41 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 42 41 43 IMPLICIT NONE … … 88 90 !! - Update the fluxes provided to the ocean 89 91 !! 90 !! ** Outputs : - qsr : sea heat flux :solar91 !! - qns : sea heat flux : non solar92 !! - emp : freshwater budget: volumeflux93 !! - emps : freshwater budget: concentration/dillution92 !! ** Outputs : - qsr : sea heat flux : solar 93 !! - qns : sea heat flux : non solar (including heat content of the mass flux) 94 !! - emp : freshwater budget: mass flux 95 !! - sfx : freshwater budget: salt flux due to Freezing/Melting 94 96 !! - utau : sea surface i-stress (ocean referential) 95 97 !! - vtau : sea surface j-stress (ocean referential) … … 107 109 INTEGER :: ifvt, i1mfr, idfr, iflt ! - - 108 110 INTEGER :: ial, iadv, ifral, ifrdv ! - - 109 REAL(wp) :: zqsr, zqns, zfm ! local scalars 110 REAL(wp) :: zinda, zfons, zemp ! - - 111 REAL(wp) :: zqsr, zqns, zfmm ! local scalars 112 REAL(wp) :: zinda, zfsalt, zemp ! - - 113 REAL(wp) :: zemp_snw, zqhc, zcd ! - - 114 REAL(wp) :: zswitch ! - - 111 115 REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace 112 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace … … 115 119 CALL wrk_alloc( jpi, jpj, zqnsoce ) 116 120 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 121 122 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option 123 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only 124 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect 125 ! (2) embedded sea-ice : salt and volume fluxes and pressure 126 END SELECT ! 117 127 118 128 !------------------------------------------! … … 133 143 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 134 144 135 !!$ zinda = 1.0 - AINT( pfrld(ji,jj) ) ! = 0. if pure ocean else 1. (at previous time)136 !!$ 137 !!$ i1mfr = 1.0 - AINT( frld(ji,jj) ) ! = 0. if pure ocean else 1. (at current time)138 !!$ 139 !!$ IF( phicif(ji,jj) <= 0. ) THEN ; ifvt = zinda ! = 1. if (snow and no ice at previous time) else 0.???140 !!$ ELSE ; ifvt = 0. 145 !!$ attempt to explain the tricky flags set above.... 146 !!$ zinda = 1.0 - AINT( pfrld(ji,jj) ) ! = 0. if ice-free ocean else 1. (after ice adv, but before ice thermo) 147 !!$ i1mfr = 1.0 - AINT( frld(ji,jj) ) ! = 0. if ice-free ocean else 1. (after ice thermo) 148 !!$ 149 !!$ IF( phicif(ji,jj) <= 0. ) THEN ; ifvt = zinda ! = zinda if previous thermodynamic step overmelted the ice??? 150 !!$ ELSE ; ifvt = 0. ! 141 151 !!$ ENDIF 142 152 !!$ 143 !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases from previous to current153 !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases due to ice thermodynamics 144 154 !!$ ELSE ; idfr = 1. 145 155 !!$ ENDIF 146 156 !!$ 147 !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous and pure ocean at current157 !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous time and ice-free ocean currently 148 158 !!$ 149 159 !!$ ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 160 !!$ = i1mfr if ifvt = 1 i.e. 161 !!$ = idfr if ifvt = 0 150 162 !!$! snow no ice ice ice or nothing lead fraction increases 151 163 !!$! at previous now at previous 152 !!$! -> ice a era increases ??? -> ice aera decreases ???164 !!$! -> ice area increases ??? -> ice area decreases ??? 153 165 !!$ 154 166 !!$ iadv = ( 1 - i1mfr ) * zinda … … 174 186 #endif 175 187 ! computation the non solar heat flux at ocean surface 176 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 177 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 178 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 179 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice 180 181 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! ??? 182 ! 188 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 189 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 190 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 191 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice 192 193 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! store residual heat flux (to put into the ocean at the next time-step) 194 zqhc = ( rdq_snw(ji,jj) & 195 & + rdq_ice(ji,jj) * ( 1.- zswitch) ) * r1_rdtice ! heat flux due to snow ( & ice heat content, 196 ! ! if ice/ocean mass exchange active) 183 197 qsr (ji,jj) = zqsr ! solar heat flux 184 qns (ji,jj) = zqns - fdtcn(ji,jj) ! non solar heat flux 198 qns (ji,jj) = zqns - fdtcn(ji,jj) + zqhc ! non solar heat flux 199 ! 200 ! !------------------------------------------! 201 ! ! mass and salt flux at the ocean surface ! 202 ! !------------------------------------------! 203 ! 204 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 205 #if defined key_coupled 206 ! ! coupled mode: 207 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 208 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice 209 #else 210 ! ! forced mode: 211 zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction 212 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean 213 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld) 214 #endif 215 ! 216 ! mass flux at the ocean/ice interface (sea ice fraction) 217 zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean 218 zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus Melting (F-M) 219 220 ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s] 221 zfsalt = - sice_0(ji,jj) * zfmm ! F-M salt exchange 222 zcd = soce_0(ji,jj) * zfmm ! concentration/dilution term due to F-M 223 ! 224 ! salt flux only : add concentration dilution term in salt flux and no F-M term in volume flux 225 ! salt and mass fluxes : non concentration dilution term in salt flux and add F-M term in volume flux 226 sfx (ji,jj) = zfsalt + zswitch * zcd ! salt flux (+ C/D if no ice/ocean mass exchange) 227 emp (ji,jj) = zemp + zemp_snw + ( 1.- zswitch) * zfmm ! mass flux (+ F/M mass flux if ice/ocean mass exchange) 228 ! 185 229 END DO 186 230 END DO 231 ! !------------------------------------------! 232 ! ! mass of snow and ice per unit area ! 233 ! !------------------------------------------! 234 IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required) 235 snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step 236 ! ! new mass per unit area 237 snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) ) 238 ! ! time evolution of snow+ice mass 239 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice 240 ENDIF 187 241 188 242 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) … … 190 244 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 191 245 192 !------------------------------------------!193 ! mass flux at the ocean surface !194 !------------------------------------------!195 DO jj = 1, jpj196 DO ji = 1, jpi197 !198 #if defined key_coupled199 ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode)200 zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & !201 & + rdmsnif(ji,jj) * r1_rdtice ! freshwaterflux due to snow melting202 #else203 ! computing freshwater exchanges at the ice/ocean interface204 zemp = + emp(ji,jj) * frld(ji,jj) & ! e-p budget over open ocean fraction205 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precipitation reaches directly the ocean206 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! change in ice cover within the time step207 & + rdmsnif(ji,jj) * r1_rdtice ! freshwater flux due to snow melting208 #endif209 !210 ! computing salt exchanges at the ice/ocean interface211 zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice )212 !213 ! converting the salt flux from ice to a freshwater flux from ocean214 zfm = zfons / ( sss_m(ji,jj) + epsi16 )215 !216 emps(ji,jj) = zemp + zfm ! surface ocean concentration/dilution effect (use on SSS evolution)217 emp (ji,jj) = zemp ! surface ocean volume flux (use on sea-surface height evolution)218 !219 END DO220 END DO221 222 246 IF( lk_diaar5 ) THEN ! AR5 diagnostics 223 CALL iom_put( 'isnwmlt_cea' , rdm snif(:,:) * r1_rdtice )224 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm icif(:,:) * r1_rdtice )225 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm icif(:,:) * r1_rdtice )247 CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 248 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 249 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 226 250 ENDIF 227 251 … … 243 267 IF(ln_ctl) THEN ! control print 244 268 CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ') 245 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2= emps , clinfo2=' emps: ')269 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ') 246 270 CALL prt_ctl(tab2d_1=utau , clinfo1=' lim_sbc: utau : ', mask1=umask, & 247 271 & tab2d_2=vtau , clinfo2=' vtau : ' , mask2=vmask ) … … 439 463 END WHERE 440 464 ENDIF 465 ! ! embedded sea ice 466 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 467 snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) ) 468 snwice_mass_b(:,:) = snwice_mass(:,:) 469 ELSE 470 snwice_mass (:,:) = 0.e0 ! no mass exchanges 471 snwice_mass_b(:,:) = 0.e0 ! no mass exchanges 472 ENDIF 473 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart : 474 & .NOT.ln_rstart ) THEN ! deplete the initial ssh below sea-ice area 475 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 476 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 477 ENDIF 441 478 ! 442 479 END SUBROUTINE lim_sbc_init_2
Note: See TracChangeset
for help on using the changeset viewer.
