Changeset 12785


Ignore:
Timestamp:
2020-04-20T20:48:56+02:00 (6 months ago)
Author:
clem
Message:

debug ice evap for the coupling in sbccpl and implement the possibility to read the cloud cover for a more accurate calculation of ice albedo. This functionality is only implemented in the bulk, I leave the task for the coupling to the people who know better (though I put the first bricks already)

Location:
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/cfgs/SHARED/namelist_ref

    r12733 r12785  
    281281   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    282282   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     283   sn_cc       = 'NOT USED'                   ,   24         , 'CC'      ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    283284   sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    284285/ 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/doc/namelists/namsbc_blk

    r11703 r12785  
    3131   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3232   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     33   sn_cc       = 'NOT USED'                   ,   24         , 'CC'      ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3334   sn_tdif     = 'taudif_core'                ,   24         , 'taudif'  ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    3435/ 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icealb.F90

    r12725 r12785  
    4545CONTAINS 
    4646 
    47    SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, palb_cs, palb_os ) 
     47   SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice ) 
    4848      !!---------------------------------------------------------------------- 
    4949      !!               ***  ROUTINE ice_alb  *** 
     
    9797      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pafrac_pnd   !  melt pond relative fraction (per unit ice area) 
    9898      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_pnd       !  melt pond depth 
    99       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_cs      !  albedo of ice under clear    sky 
    100       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_os      !  albedo of ice under overcast sky 
     99      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   pcloud_fra   !  cloud fraction 
     100      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   palb_ice     !  albedo of ice 
    101101      ! 
    102102      INTEGER  ::   ji, jj, jl                ! dummy loop indices 
     
    106106      REAL(wp) ::   zalb_ice, zafrac_ice      ! bare sea ice albedo & relative ice fraction 
    107107      REAL(wp) ::   zalb_snw, zafrac_snw      ! snow-covered sea ice albedo & relative snow fraction 
     108      REAL(wp) ::   zalb_cs, zalb_os          ! albedo of ice under clear/overcast sky 
    108109      !!--------------------------------------------------------------------- 
    109110      ! 
     
    166167               ENDIF 
    167168               !                       !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 
    168                palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
    169                ! 
    170                palb_cs(ji,jj,jl) = palb_os(ji,jj,jl)  & 
    171                   &                - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl)  & 
    172                   &                    + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 
    173                ! 
     169               zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
     170               ! 
     171               zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
     172                  &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
     173               ! 
     174               ! albedo depends on cloud fraction because of non-linear spectral effects 
     175               palb_ice(ji,jj,jl) = ( 1._wp - pcloud_fra(ji,jj) ) * zalb_cs + pcloud_fra(ji,jj) * zalb_os 
     176 
    174177            END DO 
    175178         END DO 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icesbc.F90

    r12720 r12785  
    116116      INTEGER  ::   ji, jj, jl      ! dummy loop index 
    117117      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
    118       REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    119       REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
     118      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    120119      !!-------------------------------------------------------------------- 
    121120      ! 
     
    131130      CALL iom_miss_val( "icetemp", zmiss_val ) 
    132131 
    133       ! --- cloud-sky and overcast-sky ice albedos --- ! 
    134       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, zalb_cs, zalb_os ) 
    135  
    136       ! albedo depends on cloud fraction because of non-linear spectral effects 
    137 !!gm cldf_ice is a real, DOCTOR naming rule: start with cd means CHARACTER passed in argument ! 
    138       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    139       ! 
     132      ! --- ice albedo --- ! 
     133      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) 
     134 
    140135      ! 
    141136      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/iceupdate.F90

    r12720 r12785  
    9494      REAL(wp) ::   zqmass           ! Heat flux associated with mass exchange ice->ocean (W.m-2) 
    9595      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
    96       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  ! 2D workspace 
    97       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_cs, zalb_os     ! 3D workspace 
     96      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
    9897      !!--------------------------------------------------------------------- 
    9998      IF( ln_timing )   CALL timing_start('ice_update') 
     
    185184      ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 
    186185      !------------------------------------------------------------------ 
    187       CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 
    188       ! 
    189       alb_ice(:,:,:) = ( 1._wp - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     186      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) ! ice albedo 
     187 
    190188      ! 
    191189      IF( lrst_ice ) THEN                       !* write snwice_mass fields in the restart file 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbc_ice.F90

    r12733 r12785  
    6969   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_oce        !: evap - precip over ocean                 [kg/m2/s] 
    7070   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wndm_ice       !: wind speed module at T-point                 [m/s] 
    71    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: wind speed module at T-point                 [m/s] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sstfrz         !: sea surface freezing temperature            [degC] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cloud_fra      !: cloud cover                                    [-] 
    7273#endif 
    7374 
     
    132133         &      qemp_ice(jpi,jpj)     , qevap_ice(jpi,jpj,jpl) , qemp_oce   (jpi,jpj)     ,   & 
    133134         &      qns_oce (jpi,jpj)     , qsr_oce  (jpi,jpj)     , emp_oce    (jpi,jpj)     ,   & 
    134          &      emp_ice (jpi,jpj)     , sstfrz   (jpi,jpj)     , STAT= ierr(2) ) 
     135         &      emp_ice (jpi,jpj)     , sstfrz   (jpi,jpj)     , cloud_fra  (jpi,jpj)     , STAT= ierr(2) ) 
    135136#endif 
    136137 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbcblk.F90

    r12276 r12785  
    8080   REAL(wp), PARAMETER ::   rctv0 = R_vap/R_dry   !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 
    8181 
    82    INTEGER , PARAMETER ::   jpfld   =10           ! maximum number of files to read 
     82   INTEGER , PARAMETER ::   jpfld   =11           ! maximum number of files to read 
    8383   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    8484   INTEGER , PARAMETER ::   jp_wndj = 2           ! index of 10m wind velocity (j-component) (m/s)    at T-point 
     
    9090   INTEGER , PARAMETER ::   jp_snow = 8           ! index of snow (solid prcipitation)       (kg/m2/s) 
    9191   INTEGER , PARAMETER ::   jp_slp  = 9           ! index of sea level pressure              (Pa) 
    92    INTEGER , PARAMETER ::   jp_tdif =10           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
     92   INTEGER , PARAMETER ::   jp_cc   =10           ! index of cloud cover                     (-)      range:0-1 
     93   INTEGER , PARAMETER ::   jp_tdif =11           ! index of tau diff associated to HF tau   (N/m2)   at T-point 
    9394 
    9495   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
     
    161162      !! 
    162163      !!---------------------------------------------------------------------- 
    163       INTEGER  ::   ifpr, jfld            ! dummy loop indice and argument 
     164      INTEGER  ::   jfpr, jfld            ! dummy loop indice and argument 
    164165      INTEGER  ::   ios, ierror, ioptio   ! Local integer 
    165166      !! 
     
    168169      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    169170      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !       "                        " 
    170       TYPE(FLD_N) ::   sn_slp , sn_tdif                        !       "                        " 
     171      TYPE(FLD_N) ::   sn_slp , sn_tdif, sn_cc                 !       "                        " 
    171172      NAMELIST/namsbc_blk/ sn_wndi, sn_wndj, sn_humi, sn_qsr, sn_qlw ,                &   ! input fields 
    172          &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif,                & 
     173         &                 sn_tair, sn_prec, sn_snow, sn_slp, sn_tdif, sn_cc,         & 
    173174         &                 ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF,             &   ! bulk algorithm 
    174175         &                 cn_dir , ln_taudif, rn_zqt, rn_zu,                         &  
     
    214215      slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    215216      slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    216       slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_tdif) = sn_tdif 
     217      slf_i(jp_slp)  = sn_slp    ;   slf_i(jp_cc)   = sn_cc 
     218      slf_i(jp_tdif) = sn_tdif 
    217219      ! 
    218220      lhftau = ln_taudif                     !- add an extra field if HF stress is used 
     
    222224      ALLOCATE( sf(jfld), STAT=ierror ) 
    223225      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_init: unable to allocate sf structure' ) 
    224       DO ifpr= 1, jfld 
    225          ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    226          IF( slf_i(ifpr)%ln_tint )   ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    227          IF( slf_i(ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )   & 
    228             &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.',   & 
    229             &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
    230  
    231       END DO 
     226 
    232227      !                                      !- fill the bulk structure with namelist informations 
    233228      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
    234229      ! 
     230      DO jfpr = 1, jfld 
     231         ! 
     232         IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN    !--  not used field  --!   (only now allocated and set to zero) 
     233            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     234            sf(jfpr)%fnow(:,:,1) = 0._wp 
     235         ELSE                                                  !-- used field --! 
     236            ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 
     237            IF( slf_i(jfpr)%ln_tint )   ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 
     238            IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 )                      & 
     239               &  CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 
     240               &                 '               This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) 
     241         ENDIF 
     242      ENDDO 
     243      ! fill cloud cover array with constant value if "not used" 
     244      IF( TRIM(sf(jp_cc)%clrootname) == 'NOT USED' )   sf(jp_cc)%fnow(:,:,1) = cldf_ice 
     245          
    235246      IF ( ln_wave ) THEN 
    236247      !Activated wave module but neither drag nor stokes drift activated 
     
    792803      REAL(wp) ::   zst3                     ! local variable 
    793804      REAL(wp) ::   zcoef_dqlw, zcoef_dqla   !   -      - 
    794       REAL(wp) ::   zztmp, z1_rLsub           !   -      - 
    795       REAL(wp) ::   zfr1, zfr2               ! local variables 
     805      REAL(wp) ::   zztmp, z1_rLsub          !   -      - 
    796806      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z1_st         ! inverse of surface temperature 
    797807      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z_qlw         ! long wave heat flux over ice 
     
    802812      REAL(wp), DIMENSION(jpi,jpj)     ::   zrhoa 
    803813      REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp, ztmp2 
     814      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri 
    804815      !!--------------------------------------------------------------------- 
    805816      ! 
     
    903914      END DO 
    904915 
     916      ! --- cloud cover --- ! 
     917      cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 
     918       
    905919      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 
    906       zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm 
    907       zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1 
    908       ! 
    909       WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    910          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    911       ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm 
    912          qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 
    913       ELSEWHERE                                                         ! zero when hs>0 
    914          qtr_ice_top(:,:,:) = 0._wp  
    915       END WHERE 
     920      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm 
     921      ! 
     922      DO jl = 1, jpl 
     923         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     924            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     925         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     926            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     927         ELSEWHERE                                                         ! zero when hs>0 
     928            qtr_ice_top(:,:,jl) = 0._wp  
     929         END WHERE 
     930      ENDDO 
    916931      ! 
    917932 
  • NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90

    r12742 r12785  
    16541654      ! 
    16551655      INTEGER  ::   ji, jj, jl   ! dummy loop index 
    1656       REAL(wp) ::   ztri         ! local scalar 
    16571656      REAL(wp), DIMENSION(jpi,jpj)     ::   zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 
    16581657      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip  , zevap_oce, zdevap_ice 
     
    16601659      REAL(wp), DIMENSION(jpi,jpj)     ::   zevap_ice_total 
    16611660      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 
     1661      REAL(wp), DIMENSION(jpi,jpj)     ::   ztri, zcloud_fra 
    16621662      !!---------------------------------------------------------------------- 
    16631663      ! 
     
    16941694      IF (ln_scale_ice_flux) THEN ! typically met-office requirements 
    16951695         IF (sn_rcv_emp%clcat == 'yes') THEN 
    1696             WHERE( a_i(:,:,:) > 1.e-10) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
    1697             ELSEWHERE                   ; zevap_ice(:,:,:) = 0._wp 
     1696            WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 
     1697            ELSEWHERE                     ; zevap_ice(:,:,:) = 0._wp 
    16981698            END WHERE 
    1699             zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:), dim=3 ) 
     1699            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 
     1700            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp 
     1701            END WHERE 
    17001702         ELSE 
    1701             WHERE( picefr(:,:) > 1.e-10) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 
    1702             ELSEWHERE                    ; zevap_ice(:,:,1) = 0._wp 
     1703            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 
     1704            ELSEWHERE                     ; zevap_ice(:,:,1) = 0._wp 
    17031705            END WHERE 
    17041706            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1707            DO jl = 2, jpl 
     1708               zevap_ice(:,:,jl) = zevap_ice(:,:,1) 
     1709            ENDDO 
    17051710         ENDIF 
    17061711      ELSE 
    17071712         IF (sn_rcv_emp%clcat == 'yes') THEN 
    17081713            zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 
    1709             zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:), dim=3 ) 
     1714            WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 
     1715            ELSEWHERE                     ; zevap_ice_total(:,:) = 0._wp 
     1716            END WHERE 
    17101717         ELSE 
    17111718            zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 
    17121719            zevap_ice_total(:,:) = zevap_ice(:,:,1) 
     1720            DO jl = 2, jpl 
     1721               zevap_ice(:,:,jl) = zevap_ice(:,:,1) 
     1722            ENDDO 
    17131723         ENDIF 
    17141724      ENDIF 
     
    20852095         ENDIF 
    20862096      END SELECT 
     2097!!$      !                                                      ! ========================= ! 
     2098!!$      SELECT CASE( TRIM( sn_rcv_clouds%cldes ) )             !       cloud fraction      ! 
     2099!!$      !                                                      ! ========================= ! 
     2100!!$         cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 
     2101!!$      END SELECT 
     2102      zcloud_fra(:,:) = cldf_ice   ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 
     2103      IF( ln_mixcpl ) THEN 
     2104         cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 
     2105      ELSE 
     2106         cloud_fra(:,:) = zcloud_fra(:,:) 
     2107      ENDIF 
    20872108      !                                                      ! ========================= ! 
    20882109      !                                                      !      Transmitted Qsr      !   [W/m2] 
     
    20912112         ! 
    20922113         !                    ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 
    2093          ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice    ! surface transmission when hi>10cm (Grenfell Maykut 77) 
     2114         !                    !      should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 
     2115         ztri(:,:) = 0.18 * ( 1.0 - zcloud_fra(:,:) ) + 0.35 * zcloud_fra(:,:)  ! surface transmission when hi>10cm (Grenfell Maykut 77) 
    20942116         ! 
    2095          WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm   
    2096             zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 
    2097          ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (ztri) when hi>10cm 
    2098             zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 
    2099          ELSEWHERE                                                         ! zero when hs>0 
    2100             zqtr_ice_top(:,:,:) = 0._wp 
    2101          END WHERE 
     2117         DO jl = 1, jpl 
     2118            WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm   
     2119               zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 
     2120            ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm 
     2121               zqtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:) 
     2122            ELSEWHERE                                                         ! zero when hs>0 
     2123               zqtr_ice_top(:,:,jl) = 0._wp 
     2124            END WHERE 
     2125         ENDDO 
    21022126         !      
    21032127      ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN      !==  conduction flux as surface forcing  ==! 
Note: See TracChangeset for help on using the changeset viewer.