Changeset 12785
- Timestamp:
- 2020-04-20T20:48:56+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl
- Files:
-
- 8 edited
-
cfgs/SHARED/namelist_ref (modified) (1 diff)
-
doc/namelists/namsbc_blk (modified) (1 diff)
-
src/ICE/icealb.F90 (modified) (4 diffs)
-
src/ICE/icesbc.F90 (modified) (2 diffs)
-
src/ICE/iceupdate.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbc_ice.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbcblk.F90 (modified) (9 diffs)
-
src/OCE/SBC/sbccpl.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/cfgs/SHARED/namelist_ref
r12733 r12785 281 281 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 282 282 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' , '' , '' 283 284 sn_tdif = 'taudif_core' , 24 , 'taudif' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 284 285 / -
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/doc/namelists/namsbc_blk
r11703 r12785 31 31 sn_snow = 'ncar_precip.15JUNE2009_fill', -1. , 'SNOW' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 32 32 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' , '' , '' 33 34 sn_tdif = 'taudif_core' , 24 , 'taudif' , .false. , .true. , 'yearly' , 'weights_core_orca2_bilinear_noc.nc' , '' , '' 34 35 / -
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icealb.F90
r12725 r12785 45 45 CONTAINS 46 46 47 SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, p alb_cs, palb_os)47 SUBROUTINE ice_alb( pt_su, ph_ice, ph_snw, ld_pnd_alb, pafrac_pnd, ph_pnd, pcloud_fra, palb_ice ) 48 48 !!---------------------------------------------------------------------- 49 49 !! *** ROUTINE ice_alb *** … … 97 97 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pafrac_pnd ! melt pond relative fraction (per unit ice area) 98 98 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ph_pnd ! melt pond depth 99 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_cs ! albedo of ice under clear sky100 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_ os ! albedo of ice under overcast sky99 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pcloud_fra ! cloud fraction 100 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb_ice ! albedo of ice 101 101 ! 102 102 INTEGER :: ji, jj, jl ! dummy loop indices … … 106 106 REAL(wp) :: zalb_ice, zafrac_ice ! bare sea ice albedo & relative ice fraction 107 107 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 108 109 !!--------------------------------------------------------------------- 109 110 ! … … 166 167 ENDIF 167 168 ! !--- 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 174 177 END DO 175 178 END DO -
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/icesbc.F90
r12720 r12785 116 116 INTEGER :: ji, jj, jl ! dummy loop index 117 117 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 120 119 !!-------------------------------------------------------------------- 121 120 ! … … 131 130 CALL iom_miss_val( "icetemp", zmiss_val ) 132 131 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 140 135 ! 141 136 SELECT CASE( ksbc ) !== fluxes over sea ice ==! -
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/ICE/iceupdate.F90
r12720 r12785 94 94 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 95 95 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 98 97 !!--------------------------------------------------------------------- 99 98 IF( ln_timing ) CALL timing_start('ice_update') … … 185 184 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) 186 185 !------------------------------------------------------------------ 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 190 188 ! 191 189 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 69 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 70 70 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 [-] 72 73 #endif 73 74 … … 132 133 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 133 134 & 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) ) 135 136 #endif 136 137 -
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbcblk.F90
r12276 r12785 80 80 REAL(wp), PARAMETER :: rctv0 = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 81 81 82 INTEGER , PARAMETER :: jpfld =1 0! maximum number of files to read82 INTEGER , PARAMETER :: jpfld =11 ! maximum number of files to read 83 83 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 84 84 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point … … 90 90 INTEGER , PARAMETER :: jp_snow = 8 ! index of snow (solid prcipitation) (kg/m2/s) 91 91 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 93 94 94 95 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) … … 161 162 !! 162 163 !!---------------------------------------------------------------------- 163 INTEGER :: ifpr, jfld ! dummy loop indice and argument164 INTEGER :: jfpr, jfld ! dummy loop indice and argument 164 165 INTEGER :: ios, ierror, ioptio ! Local integer 165 166 !! … … 168 169 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 169 170 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 ! " " 171 172 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, & 173 174 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF, & ! bulk algorithm 174 175 & cn_dir , ln_taudif, rn_zqt, rn_zu, & … … 214 215 slf_i(jp_tair) = sn_tair ; slf_i(jp_humi) = sn_humi 215 216 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 217 219 ! 218 220 lhftau = ln_taudif !- add an extra field if HF stress is used … … 222 224 ALLOCATE( sf(jfld), STAT=ierror ) 223 225 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 232 227 ! !- fill the bulk structure with namelist informations 233 228 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 234 229 ! 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 235 246 IF ( ln_wave ) THEN 236 247 !Activated wave module but neither drag nor stokes drift activated … … 792 803 REAL(wp) :: zst3 ! local variable 793 804 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 ! - - 796 806 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_st ! inverse of surface temperature 797 807 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_qlw ! long wave heat flux over ice … … 802 812 REAL(wp), DIMENSION(jpi,jpj) :: zrhoa 803 813 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 814 REAL(wp), DIMENSION(jpi,jpj) :: ztri 804 815 !!--------------------------------------------------------------------- 805 816 ! … … 903 914 END DO 904 915 916 ! --- cloud cover --- ! 917 cloud_fra(:,:) = sf(jp_cc)%fnow(:,:,1) 918 905 919 ! --- 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 916 931 ! 917 932 -
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/SBC/sbccpl.F90
r12742 r12785 1654 1654 ! 1655 1655 INTEGER :: ji, jj, jl ! dummy loop index 1656 REAL(wp) :: ztri ! local scalar1657 1656 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1658 1657 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice … … 1660 1659 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total 1661 1660 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 1662 1662 !!---------------------------------------------------------------------- 1663 1663 ! … … 1694 1694 IF (ln_scale_ice_flux) THEN ! typically met-office requirements 1695 1695 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._wp1696 WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1697 ELSEWHERE ; zevap_ice(:,:,:) = 0._wp 1698 1698 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 1700 1702 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._wp1703 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 1703 1705 END WHERE 1704 1706 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1707 DO jl = 2, jpl 1708 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1709 ENDDO 1705 1710 ENDIF 1706 1711 ELSE 1707 1712 IF (sn_rcv_emp%clcat == 'yes') THEN 1708 1713 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 1710 1717 ELSE 1711 1718 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1712 1719 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1720 DO jl = 2, jpl 1721 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1722 ENDDO 1713 1723 ENDIF 1714 1724 ENDIF … … 2085 2095 ENDIF 2086 2096 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 2087 2108 ! ! ========================= ! 2088 2109 ! ! Transmitted Qsr ! [W/m2] … … 2091 2112 ! 2092 2113 ! ! ===> 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) 2094 2116 ! 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 2102 2126 ! 2103 2127 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==!
Note: See TracChangeset
for help on using the changeset viewer.
