Changeset 5407 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
- Timestamp:
- 2015-06-11T21:13:22+02:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5341 r5407 110 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 111 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) 112 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 112 113 !!---------------------------------------------------------------------- 113 114 … … 115 116 116 117 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only 118 117 119 !-----------------------! 118 120 ! --- Bulk Formulae --- ! … … 124 126 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 125 127 ! 126 ! Ice albedo 127 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 128 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 129 130 ! CORE and COUPLED bulk formulations 131 SELECT CASE( kblk ) 132 CASE( jp_core , jp_cpl ) 133 134 ! albedo depends on cloud fraction because of non-linear spectral effects 135 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 136 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 137 ! (zalb_ice) is computed within the bulk routine 138 139 END SELECT 128 !!clem ! Ice albedo 129 !!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 albedos 131 !! 132 !! ! CORE and COUPLED bulk formulations 133 !! SELECT CASE( kblk ) 134 !! CASE( jp_core , jp_purecpl ) 135 !! ! albedo depends on cloud fraction because of non-linear spectral effects 136 !! 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 albedo 138 !! ! (zalb_ice) is computed within the bulk routine 139 !!clem END SELECT 140 140 141 141 ! Mask sea ice surface temperature (set to rt0 over land) … … 154 154 SELECT CASE( kblk ) 155 155 CASE( jp_clio ) ! CLIO bulk formulation 156 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 ) 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 164 165 165 166 CASE( jp_core ) ! CORE bulk formulation 166 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , &167 & utau_ice , vtau_ice , qns_ice , qsr_ice , &168 & qla_ice , dqns_ice , dqla_ice , &169 & tprecip , sprecip , &170 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl )171 ! 172 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 173 & dqns_ice, qla_ice, dqla_ice, nn_limflx )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 174 175 ! 175 CASE ( jp_ cpl )176 CASE ( jp_purecpl ) 176 177 177 178 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) … … 179 180 END SELECT 180 181 181 !------------------------------! 182 ! --- LIM-3 main time-step --- ! 183 !------------------------------! 182 IF( ln_mixcpl) THEN 183 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 184 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 185 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 186 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 187 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 188 ENDIF 189 190 ! !----------------------! 191 ! ! LIM-3 time-stepping ! 192 ! !----------------------! 193 ! 184 194 numit = numit + nn_fsbc ! Ice model time step 185 195 ! … … 220 230 phicif(:,:) = vt_i(:,:) 221 231 232 ! Ice albedo 233 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 ) ! cloud-sky and overcast-sky ice albedos 235 222 236 SELECT CASE( kblk ) 223 CASE ( jp_cpl ) 224 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 237 CASE( jp_clio ) ! CLIO bulk formulation 238 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 239 ! (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 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 249 CASE( jp_core ) ! CORE bulk formulation 250 ! albedo depends on cloud fraction because of non-linear spectral effects 251 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 252 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 257 CASE ( jp_purecpl ) 258 ! albedo depends on cloud fraction because of non-linear spectral effects 259 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 ) 225 261 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 226 & dqns_ice, qla_ice, dqla_ice, nn_limflx )262 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 227 263 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 228 qla_ice (:,:,:) = 0._wp 229 dqla_ice (:,:,:) = 0._wp 264 evap_ice (:,:,:) = 0._wp 265 devap_ice (:,:,:) = 0._wp 266 230 267 END SELECT 268 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 269 231 270 ! 232 271 CALL lim_thd( kt ) ! Ice thermodynamics … … 247 286 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 248 287 ! 249 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )250 288 ! 251 289 ENDIF ! End sea-ice time step only … … 476 514 477 515 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 478 & pdqn_ice, p qla_ice, pdql_ice, k_limflx )516 & pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 479 517 !!--------------------------------------------------------------------- 480 518 !! *** ROUTINE ice_lim_flx *** … … 494 532 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux 495 533 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity 496 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p qla_ice ! latent heat flux497 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pd ql_ice ! latent heat fluxsensitivity534 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation 535 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 498 536 ! 499 537 INTEGER :: jl ! dummy loop index … … 504 542 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories 505 543 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories 506 REAL(wp), POINTER, DIMENSION(:,:) :: z_ qla_m ! Mean latent heat fluxover all categories544 REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories 507 545 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories 508 REAL(wp), POINTER, DIMENSION(:,:) :: z_d ql_m ! Mean d(qla)/dT over all categories546 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 509 547 !!---------------------------------------------------------------------- 510 548 … … 514 552 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 515 553 CASE( 0 , 1 ) 516 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)554 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 517 555 ! 518 556 z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 519 557 z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 520 558 z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 521 z_ qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )522 z_d ql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )559 z_evap_m(:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 560 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 523 561 DO jl = 1, jpl 524 562 pdqn_ice(:,:,jl) = z_dqn_m(:,:) 525 pd ql_ice(:,:,jl) = z_dql_m(:,:)563 pdevap_ice(:,:,jl) = z_devap_m(:,:) 526 564 END DO 527 565 ! … … 529 567 pqns_ice(:,:,jl) = z_qns_m(:,:) 530 568 pqsr_ice(:,:,jl) = z_qsr_m(:,:) 531 p qla_ice(:,:,jl) = z_qla_m(:,:)569 pevap_ice(:,:,jl) = z_evap_m(:,:) 532 570 END DO 533 571 ! 534 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)572 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 535 573 END SELECT 536 574 … … 543 581 DO jl = 1, jpl 544 582 pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 545 p qla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))583 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 546 584 pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 547 585 END DO … … 593 631 wfx_spr(:,:) = 0._wp ; 594 632 595 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp596 633 hfx_thd(:,:) = 0._wp ; 597 634 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 610 647 611 648 END SUBROUTINE sbc_lim_diag0 612 649 650 613 651 FUNCTION fice_cell_ave ( ptab ) 614 652 !!--------------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
