- Timestamp:
- 2016-11-21T10:38:43+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r6403 r7278 106 106 INTEGER :: jl ! dummy loop index 107 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled)109 108 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 110 109 !!---------------------------------------------------------------------- … … 193 192 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 194 193 !---------------------------------------------------------------------------------------- 195 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs , zalb_ice)194 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 196 195 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 197 196 … … 199 198 CASE( jp_clio ) ! CLIO bulk formulation 200 199 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 201 ! ( zalb_ice) is computed within the bulk routine202 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice )203 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi= zalb_ice, psst=sst_m, pist=t_su )204 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )200 ! (alb_ice) is computed within the bulk routine 201 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, alb_ice ) 202 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 203 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 205 204 CASE( jp_core ) ! CORE bulk formulation 206 205 ! albedo depends on cloud fraction because of non-linear spectral effects 207 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)208 CALL blk_ice_core_flx( t_su, zalb_ice )209 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi= zalb_ice, psst=sst_m, pist=t_su )210 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx )206 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 207 CALL blk_ice_core_flx( t_su, alb_ice ) 208 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 209 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 211 210 CASE ( jp_purecpl ) 212 211 ! albedo depends on cloud fraction because of non-linear spectral effects 213 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 214 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 215 ! clem: evap_ice is forced to 0 in coupled mode for now 216 ! but it needs to be changed (along with modif in limthd_dh) once heat flux from evap will be avail. from atm. models 217 evap_ice (:,:,:) = 0._wp ; devap_ice (:,:,:) = 0._wp 218 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 212 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 213 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 214 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 219 215 END SELECT 220 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs , zalb_ice)216 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs ) 221 217 222 218 !----------------------------! … … 577 573 sfx_bog(:,:) = 0._wp ; sfx_dyn(:,:) = 0._wp 578 574 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 579 sfx_res(:,:) = 0._wp 575 sfx_res(:,:) = 0._wp ; sfx_sub(:,:) = 0._wp 580 576 ! 581 577 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp … … 593 589 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 594 590 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 595 hfx_err_dif(:,:) = 0._wp ; 591 hfx_err_dif(:,:) = 0._wp 592 wfx_err_sub(:,:) = 0._wp 596 593 ! 597 594 afx_tot(:,:) = 0._wp ;
Note: See TracChangeset
for help on using the changeset viewer.