- Timestamp:
- 2016-06-24T09:50:27+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r3625 r6736 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 !! 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 11 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 13 12 !!---------------------------------------------------------------------- 14 13 #if defined key_lim2 … … 29 28 USE sbc_oce ! surface boundary condition: ocean 30 29 USE sbccpl 31 USE cpl_oasis3, ONLY : lk_cpl 32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 30 33 31 USE albedo ! albedo parameters 34 32 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 39 37 USE iom ! I/O library 40 38 USE prtctl ! Print control 41 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 40 USE cpl_oasis3, ONLY : lk_cpl 42 41 43 42 IMPLICIT NONE … … 90 89 !! - Update the fluxes provided to the ocean 91 90 !! 92 !! ** Outputs : - qsr : sea heat flux :solar93 !! - qns : sea heat flux : non solar (including heat content of the mass flux)94 !! - emp : freshwater budget: massflux95 !! - sfx : freshwater budget: salt flux due to Freezing/Melting91 !! ** Outputs : - qsr : sea heat flux: solar 92 !! - qns : sea heat flux: non solar 93 !! - emp : freshwater budget: volume flux 94 !! - emps : freshwater budget: concentration/dillution 96 95 !! - utau : sea surface i-stress (ocean referential) 97 96 !! - vtau : sea surface j-stress (ocean referential) … … 109 108 INTEGER :: ifvt, i1mfr, idfr, iflt ! - - 110 109 INTEGER :: ial, iadv, ifral, ifrdv ! - - 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 ! - - 110 REAL(wp) :: zqsr, zqns, zfm ! local scalars 111 REAL(wp) :: zinda, zfons, zemp ! - - 115 112 REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace 116 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace … … 119 116 CALL wrk_alloc( jpi, jpj, zqnsoce ) 120 117 CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp ) 121 122 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option123 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only124 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect125 ! (2) embedded sea-ice : salt and volume fluxes and pressure126 END SELECT !127 118 128 119 !------------------------------------------! … … 143 134 ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv 144 135 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. !136 !!$ zinda = 1.0 - AINT( pfrld(ji,jj) ) ! = 0. if pure ocean else 1. (at previous time) 137 !!$ 138 !!$ i1mfr = 1.0 - AINT( frld(ji,jj) ) ! = 0. if pure ocean else 1. (at current time) 139 !!$ 140 !!$ IF( phicif(ji,jj) <= 0. ) THEN ; ifvt = zinda ! = 1. if (snow and no ice at previous time) else 0. ??? 141 !!$ ELSE ; ifvt = 0. 151 142 !!$ ENDIF 152 143 !!$ 153 !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases due to ice thermodynamics144 !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases from previous to current 154 145 !!$ ELSE ; idfr = 1. 155 146 !!$ ENDIF 156 147 !!$ 157 !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous time and ice-free ocean currently148 !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous and pure ocean at current 158 149 !!$ 159 150 !!$ ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr 160 !!$ = i1mfr if ifvt = 1 i.e.161 !!$ = idfr if ifvt = 0162 151 !!$! snow no ice ice ice or nothing lead fraction increases 163 152 !!$! at previous now at previous 164 !!$! -> ice a rea increases ??? -> ice area decreases ???153 !!$! -> ice aera increases ??? -> ice aera decreases ??? 165 154 !!$ 166 155 !!$ iadv = ( 1 - i1mfr ) * zinda … … 186 175 #endif 187 176 ! computation the non solar heat flux at ocean surface 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) 177 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 178 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 179 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 180 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice 181 182 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! ??? 183 ! 197 184 qsr (ji,jj) = zqsr ! 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 qns (ji,jj) = zqns - fdtcn(ji,jj) ! non solar heat flux 229 186 END DO 230 187 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 step236 ! ! new mass per unit area237 snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) )238 ! ! time evolution of snow+ice mass239 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice240 ENDIF241 188 242 189 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) … … 244 191 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 245 192 193 !------------------------------------------! 194 ! mass flux at the ocean surface ! 195 !------------------------------------------! 196 DO jj = 1, jpj 197 DO ji = 1, jpi 198 ! 199 #if defined key_coupled 200 ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode) 201 zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 202 & + rdmsnif(ji,jj) * r1_rdtice ! freshwaterflux due to snow melting 203 #else 204 ! computing freshwater exchanges at the ice/ocean interface 205 zemp = + emp(ji,jj) * frld(ji,jj) & ! e-p budget over open ocean fraction 206 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precipitation reaches directly the ocean 207 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! change in ice cover within the time step 208 & + rdmsnif(ji,jj) * r1_rdtice ! freshwater flux due to snow melting 209 #endif 210 ! 211 ! computing salt exchanges at the ice/ocean interface 212 zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice ) 213 ! 214 ! converting the salt flux from ice to a freshwater flux from ocean 215 zfm = zfons / ( sss_m(ji,jj) + epsi16 ) 216 ! 217 emps(ji,jj) = zemp + zfm ! surface ocean concentration/dilution effect (use on SSS evolution) 218 emp (ji,jj) = zemp ! surface ocean volume flux (use on sea-surface height evolution) 219 ! 220 END DO 221 END DO 222 246 223 IF( lk_diaar5 ) THEN ! AR5 diagnostics 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 )224 CALL iom_put( 'isnwmlt_cea' , rdmsnif(:,:) * r1_rdtice ) 225 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdmicif(:,:) * r1_rdtice ) 226 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdmicif(:,:) * r1_rdtice ) 250 227 ENDIF 251 228 … … 267 244 IF(ln_ctl) THEN ! control print 268 245 CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ') 269 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2= sfx , clinfo2=' sfx: ')246 CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=emps , clinfo2=' emps : ') 270 247 CALL prt_ctl(tab2d_1=utau , clinfo1=' lim_sbc: utau : ', mask1=umask, & 271 248 & tab2d_2=vtau , clinfo2=' vtau : ' , mask2=vmask ) … … 463 440 END WHERE 464 441 ENDIF 465 ! ! embedded sea ice466 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass467 snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) )468 snwice_mass_b(:,:) = snwice_mass(:,:)469 ELSE470 snwice_mass (:,:) = 0.e0 ! no mass exchanges471 snwice_mass_b(:,:) = 0.e0 ! no mass exchanges472 ENDIF473 IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart :474 & .NOT.ln_rstart ) THEN ! deplete the initial ssh below sea-ice area475 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0476 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0477 ENDIF478 442 ! 479 443 END SUBROUTINE lim_sbc_init_2
Note: See TracChangeset
for help on using the changeset viewer.
