*IF DEF,A01_1A,OR,DEF,A01_1B,OR,DEF,A01_2A,OR,DEF,A01_3A ADB1F400.1
C ******************************COPYRIGHT****************************** GTS2F400.3223
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3224
C GTS2F400.3225
C Use, duplication or disclosure of this code is subject to the GTS2F400.3226
C restrictions as set forth in the contract. GTS2F400.3227
C GTS2F400.3228
C Meteorological Office GTS2F400.3229
C London Road GTS2F400.3230
C BRACKNELL GTS2F400.3231
C Berkshire UK GTS2F400.3232
C RG12 2SZ GTS2F400.3233
C GTS2F400.3234
C If no contract has been raised with this copy of the code, the use, GTS2F400.3235
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3236
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3237
C Modelling at the above address. GTS2F400.3238
C ******************************COPYRIGHT****************************** GTS2F400.3239
C GTS2F400.3240
CLL Subroutine FTSA ------------------------------------------------- FTSA1A.3
CLL FTSA1A.4
CLL It calculates (true) surface albedos for P234. FTSA1A.5
CLL Release 2.8 of the UM allows for separate surface FTSA1A.6
CLL albedos for direct and diffuse light over sea, calculating the FTSA1A.7
CLL former from the formula of Briegleb and Ramanathan (1982, J. Appl. FTSA1A.8
CLL Met., 21, 1160-1171) and passes the albedos out in different form FTSA1A.9
CLL Land & ice albedos are still the same for direct and diffuse beams. FTSA1A.10
CLL William Ingram 25/9/92 FTSA1A.11
CLL Suitable for single column model use. FTSA1A.12
CLL FTSA1A.13
CLL Author: William Ingram FTSA1A.14
CLL FTSA1A.15
CLL Model Modification history from model version 3.0: FTSA1A.16
CLL version Date FTSA1A.17
CLL 3.1 25/1/93 alphaC and alphaM increased if version 2A of WI250193.1
CLL Section 1 is selected. WI250193.2
CLL 3.4 09/09/94 alphaC,alphaM,dTice all set in U.I. C D Hewitt AWA1F304.1398
CLL 4.0 04/07/95 MASKD set locally. William Ingram AWI2F400.3
! ADB1F400.2
! 4.0 01/09/95 Logical test for version of SW radiation ADB1F400.3
! introduced to allow for differing treatment ADB1F400.4
! of the direct beam by different versions of ADB1F400.5
! the radiation. ADB1F400.6
! J. M. Edwards ADB1F400.7
CLL FTSA1A.18
CLL 4.1 25/01/96 Set SAOS to SALI over land because SAOS is AJS1F401.1471
CLL used to find Net Surface SW in Band 1, which AJS1F401.1472
CLL is now required over land for photosythesis AJS1F401.1473
CLL modelling. AJS1F401.1474
CLL Richard Betts AJS1F401.1475
CLL AJS1F401.1476
CLL 4.4 17/09/97 Optional prognostic snow albedo scheme - ARE2F404.294
CLL separate albedos calculated for visible and ARE2F404.295
CLL near-infrared wavelengths, depending on snow ARE2F404.296
CLL grain size, soot content and zenith angle. ARE2F404.297
CLL Richard Essery ARE2F404.298
CLL ARE2F404.299
CLL 4.4 18/09/97 SNOW_FRAC and TSTAR_SNOW are fractional ARE2F404.300
CLL coverage and surface temperature for snow on ARE2F404.301
CLL land points if MOSES II is selected, set to ARE2F404.302
CLL 1 and TSTAR otherwise. ARE2F404.303
CLL Richard Essery ARE2F404.304
CLL 4.5 21.08.98 If l_ssice_albedo, the albedo of sea-ice is AJG1F405.32
CLL altered by the presence of snow. Jonathan Gregory AJG1F405.33
CLL ARE2F404.305
CLL ARE2F404.306
CLL It conforms to programming standard A of UMDP 4, version 2. FTSA1A.19
CLL It contains ! comments, but otherwise conforms to the FORTRAN 77 FTSA1A.20
CLL standard with no features deprecated by 8X. FTSA1A.21
CLL FTSA1A.22
CLL Logical components covered : P233 FTSA1A.23
CLL (ancillary calculations for the shortwave scheme) FTSA1A.24
CLL FTSA1A.25
CLL Project task : P23 FTSA1A.26
CLL FTSA1A.27
CLL Offline documentation is in UMDP 23, sections "True surface albedo FTSA1A.28
CLL specification" and "Modifications to the radiation scheme to FTSA1A.29
CLL accommodate the leads model" FTSA1A.30
CLLEND FTSA1A.31
C*L FTSA1A.32
SUBROUTINE FTSA ( 3ADB1F400.8
& LAND, AICE, TSTAR, TSTAR_SNOW, SNOW_FRAC, SFA, MDSA, COSZ, ARE2F404.307
& S, RGRAIN, SOOT, ARE2F404.308
& ALPHAM,ALPHAC,ALPHAB,DTICE,L_SSICE_ALBEDO, AJG1F405.36
& VERSION, ADB1F400.10
& L1, L2, L_SNOW_ALBEDO, SAL_DIM, SAL_VIS, SAL_NIR, SALI, SAOS) ARE2F404.309
! ADB1F400.11
implicit none AJG1F405.34
! AJG1F405.35
CHARACTER !, INTENT(IN) :: ADB1F400.12
& VERSION*3 ! Version of radiation scheme ADB1F400.13
INTEGER !, INTENT(IN) :: ADB1F400.14
& L1, ! Full field dimension FTSA1A.36
& L2 ! Number of points to treat FTSA1A.37
& ,SAL_DIM ! Dimensions SAL_VIS and ARE2F404.310
C ! SAL_NIR for prognostic snow ARE2F404.311
C ! albedo ARE2F404.312
LOGICAL !, INTENT(IN) :: ADB1F400.15
& LAND(L1) ! Land-sea mask (land .TRUE.) FTSA1A.39
& ,L_SNOW_ALBEDO ! Flag for prognostic snow ARE2F404.313
C ! albedo ARE2F404.314
! Switch on the effect of snow on sea-ice albedo AJG1F405.37
& ,L_SSICE_ALBEDO AJG1F405.38
REAL !, INTENT(IN) :: ADB1F400.16
& AICE(L1), ! Sea-ice fraction FTSA1A.41
& SNOW_FRAC(L1), ! Snow fraction ARE2F404.315
& TSTAR(L1), ! Surface temperature FTSA1A.42
& TSTAR_SNOW(L1), ! Snow surface temperature (K) ARE2F404.316
& SFA(L1), ! Snow-free surface albedo FTSA1A.43
& MDSA(L1), ! Cold deep-snow albedo FTSA1A.44
& ! (These two are alpha sub 0 & alpha sub S resp. in UMDP 23.) FTSA1A.45
& COSZ(L1), ! cos(solar zenith angle) FTSA1A.46
& RGRAIN(L1), ! Snow grain size (microns) ARE2F404.317
& SOOT(L1), ! Snow soot content (mass frac ARE2F404.318
& S(L1) ! Snow amount (mass/area) AWI2F400.5
! Constants used to determine the albedo of sea-ice: AJG1F405.39
! Albedo of sea-ice at melting point (TM) if .not.l_ssice_albedo, or AJG1F405.40
! Albedo of snow on sea-ice at melting point (TM) if l_ssice_albedo AJG1F405.41
& ,ALPHAM ! "M" for "melting" AJG1F405.42
! Albedo of sea-ice at and below TM-DTICE if .not.l_ssice_albedo, or AJG1F405.43
! Albedo of snow on sea-ice at and below TM-DTICE if l_ssice_albedo AJG1F405.44
& ,ALPHAC ! "C" for "cold" AJG1F405.45
! Albedo of snow-free sea-ice if l_ssice_albedo AJG1F405.46
& ,ALPHAB ! "B" for "bare" AJG1F405.47
! Temperature range in which albedo of sea-ice, if .not.l_ssice_albedo, AJG1F405.48
! or of snow on sea-ice, if l_ssice_albedo, varies between its limits AJG1F405.49
& ,DTICE AJG1F405.50
REAL!, INTENT(OUT) FTSA1A.49
& SAL_VIS(SAL_DIM,2), ! Visible albedo for land ARE2F404.319
& SAL_NIR(SAL_DIM,2), ! Near-IR albedo for land ARE2F404.320
& SALI(L1), ! Surface Albedos for Land FTSA1A.50
& SAOS(L1,2) ! and Ice, and for Open Sea, FTSA1A.51
C ! respectively, with zeroes for safety where no value applies FTSA1A.52
C FTSA1A.53
C ! FTSA has no dynamically allocated workspace, no EXTERNAL calls WI200893.39
C ! and no significant structure - just one loop and some IF blocks FTSA1A.55
C* FTSA1A.56
INTEGER J ! Loops over points FTSA1A.57
REAL DSA, ! Deep-snow albedo (alphasubD) FTSA1A.58
& TICE ! Surface temperature for FTSA1A.59
C ! the sea-ice covered fraction of a grid-box. FTSA1A.60
! Temperature at which (snow on) sea-ice reaches its "cold" value AJG1F405.51
& ,TCICE AJG1F405.52
! Slope and intercept of temperature dependence of the albedo of AJG1F405.53
! (snow on) sea-ice AJG1F405.54
& ,ICE1,ICE2 AJG1F405.55
! Local parameters AJG1F405.56
REAL DTLAND, KLAND, TCLAND, ADIFC, FCATM, AJG1F405.57
& ALB_DIFF, ! Diffuse beam snow albedo ARE2F404.321
& ALB_DIR, ! Direct beam snow albedo ARE2F404.322
& R0, ! Grain size for fresh snow ARE2F404.323
C ! (microns) ARE2F404.324
& REFF, ! Zenith effective grain size ARE2F404.325
& SIGMA, ! Scaled soot content ARE2F404.326
& SNOW_ALBEDO, ! Snow albedo ARE2F404.327
& MASK, ! Snow masking factor ARE2F404.328
& MASKD ! Masking depth (S in 3.6.1) AWI2F400.7
C Note that the same masking depth is always used, both for land, AJG1F405.58
C regardless of vegetation cover, and for sea-ice. This assumption AJG1F405.59
C of constancy may be doubtful. AJG1F405.60
PARAMETER ( MASKD = 0.2, R0 = 50. ) ARE2F404.329
*CALL C_0_DG_C 
FTSA1A.63
C ! Basic quantities for land CSSA calculations: FTSA1A.64
PARAMETER ( DTLAND = 2., ! delta(T) in 3.6.2 FTSA1A.65
& FCATM = 0.3 ) ! Fraction by which deep-snow FTSA1A.66
C ! albedo changes (from "cold" value towards snow-free value) at TM FTSA1A.67
C ! From these, 2 constants precalculated for efficiency in 3.6.2: FTSA1A.68
PARAMETER ( KLAND = 0.3/DTLAND, FTSA1A.69
& TCLAND = TM-DTLAND ) FTSA1A.70
C FTSA1A.71
PARAMETER ( ADIFC = 0.06 ) ! Surface albedo of ice-free FTSA1A.72
C ! sea for the diffuse beam FTSA1A.73
C ! derive 3 constants from the basic quantities (supplied in the AWA1F304.1402
C ! namelist RUNCNST) for sea-ice CSSA calculations: AWA1F304.1403
TCICE = TM - DTICE AWA1F304.1404
ICE1 = (ALPHAM-ALPHAC) / DTICE AWA1F304.1405
ICE2 = ALPHAM - TM*ICE1 AWA1F304.1406
AWA1F304.1407
C FTSA1A.80
C FTSA1A.81
ARE2F404.330
IF ( L_SNOW_ALBEDO ) THEN ARE2F404.331
C----------------------------------------------------------------------- ARE2F404.332
C Prognostic spectral snow albedos ARE2F404.333
C----------------------------------------------------------------------- ARE2F404.334
DO J=1,L2 ARE2F404.335
SALI(J) = 0. ARE2F404.336
IF (LAND(J)) THEN FTSA1A.83
ARE2F404.337
C Increased deep-snow albedo required for land ice points ARE2F404.338
IF ( MDSA(J) .GT. 0.78 ) MDSA(J) = 0.83 ARE2F404.339
ARE2F404.340
C Effective grain size for zenith angle ARE2F404.341
REFF = RGRAIN(J) * ( 1. + 0.77*(COSZ(J)-0.65) )**2 ARE2F404.342
ARE2F404.343
C Visible albedos ARE2F404.344
ALB_DIR = 1.2*MDSA(J) - 0.002*(SQRT(REFF)-SQRT(R0)) ARE2F404.345
ALB_DIFF = 1.2*MDSA(J) - 0.002*(SQRT(RGRAIN(J))-SQRT(R0)) ARE2F404.346
SIGMA = SOOT(J) * RGRAIN(J) / 0.0017 ARE2F404.347
IF ( SIGMA .GT. 1. ) THEN ARE2F404.348
ALB_DIR = 0.07 + 0.5*(ALB_DIR - 0.07) / (SIGMA**0.46) ARE2F404.349
ALB_DIFF = 0.07 + 0.5*(ALB_DIFF - 0.07) / (SIGMA**0.46) ARE2F404.350
ELSE ARE2F404.351
ALB_DIR = ALB_DIR - 0.5*(ALB_DIR - 0.07)*(SIGMA**0.6) ARE2F404.352
ALB_DIFF = ALB_DIFF - 0.5*(ALB_DIFF - 0.07)*(SIGMA**0.6) ARE2F404.353
ENDIF ARE2F404.354
SAL_VIS(J,1) = ALB_DIR ARE2F404.355
SAL_VIS(J,2) = ALB_DIFF ARE2F404.356
ARE2F404.357
C Near-IR albedos ARE2F404.358
ALB_DIR = 0.8*MDSA(J) - ARE2F404.359
& 0.18*( ALOG(SQRT(REFF)) - ALOG(SQRT(R0)) ) ARE2F404.360
ALB_DIFF = 0.8*MDSA(J) - ARE2F404.361
& 0.18*( ALOG(SQRT(RGRAIN(J))) - ALOG(SQRT(R0)) ) ARE2F404.362
SIGMA = SOOT(J) * RGRAIN(J) / 0.004 ARE2F404.363
IF ( SIGMA .GT. 1. ) THEN ARE2F404.364
ALB_DIR = 0.06 + 0.5*(ALB_DIR - 0.06) / (SIGMA**0.6) ARE2F404.365
ALB_DIFF = 0.06 + 0.5*(ALB_DIFF - 0.06) / (SIGMA**0.6) ARE2F404.366
ELSE ARE2F404.367
ALB_DIR = ALB_DIR - 0.5*(ALB_DIFF - 0.06)*(SIGMA**0.7) ARE2F404.368
ALB_DIFF = ALB_DIFF - 0.5*(ALB_DIFF - 0.06)*(SIGMA**0.7) ARE2F404.369
ENDIF ARE2F404.370
SAL_NIR(J,1) = ALB_DIR ARE2F404.371
SAL_NIR(J,2) = ALB_DIFF ARE2F404.372
ARE2F404.373
C Adjust albedos for snow depth and fraction ARE2F404.374
MASK = 1. ARE2F404.375
IF ( SNOW_FRAC(J).GT.0. ) MASK = EXP(-MASKD*S(J)/SNOW_FRAC(J)) ARE2F404.376
SAL_VIS(J,1) = (1. - SNOW_FRAC(J))*SFA(J) + SNOW_FRAC(J) * ARE2F404.377
& (SFA(J) + (SAL_VIS(J,1) - SFA(J))*(1. - MASK)) ARE2F404.378
SAL_VIS(J,2) = (1. - SNOW_FRAC(J))*SFA(J) + SNOW_FRAC(J) * ARE2F404.379
& (SFA(J) + (SAL_VIS(J,2) - SFA(J))*(1. - MASK)) ARE2F404.380
SAL_NIR(J,1) = (1. - SNOW_FRAC(J))*SFA(J) + SNOW_FRAC(J) * ARE2F404.381
& (SFA(J) + (SAL_NIR(J,1) - SFA(J))*(1. - MASK)) ARE2F404.382
SAL_NIR(J,2) = (1. - SNOW_FRAC(J))*SFA(J) + SNOW_FRAC(J) * ARE2F404.383
& (SFA(J) + (SAL_NIR(J,2) - SFA(J))*(1. - MASK)) ARE2F404.384
ENDIF ARE2F404.385
ENDDO ARE2F404.386
ARE2F404.387
ELSE ARE2F404.388
C----------------------------------------------------------------------- ARE2F404.389
C Diagnosed all-band snow albedo ARE2F404.390
C----------------------------------------------------------------------- ARE2F404.391
DO J=1,L2 ARE2F404.392
IF (LAND(J)) THEN ARE2F404.393
SALI(J) = SFA(J) ARE2F404.394
IF (SNOW_FRAC(J) .GT. 0.0) THEN ARE2F404.395
IF ( TSTAR_SNOW(J) .LT. TCLAND ) THEN ARE2F404.396
DSA = MDSA(J) FTSA1A.86
ELSE FTSA1A.87
DSA = MDSA(J) + KLAND * (SFA(J) - MDSA(J)) * ARE2F404.397
& (TSTAR_SNOW(J) - TCLAND) ARE2F404.398
ENDIF FTSA1A.89
SNOW_ALBEDO = SFA(J) + (DSA-SFA(J)) * ARE2F404.399
& ( 1. - EXP(-MASKD*S(J)/SNOW_FRAC(J)) ) ARE2F404.400
SALI(J) = (1. - SNOW_FRAC(J))*SFA(J) + ARE2F404.401
& SNOW_FRAC(J)*SNOW_ALBEDO ARE2F404.402
ENDIF ARE2F404.403
SAOS(J,1) = SALI(J) AJS1F401.1477
SAOS(J,2) = SALI(J) AJS1F401.1478
ENDIF ARE2F404.404
ENDDO ARE2F404.405
ARE2F404.406
ENDIF ! Prognostic or diagnostic snow albedo ARE2F404.407
ARE2F404.408
DO 100 J=1, L2 ARE2F404.409
IF ( .NOT. LAND(J) ) THEN ARE2F404.410
IF (VERSION.NE.'03A') THEN ADB1F400.17
SAOS(J,1) = 0.05 / ( 1.1 * COSZ(J)**1.4 + 0.15 ) ADB1F400.18
ELSE ADB1F400.19
SAOS(J, 1)=0.026/(COSZ(J)**1.7+0.065) ADB1F400.20
& +0.15*(COSZ(J)-0.1)*(COSZ(J)-0.5)*(COSZ(J)-1.0) ADB1F400.21
ENDIF ADB1F400.22
SAOS(J,2) = ADIFC FTSA1A.96
C ! Note that the following will add in ICE1*(TSTAR-TFS) to CSSA FTSA1A.97
C ! if AICE#0 when it should be - even if only very small: for FTSA1A.98
C ! large enough TSTAR this will give very large surface heating FTSA1A.99
C ! and even negative atmospheric heating. Check whether this FTSA1A.100
C ! could occur. FTSA1A.101
IF ( AICE(J) .EQ. 0. ) THEN FTSA1A.102
SALI(J) = 0. FTSA1A.103
ELSE FTSA1A.104
C ! Recover TICE from TSTAR: FTSA1A.105
TICE = ( TSTAR(J) + (AICE(J)-1.) * TFS ) / AICE(J) FTSA1A.106
if (l_ssice_albedo) then AJG1F405.61
if (s(j).gt.0.0) then AJG1F405.62
if (tice.gt.tcice) then AJG1F405.63
snow_albedo=ice2+ice1*tice AJG1F405.64
else AJG1F405.65
snow_albedo=alphac AJG1F405.66
endif AJG1F405.67
sali(j)=alphab AJG1F405.68
& +(snow_albedo-alphab)*(1.0-exp(-maskd*s(j))) AJG1F405.69
else AJG1F405.70
sali(j)=alphab AJG1F405.71
endif AJG1F405.72
else AJG1F405.73
C ! 3.5.1: FTSA1A.107
IF ( TICE .LT. TCICE ) THEN FTSA1A.108
SALI(J) = ALPHAC FTSA1A.109
ELSE FTSA1A.110
SALI(J) = ICE1 * TICE + ICE2 FTSA1A.111
ENDIF FTSA1A.112
endif AJG1F405.74
ENDIF FTSA1A.113
ENDIF FTSA1A.114
100 CONTINUE FTSA1A.115
C FTSA1A.116
RETURN FTSA1A.117
END FTSA1A.118
*ENDIF DEF,A01_1A,OR,DEF,A01_1B,OR,DEF,A01_2A,OR,DEF,A01_3A ADB1F400.23