Changeset 15603 for branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
- Timestamp:
- 2021-12-16T10:39:55+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
r12555 r15603 21 21 USE lib_mpp ! MPP library 22 22 USE wrk_nemo ! work arrays 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 24 USE stopack 24 25 25 26 IMPLICIT NONE … … 30 31 31 32 INTEGER :: albd_init = 0 !: control flag for initialization 32 33 33 34 REAL(wp) :: rmue = 0.40 ! cosine of local solar altitude 34 35 REAL(wp) :: ralb_oce = 0.066 ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001) … … 36 37 REAL(wp) :: c2 = 0.10 ! " " 37 38 REAL(wp) :: rcloud = 0.06 ! cloud effect on albedo (only-for nn_ice_alb=0) 38 39 39 40 ! !!* namelist namsbc_alb 40 41 INTEGER :: nn_ice_alb … … 51 52 !!---------------------------------------------------------------------- 52 53 !! *** ROUTINE albedo_ice *** 53 !! 54 !! ** Purpose : Computation of the albedo of the snow/ice system 55 !! 54 !! 55 !! ** Purpose : Computation of the albedo of the snow/ice system 56 !! 56 57 !! ** Method : Two schemes are available (from namelist parameter nn_ice_alb) 57 58 !! 0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies … … 72 73 !! ** Note : The parameterization from Shine & Henderson-Sellers presents several misconstructions: 73 74 !! 1) ice albedo when ice thick. tends to 0 is different than ocean albedo 74 !! 2) for small ice thick. covered with some snow (<3cm?), albedo is larger 75 !! 2) for small ice thick. covered with some snow (<3cm?), albedo is larger 75 76 !! under melting conditions than under freezing conditions 76 !! 3) the evolution of ice albedo as a function of ice thickness shows 77 !! 3) the evolution of ice albedo as a function of ice thickness shows 77 78 !! 3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic 78 79 !! 79 80 !! References : Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250. 80 81 !! Brandt et al. 2005, J. Climate, vol 18 81 !! Grenfell & Perovich 2004, JGR, vol 109 82 !! Grenfell & Perovich 2004, JGR, vol 109 82 83 !!---------------------------------------------------------------------- 83 84 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pt_ice ! ice surface temperature (Kelvin) … … 96 97 97 98 ijpl = SIZE( pt_ice, 3 ) ! number of ice categories 98 99 99 100 CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it ) 100 101 101 IF( albd_init == 0 ) CALL albedo_init ! initialization 102 103 102 IF( albd_init == 0 ) CALL albedo_init ! initialization 103 104 104 105 SELECT CASE ( nn_ice_alb ) 105 106 … … 108 109 !------------------------------------------ 109 110 CASE( 0 ) 110 111 111 112 ralb_sf = 0.80 ! dry snow 112 113 ralb_sm = 0.65 ! melting snow 113 114 ralb_if = 0.72 ! bare frozen ice 114 ralb_im = rn_albice ! bare puddled ice 115 115 ralb_im = rn_albice ! bare puddled ice 116 116 117 ! Computation of ice albedo (free of snow) 117 118 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb(:,:,:) = ralb_im 118 119 ELSE WHERE ; zalb(:,:,:) = ralb_if 119 120 END WHERE 120 121 121 122 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb 122 123 ELSE WHERE( 1.0 < ph_ice .AND. ph_ice <= 1.5 ) ; zalb_it = 0.472 + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 ) … … 126 127 ELSE WHERE ; zalb_it = 0.1 + 3.6 * ph_ice 127 128 END WHERE 128 129 129 130 DO jl = 1, ijpl 130 131 DO jj = 1, jpj … … 132 133 ! freezing snow 133 134 ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2 134 ! ! freezing snow 135 ! ! freezing snow 135 136 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 136 137 zalb_sf = ( 1._wp - zswitch ) * ( zalb_it(ji,jj,jl) & 137 138 & + ph_snw(ji,jj,jl) * ( ralb_sf - zalb_it(ji,jj,jl) ) / c1 ) & 138 & + zswitch * ralb_sf 139 & + zswitch * ralb_sf 139 140 140 141 ! melting snow … … 142 143 zswitch = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) ) 143 144 zalb_sm = ( 1._wp - zswitch ) * ( ralb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im ) / c2 ) & 144 & + zswitch * ralb_sm 145 & + zswitch * ralb_sm 145 146 ! 146 147 ! snow albedo 147 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 148 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 148 149 zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 149 150 150 151 ! Ice/snow albedo 151 152 zswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) … … 154 155 END DO 155 156 END DO 157 158 #if defined key_traldf_c2d || key_traldf_c3d 159 IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 160 & CALL spp_gen( 1, pa_ice_cs(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl ) 161 #else 162 IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 163 & CALL ctl_stop( 'albedo_ice: parameter perturbation will only work with '// & 164 'key_traldf_c2d or key_traldf_c3d') 165 #endif 156 166 END DO 157 167 … … 161 171 ! New parameterization (2016) 162 172 !------------------------------------------ 163 CASE( 1 ) 173 CASE( 1 ) 164 174 165 175 ralb_im = rn_albice ! bare puddled ice … … 176 186 ! ralb_sm = 0.82 ! melting snow 177 187 ! ralb_if = 0.54 ! bare frozen ice 178 ! 188 ! 179 189 ! Computation of ice albedo (free of snow) 180 z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 190 z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 181 191 z1_c2 = 1. / 0.05 182 192 WHERE ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice ) ; zalb = ralb_im 183 193 ELSE WHERE ; zalb = ralb_if 184 194 END WHERE 185 195 186 196 WHERE ( 1.5 < ph_ice ) ; zalb_it = zalb 187 197 ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 ) ; zalb_it = zalb + ( 0.18 - zalb ) * z1_c1 * & … … 200 210 201 211 ! snow albedo 202 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 212 zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 203 213 zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 204 214 205 ! Ice/snow albedo 215 ! Ice/snow albedo 206 216 zswitch = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 207 217 pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch * zalb_it(ji,jj,jl) … … 209 219 END DO 210 220 END DO 221 222 #if defined key_traldf_c2d || key_traldf_c3d 223 IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 224 & CALL spp_gen( 1, pa_ice_os(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl ) 225 #else 226 IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 227 & CALL ctl_stop( 'albedo_ice: parameter perturbation will only work with '// & 228 'key_traldf_c2d or key_traldf_c3d') 229 #endif 211 230 END DO 212 231 ! Effect of the clouds (2d order polynomial) 213 pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 232 pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 214 233 215 234 END SELECT 216 235 217 236 CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it ) 218 237 ! … … 223 242 !!---------------------------------------------------------------------- 224 243 !! *** ROUTINE albedo_oce *** 225 !! 244 !! 226 245 !! ** Purpose : Computation of the albedo of the ocean 227 246 !!---------------------------------------------------------------------- … … 229 248 REAL(wp), DIMENSION(:,:), INTENT(out) :: pa_oce_cs ! albedo of ocean under clear sky 230 249 !! 231 REAL(wp) :: zcoef 250 REAL(wp) :: zcoef 232 251 !!---------------------------------------------------------------------- 233 252 ! 234 253 zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 ) ! Parameterization of Briegled and Ramanathan, 1982 235 pa_oce_cs(:,:) = zcoef 254 pa_oce_cs(:,:) = zcoef 236 255 pa_oce_os(:,:) = 0.06 ! Parameterization of Kondratyev, 1969 and Payne, 1972 237 256 ! … … 248 267 !!---------------------------------------------------------------------- 249 268 INTEGER :: ios ! Local integer output status for namelist read 250 NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice 269 NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice 251 270 !!---------------------------------------------------------------------- 252 271 !
Note: See TracChangeset
for help on using the changeset viewer.
