Changeset 8404 for branches/2017
- Timestamp:
- 2017-08-07T15:05:37+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 1 added
- 2 edited
-
iceforcing.F90 (added)
-
icestp.F90 (modified) (8 diffs)
-
limsbc.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icestp.F90
r8378 r8404 28 28 USE sbc_oce ! Surface boundary condition: ocean fields 29 29 USE sbc_ice ! Surface boundary condition: ice fields 30 USE usrdef_sbc ! user defined: surface boundary condition 31 USE sbcblk ! Surface boundary condition: bulk 32 USE sbccpl ! Surface boundary condition: coupled interface 33 USE albedoice ! ice albedo 30 USE iceforcing ! Surface boundary condition for sea ice 34 31 ! 35 32 USE phycst ! Define parameters for the routines … … 142 139 END DO 143 140 ! 141 CALL ice_bef ! Store previous ice values 144 142 !------------------------------------------------! 145 143 ! --- Dynamical coupling with the atmosphere --- ! 146 144 !------------------------------------------------! 147 ! It provides the following fields: 148 ! utau_ice, vtau_ice : surface ice stress (U- & V-points) [N/m2] 149 !----------------------------------------------------------------- 150 CALL ice_bef ! Store previous ice values 151 SELECT CASE( ksbc ) 152 CASE( jp_usr ) ; CALL usrdef_sbc_ice_tau( kt ) ! user defined formulation 153 CASE( jp_blk ) ; CALL blk_ice_tau ! Bulk formulation 154 CASE( jp_purecpl ) ; CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) ! Coupled formulation 155 END SELECT 156 157 IF( ln_mixcpl) THEN ! Case of a mixed Bulk/Coupled formulation 158 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 159 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 160 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 161 ENDIF 162 145 ! it provides: 146 ! utau_ice, vtau_ice = surface ice stress [N/m2] 147 !-------------------------------------------------- 148 CALL ice_forcing_tau( kt, ksbc, utau_ice, vtau_ice ) 149 163 150 !-------------------------------------------------------! 164 151 ! --- ice dynamics and transport (except in 1D case) ---! 165 152 !-------------------------------------------------------! 166 CALL ice_diag0 ! set diag of mass, heat and salt fluxes to 0153 CALL ice_diag0 ! set diag of mass, heat and salt fluxes to 0 167 154 CALL lim_rst_opn( kt ) ! Open Ice restart file 168 155 ! … … 198 185 ! --- Thermodynamical coupling with the atmosphere --- ! 199 186 !------------------------------------------------------! 200 ! It provides the following fields: 201 ! qsr_ice , qns_ice : solar & non solar heat flux over ice (T-point) [W/m2] 202 ! qla_ice : latent heat flux over ice (T-point) [W/m2] 203 ! dqns_ice, dqla_ice : non solar & latent heat sensistivity (T-point) [W/m2] 204 ! tprecip , sprecip : total & solid precipitation (T-point) [Kg/m2/s] 205 ! fr1_i0 , fr2_i0 : 1sr & 2nd fraction of qsr penetration in ice [%] 206 !---------------------------------------------------------------------------------------- 207 208 CALL albedo_ice( t_su, ht_i, ht_s, a_ip_frac, h_ip, ln_pnd_rad, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos MV MP 2016 209 210 SELECT CASE( ksbc ) 211 CASE( jp_usr ) ; CALL usrdef_sbc_ice_flx( kt ) ! user defined formulation 212 CASE( jp_blk ) ! bulk formulation 213 ! albedo depends on cloud fraction because of non-linear spectral effects 214 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 215 CALL blk_ice_flx( t_su, alb_ice ) 216 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su ) 217 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 218 CASE ( jp_purecpl ) 219 ! albedo depends on cloud fraction because of non-linear spectral effects 220 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 221 CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su ) 222 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 223 END SELECT 187 ! It provides the following fields used in sea ice model: 188 ! fr1_i0 , fr2_i0 = 1sr & 2nd fraction of qsr penetration in ice [%] 189 ! emp_oce , emp_ice = E-P over ocean and sea ice [Kg/m2/s] 190 ! sprecip = solid precipitation [Kg/m2/s] 191 ! evap_ice = sublimation [Kg/m2/s] 192 ! qsr_tot , qns_tot = solar & non solar heat flux (total) [W/m2] 193 ! qsr_ice , qns_ice = solar & non solar heat flux over ice [W/m2] 194 ! dqns_ice = non solar heat sensistivity [W/m2] 195 ! qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2] 196 !------------------------------------------------------------------------------------------------------ 197 CALL ice_forcing_flx( kt, ksbc ) 224 198 225 199 !----------------------------! … … 489 463 END SUBROUTINE ice_itd_init 490 464 491 492 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx )493 !!---------------------------------------------------------------------494 !! *** ROUTINE ice_lim_flx ***495 !!496 !! ** Purpose : update the ice surface boundary condition by averaging and / or497 !! redistributing fluxes on ice categories498 !!499 !! ** Method : average then redistribute500 !!501 !! ** Action :502 !!---------------------------------------------------------------------503 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ;504 ! ! = 1 average and redistribute ; =2 redistribute505 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature506 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo507 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqns_ice ! non solar flux508 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux509 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity510 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation511 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity512 !513 INTEGER :: jl ! dummy loop index514 !515 REAL(wp), DIMENSION(jpi,jpj) :: zalb_m ! Mean albedo over all categories516 REAL(wp), DIMENSION(jpi,jpj) :: ztem_m ! Mean temperature over all categories517 !518 REAL(wp), DIMENSION(jpi,jpj) :: z_qsr_m ! Mean solar heat flux over all categories519 REAL(wp), DIMENSION(jpi,jpj) :: z_qns_m ! Mean non solar heat flux over all categories520 REAL(wp), DIMENSION(jpi,jpj) :: z_evap_m ! Mean sublimation over all categories521 REAL(wp), DIMENSION(jpi,jpj) :: z_dqn_m ! Mean d(qns)/dT over all categories522 REAL(wp), DIMENSION(jpi,jpj) :: z_devap_m ! Mean d(evap)/dT over all categories523 !!----------------------------------------------------------------------524 !525 IF( nn_timing == 1 ) CALL timing_start('ice_lim_flx')526 !527 SELECT CASE( k_limflx ) !== averaged on all ice categories ==!528 CASE( 0 , 1 )529 !530 z_qns_m (:,:) = fice_ice_ave ( pqns_ice (:,:,:) )531 z_qsr_m (:,:) = fice_ice_ave ( pqsr_ice (:,:,:) )532 z_dqn_m (:,:) = fice_ice_ave ( pdqn_ice (:,:,:) )533 z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) )534 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) )535 DO jl = 1, jpl536 pdqn_ice (:,:,jl) = z_dqn_m(:,:)537 pdevap_ice(:,:,jl) = z_devap_m(:,:)538 END DO539 !540 DO jl = 1, jpl541 pqns_ice (:,:,jl) = z_qns_m(:,:)542 pqsr_ice (:,:,jl) = z_qsr_m(:,:)543 pevap_ice(:,:,jl) = z_evap_m(:,:)544 END DO545 !546 END SELECT547 !548 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==!549 CASE( 1 , 2 )550 !551 zalb_m(:,:) = fice_ice_ave ( palb_ice (:,:,:) )552 ztem_m(:,:) = fice_ice_ave ( ptn_ice (:,:,:) )553 DO jl = 1, jpl554 pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )555 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) )556 pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) )557 END DO558 !559 END SELECT560 !561 IF( nn_timing == 1 ) CALL timing_stop('ice_lim_flx')562 !563 END SUBROUTINE ice_lim_flx564 565 566 465 SUBROUTINE ice_bef 567 466 !!---------------------------------------------------------------------- … … 574 473 ! 575 474 DO jl = 1, jpl 576 577 DO jj = 1, jpj 578 DO ji = 1, jpi 475 DO jj = 2, jpjm1 476 DO ji = 2, jpim1 579 477 a_i_b (ji,jj,jl) = a_i (ji,jj,jl) ! ice area 580 478 v_i_b (ji,jj,jl) = v_i (ji,jj,jl) ! ice volume … … 589 487 ht_s_b(ji,jj,jl) = v_s_b (ji,jj,jl) / MAX( a_i_b(ji,jj,jl) , epsi20 ) * rswitch 590 488 END DO 591 END DO 592 489 END DO 593 490 END DO 491 CALL lbc_lnk_multi( a_i_b, 'T', 1., v_i_b , 'T', 1., v_s_b , 'T', 1., smv_i_b, 'T', 1., & 492 & oa_i_b, 'T', 1., ht_i_b, 'T', 1., ht_s_b, 'T', 1. ) 493 CALL lbc_lnk( e_i_b, 'T', 1. ) 494 CALL lbc_lnk( e_s_b, 'T', 1. ) 594 495 595 496 ! ice velocities & total concentration 596 DO jj = 1, jpj597 DO ji = 1, jpi497 DO jj = 2, jpjm1 498 DO ji = 2, jpim1 598 499 at_i_b(ji,jj) = SUM( a_i_b(ji,jj,:) ) 599 500 u_ice_b(ji,jj) = u_ice(ji,jj) … … 601 502 END DO 602 503 END DO 504 CALL lbc_lnk_multi( at_i_b, 'T', 1., u_ice_b , 'U', -1., v_ice_b , 'V', -1. ) 603 505 604 506 END SUBROUTINE ice_bef … … 662 564 END SUBROUTINE ice_diag0 663 565 664 665 FUNCTION fice_cell_ave ( ptab )666 !!--------------------------------------------------------------------------667 !! * Compute average over categories, for grid cell (ice covered and free ocean)668 !!--------------------------------------------------------------------------669 REAL (wp), DIMENSION (jpi,jpj) :: fice_cell_ave670 REAL (wp), DIMENSION (jpi,jpj,jpl), INTENT (in) :: ptab671 INTEGER :: jl ! Dummy loop index672 673 fice_cell_ave (:,:) = 0._wp674 DO jl = 1, jpl675 fice_cell_ave (:,:) = fice_cell_ave (:,:) + a_i (:,:,jl) * ptab (:,:,jl)676 END DO677 678 END FUNCTION fice_cell_ave679 680 681 FUNCTION fice_ice_ave ( ptab )682 !!--------------------------------------------------------------------------683 !! * Compute average over categories, for ice covered part of grid cell684 !!--------------------------------------------------------------------------685 REAL (kind=wp), DIMENSION (jpi,jpj) :: fice_ice_ave686 REAL (kind=wp), DIMENSION (jpi,jpj,jpl), INTENT(in) :: ptab687 688 fice_ice_ave (:,:) = 0.0_wp689 WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)690 691 END FUNCTION fice_ice_ave692 693 566 #else 694 567 !!---------------------------------------------------------------------- -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r8378 r8404 107 107 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 108 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zalb_cs, zalb_os ! 3D workspace 109 REAL(wp), DIMENSION(jpi,jpj) :: zalb ! 2D workspace110 109 !!--------------------------------------------------------------------- 111 110 … … 120 119 ENDIF 121 120 122 ! albedo output123 zalb(:,:) = 0._wp124 WHERE ( at_i_b <= epsi06 ) ; zalb(:,:) = rn_alb_oce125 ELSEWHERE ; zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b126 END WHERE127 IF( iom_use('icealb' ) ) CALL iom_put( "icealb" , zalb(:,:) ) ! ice albedo output128 129 zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b )130 IF( iom_use('albedo' ) ) CALL iom_put( "albedo" , zalb(:,:) ) ! surface albedo output131 132 133 121 DO jj = 1, jpj 134 122 DO ji = 1, jpi
Note: See TracChangeset
for help on using the changeset viewer.
