- Timestamp:
- 2015-06-04T20:39:20+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5220 r5357 116 116 117 117 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only 118 118 119 !-----------------------! 119 120 ! --- Bulk Formulae --- ! … … 125 126 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 126 127 ! 127 ! Ice albedo 128 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 129 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 130 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_cpl ) 135 136 ! albedo depends on cloud fraction because of non-linear spectral effects 137 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 138 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 139 ! (zalb_ice) is computed within the bulk routine 140 141 END SELECT 128 !!clem ! Ice albedo 129 !!clem CALL wrk_alloc( 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_cpl ) 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 142 140 143 141 ! Mask sea ice surface temperature (set to rt0 over land) … … 156 154 SELECT CASE( kblk ) 157 155 CASE( jp_clio ) ! CLIO bulk formulation 158 CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , & 159 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 160 & qla_ice , dqns_ice , dqla_ice , & 161 & tprecip , sprecip , & 162 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 163 ! 164 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 165 & 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( utau_ice, vtau_ice, cp_ice_msh ) 166 165 167 166 CASE( jp_core ) ! CORE bulk formulation 168 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , &169 & utau_ice , vtau_ice , qns_ice , qsr_ice , &170 & qla_ice , dqns_ice , dqla_ice , &171 & tprecip , sprecip , &172 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl )173 ! 174 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 175 & 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 176 175 ! 177 176 CASE ( jp_cpl ) … … 182 181 183 182 IF( ln_mixcpl) THEN 183 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 184 184 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 185 185 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 186 186 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 187 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 187 188 ENDIF 188 189 … … 229 230 phicif(:,:) = vt_i(:,:) 230 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 231 236 SELECT CASE( kblk ) 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 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 245 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 246 247 CASE( jp_core ) ! CORE bulk formulation 248 ! albedo depends on cloud fraction because of non-linear spectral effects 249 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 250 CALL blk_ice_core_flx( t_su, zalb_ice ) 251 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 252 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 253 232 254 CASE ( jp_cpl ) 255 ! albedo depends on cloud fraction because of non-linear spectral effects 256 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 233 257 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 234 258 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 235 & dqns_ice, qla_ice, dqla_ice, nn_limflx )259 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 236 260 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 237 qla_ice (:,:,:) = 0._wp 238 dqla_ice (:,:,:) = 0._wp 261 evap_ice (:,:,:) = 0._wp 262 devap_ice (:,:,:) = 0._wp 263 239 264 END SELECT 265 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 266 240 267 ! 241 268 CALL lim_thd( kt ) ! Ice thermodynamics … … 256 283 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 257 284 ! 258 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)259 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )260 285 ! 261 286 ENDIF ! End sea-ice time step only … … 486 511 487 512 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 488 & pdqn_ice, p qla_ice, pdql_ice, k_limflx )513 & pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 489 514 !!--------------------------------------------------------------------- 490 515 !! *** ROUTINE ice_lim_flx *** … … 504 529 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux 505 530 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity 506 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p qla_ice ! latent heat flux507 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pd ql_ice ! latent heat fluxsensitivity531 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation 532 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 508 533 ! 509 534 INTEGER :: jl ! dummy loop index … … 514 539 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories 515 540 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories 516 REAL(wp), POINTER, DIMENSION(:,:) :: z_ qla_m ! Mean latent heat fluxover all categories541 REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories 517 542 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories 518 REAL(wp), POINTER, DIMENSION(:,:) :: z_d ql_m ! Mean d(qla)/dT over all categories543 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 519 544 !!---------------------------------------------------------------------- 520 545 … … 524 549 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 525 550 CASE( 0 , 1 ) 526 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)551 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 527 552 ! 528 553 z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 529 554 z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 530 555 z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 531 z_ qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )532 z_d ql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )556 z_evap_m(:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 557 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 533 558 DO jl = 1, jpl 534 559 pdqn_ice(:,:,jl) = z_dqn_m(:,:) 535 pd ql_ice(:,:,jl) = z_dql_m(:,:)560 pdevap_ice(:,:,jl) = z_devap_m(:,:) 536 561 END DO 537 562 ! … … 539 564 pqns_ice(:,:,jl) = z_qns_m(:,:) 540 565 pqsr_ice(:,:,jl) = z_qsr_m(:,:) 541 p qla_ice(:,:,jl) = z_qla_m(:,:)566 pevap_ice(:,:,jl) = z_evap_m(:,:) 542 567 END DO 543 568 ! 544 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)569 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 545 570 END SELECT 546 571 … … 553 578 DO jl = 1, jpl 554 579 pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 555 p qla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))580 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 556 581 pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 557 582 END DO … … 603 628 wfx_spr(:,:) = 0._wp ; 604 629 605 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp606 630 hfx_thd(:,:) = 0._wp ; 607 631 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 620 644 621 645 END SUBROUTINE sbc_lim_diag0 622 646 647 623 648 FUNCTION fice_cell_ave ( ptab ) 624 649 !!--------------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
