Changeset 5410 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
- Timestamp:
- 2015-06-12T18:39:20+02:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5407 r5410 115 115 IF( nn_timing == 1 ) CALL timing_start('sbc_ice_lim') 116 116 117 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only 118 119 !-----------------------! 120 ! --- Bulk Formulae --- ! 121 !-----------------------! 122 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point 123 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) ! (C-grid dynamics : U- & V-points as the ocean) 117 !-----------------------! 118 ! --- Ice time step --- ! 119 !-----------------------! 120 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 121 122 ! mean surface ocean current at ice velocity point (C-grid dynamics : U- & V-points as the ocean) 123 u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 124 v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 124 125 125 126 ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 126 127 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 127 !128 !!clem ! Ice albedo129 !!clem CALL wrk_@lloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )130 !!clem CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos131 !!132 !! ! CORE and COUPLED bulk formulations133 !! SELECT CASE( kblk )134 !! CASE( jp_core , jp_purecpl )135 !! ! albedo depends on cloud fraction because of non-linear spectral effects136 !! zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)137 !! ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo138 !! ! (zalb_ice) is computed within the bulk routine139 !!clem END SELECT140 128 141 129 ! Mask sea ice surface temperature (set to rt0 over land) 142 130 DO jl = 1, jpl 143 131 t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 144 END DO 145 146 ! Bulk formulae - provides the following fields: 147 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 148 ! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2] 149 ! qla_ice : latent heat flux over ice (T-point) [W/m2] 150 ! dqns_ice, dqla_ice : non solar & latent heat sensistivity (T-point) [W/m2] 151 ! tprecip , sprecip : total & solid precipitation (T-point) [Kg/m2/s] 152 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 153 ! 132 END DO 133 ! 134 !------------------------------------------------! 135 ! --- Dynamical coupling with the atmosphere --- ! 136 !------------------------------------------------! 137 ! It provides the following fields: 138 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 139 !----------------------------------------------------------------- 154 140 SELECT CASE( kblk ) 155 CASE( jp_clio ) ! CLIO bulk formulation 156 !!clem CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , & 157 !! & utau_ice , vtau_ice , qns_ice , qsr_ice , & 158 !! & qla_ice , dqns_ice , dqla_ice , & 159 !! & tprecip , sprecip , & 160 !! & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 161 !! ! 162 !! IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 163 !! & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 164 CALL blk_ice_clio_tau 165 166 CASE( jp_core ) ! CORE bulk formulation 167 !!clem CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , & 168 !!clem & utau_ice , vtau_ice , qns_ice , qsr_ice , & 169 !!clem & qla_ice , dqns_ice , dqla_ice , & 170 !!clem & tprecip , sprecip , & 171 !!clem & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 172 !!clem IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 173 !!clem & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 174 CALL blk_ice_core_tau 175 ! 176 CASE ( jp_purecpl ) 177 178 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 179 141 CASE( jp_clio ) ; CALL blk_ice_clio_tau ! CLIO bulk formulation 142 CASE( jp_core ) ; CALL blk_ice_core_tau ! CORE bulk formulation 143 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 180 144 END SELECT 181 145 182 IF( ln_mixcpl) THEN 146 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 183 147 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 184 148 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) … … 188 152 ENDIF 189 153 190 ! !----------------------! 191 ! ! LIM-3 time-stepping ! 192 ! !----------------------! 193 ! 194 numit = numit + nn_fsbc ! Ice model time step 154 !-------------------------------------------------------! 155 ! --- ice dynamics and transport (except in 1D case) ---! 156 !-------------------------------------------------------! 157 numit = numit + nn_fsbc ! Ice model time step 195 158 ! 196 CALL sbc_lim_bef ! Store previous ice values 197 198 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 199 200 CALL lim_rst_opn( kt ) ! Open Ice restart file 201 ! 202 ! ---------------------------------------------- 203 ! ice dynamics and transport (except in 1D case) 204 ! ---------------------------------------------- 159 CALL sbc_lim_bef ! Store previous ice values 160 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 161 CALL lim_rst_opn( kt ) ! Open Ice restart file 162 ! 205 163 IF( .NOT. lk_c1d ) THEN 206 207 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics )208 209 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion )210 211 IF( nn_monocat /= 2 ) CALL lim_itd_me 212 164 ! 165 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 166 ! 167 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) 168 ! 169 IF( nn_monocat /= 2 ) CALL lim_itd_me ! Mechanical redistribution ! (ridging/rafting) 170 ! 213 171 #if defined key_bdy 214 CALL bdy_ice_lim( kt ) ! bdy ice thermo215 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )172 CALL bdy_ice_lim( kt ) ! bdy ice thermo 173 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 216 174 #endif 217 CALL lim_update1( kt ) 218 175 ! 176 CALL lim_update1( kt ) ! Corrections 177 ! 219 178 ENDIF 220 179 221 CALL sbc_lim_bef ! Store previous ice values222 223 ! ----------------------------------------------224 ! ice thermodynamics225 ! ----------------------------------------------226 CALL lim_var_agg(1)227 228 180 ! previous lead fraction and ice volume for flux calculations 181 CALL sbc_lim_bef 182 CALL lim_var_glo2eqv ! ht_i and ht_s for ice albedo calculation 183 CALL lim_var_agg(1) ! at_i for coupling (via pfrld) 229 184 pfrld(:,:) = 1._wp - at_i(:,:) 230 185 phicif(:,:) = vt_i(:,:) 231 186 232 ! Ice albedo 187 !------------------------------------------------------! 188 ! --- Thermodynamical coupling with the atmosphere --- ! 189 !------------------------------------------------------! 190 ! It provides the following fields: 191 ! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2] 192 ! qla_ice : latent heat flux over ice (T-point) [W/m2] 193 ! dqns_ice, dqla_ice : non solar & latent heat sensistivity (T-point) [W/m2] 194 ! tprecip , sprecip : total & solid precipitation (T-point) [Kg/m2/s] 195 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 196 !---------------------------------------------------------------------------------------- 233 197 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 234 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) 235 198 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 199 236 200 SELECT CASE( kblk ) 237 201 CASE( jp_clio ) ! CLIO bulk formulation 238 202 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 239 203 ! (zalb_ice) is computed within the bulk routine 240 ! CALL blk_ice_clio_flx( t_su , zalb_cs, zalb_os , zalb_ice, qns_ice , qsr_ice , &241 ! & qla_ice, dqns_ice , dqla_ice , tprecip, sprecip , &242 ! & fr1_i0 , fr2_i0 , jpl )243 ! !244 204 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 245 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 246 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 247 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 248 205 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 206 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 249 207 CASE( jp_core ) ! CORE bulk formulation 250 208 ! albedo depends on cloud fraction because of non-linear spectral effects 251 209 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 252 210 CALL blk_ice_core_flx( t_su, zalb_ice ) 253 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 254 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 255 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 256 211 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 212 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 257 213 CASE ( jp_purecpl ) 258 214 ! albedo depends on cloud fraction because of non-linear spectral effects 259 215 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 260 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 261 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 262 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 216 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 217 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 263 218 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 264 219 evap_ice (:,:,:) = 0._wp 265 220 devap_ice (:,:,:) = 0._wp 266 267 221 END SELECT 268 222 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 269 223 270 ! 271 CALL lim_thd( kt ) ! Ice thermodynamics 272 224 !----------------------------! 225 ! --- ice thermodynamics --- ! 226 !----------------------------! 227 CALL lim_thd( kt ) ! Ice thermodynamics 228 ! 273 229 CALL lim_update2( kt ) ! Corrections 274 230 ! … … 276 232 ! 277 233 IF(ln_limdiaout) CALL lim_diahsb ! Diagnostics and outputs 278 234 ! 279 235 CALL lim_wri( 1 ) ! Ice outputs 280 236 ! 281 237 IF( kt == nit000 .AND. ln_rstart ) & 282 238 & CALL iom_close( numrir ) ! close input ice restart file … … 286 242 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 287 243 ! 288 !289 244 ENDIF ! End sea-ice time step only 290 245 291 !--------------------------------! 292 ! --- at all ocean time step --- ! 293 !--------------------------------! 294 ! Update surface ocean stresses (only in ice-dynamic case) 295 ! otherwise the atm.-ocean stresses are used everywhere 246 !-------------------------! 247 ! --- Ocean time step --- ! 248 !-------------------------! 249 ! Update surface ocean stresses (only in ice-dynamic case) otherwise the atm.-ocean stresses are used everywhere 296 250 IF( ln_limdyn ) CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 297 251 !!gm remark, the ocean-ice stress is not saved in ice diag call above ..... find a solution!!! 298 252 ! 299 IF( nn_timing == 1 ) 253 IF( nn_timing == 1 ) CALL timing_stop('sbc_ice_lim') 300 254 ! 301 255 END SUBROUTINE sbc_ice_lim … … 513 467 514 468 515 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 516 & pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 469 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 517 470 !!--------------------------------------------------------------------- 518 471 !! *** ROUTINE ice_lim_flx *** … … 554 507 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 555 508 ! 556 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )557 z_qsr_m (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )558 z_dqn_m (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )559 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )509 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 510 z_qsr_m (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 511 z_dqn_m (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 512 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 560 513 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 561 514 DO jl = 1, jpl 562 pdqn_ice (:,:,jl) = z_dqn_m(:,:)515 pdqn_ice (:,:,jl) = z_dqn_m(:,:) 563 516 pdevap_ice(:,:,jl) = z_devap_m(:,:) 564 517 END DO 565 518 ! 566 519 DO jl = 1, jpl 567 pqns_ice (:,:,jl) = z_qns_m(:,:)568 pqsr_ice (:,:,jl) = z_qsr_m(:,:)520 pqns_ice (:,:,jl) = z_qns_m(:,:) 521 pqsr_ice (:,:,jl) = z_qsr_m(:,:) 569 522 pevap_ice(:,:,jl) = z_evap_m(:,:) 570 523 END DO … … 580 533 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) ) 581 534 DO jl = 1, jpl 582 pqns_ice (:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))583 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:))584 pqsr_ice (:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )535 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 536 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 537 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 585 538 END DO 586 539 ! … … 658 611 659 612 fice_cell_ave (:,:) = 0.0_wp 660 661 613 DO jl = 1, jpl 662 614 fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)
Note: See TracChangeset
for help on using the changeset viewer.
