*IF DEF,A01_2B FTSA2B.2
C ******************************COPYRIGHT****************************** FTSA2B.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. FTSA2B.4
C FTSA2B.5
C Use, duplication or disclosure of this code is subject to the FTSA2B.6
C restrictions as set forth in the contract. FTSA2B.7
C FTSA2B.8
C Meteorological Office FTSA2B.9
C London Road FTSA2B.10
C BRACKNELL FTSA2B.11
C Berkshire UK FTSA2B.12
C RG12 2SZ FTSA2B.13
C FTSA2B.14
C If no contract has been raised with this copy of the code, the use, FTSA2B.15
C duplication or disclosure of it is strictly prohibited. Permission FTSA2B.16
C to do so must first be obtained in writing from the Head of Numerical FTSA2B.17
C Modelling at the above address. FTSA2B.18
C ******************************COPYRIGHT****************************** FTSA2B.19
C FTSA2B.20
CLL Subroutine FTSA ------------------------------------------------- FTSA2B.21
CLL FTSA2B.22
CLL It calculates (true) surface albedos for P234. FTSA2B.23
CLL This version (2B) can modify the surface albedo for the direct AWI1F403.362
CLL beam to mimic the effect of a layer of anthropogenic sulphate FTSA2B.25
CLL aerosol using the first-order approximation following Charlock FTSA2B.26
CLL & al (1991), as part of "HADCM2 physics" (v Mitchell & al 1995). FTSA2B.27
CLL Otherwise it matches the standard routine. FTSA2B.28
CLL William Ingram 19/11/96 FTSA2B.29
CLL Suitable for single column model use. FTSA2B.30
CLL FTSA2B.31
CLL Author: William Ingram FTSA2B.32
CLL FTSA2B.33
CLL Model Modification history: FTSA2B.34
CLL version Date FTSA2B.35
CLL 4.2 19/11/96 Written William Ingram, reviewed Cath Senior. FTSA2B.36
CLL 4.3 18/3/97 Make sulphate calculations optional. WJI AWI1F403.363
CLL FTSA2B.37
CLL It conforms to programming standard A of UMDP 4, version 2. FTSA2B.38
CLL It contains ! comments, but otherwise conforms to the FORTRAN 77 FTSA2B.39
CLL standard with no features deprecated by 8X. FTSA2B.40
CLL FTSA2B.41
CLL Logical components covered : P233 FTSA2B.42
CLL (ancillary calculations for the shortwave scheme) FTSA2B.43
CLL FTSA2B.44
CLL Project task : P23 FTSA2B.45
CLL FTSA2B.46
CLL Offline documentation is in UMDP 23, sections "True surface albedo FTSA2B.47
CLL specification" and "Modifications to the radiation scheme to FTSA2B.48
CLL accommodate the leads model" FTSA2B.49
CLLEND FTSA2B.50
C*L FTSA2B.51
SUBROUTINE FTSA ( 3FTSA2B.52
& LAND, AICE, TSTAR, SFA, MDSA, COSZ, S, SULPH, FTSA2B.53
& ALPHAC, ALPHAM, DTICE, FTSA2B.54
& SANAON, NLALBS, NSULPAT, AWI1F403.364
& L1, L2, FTSA2B.55
& SALI, SAOS, SANA) FTSA2B.56
! FTSA2B.57
INTEGER !, INTENT(IN) :: FTSA2B.58
& L1, ! Full field dimension FTSA2B.59
& L2 ! Number of points to treat FTSA2B.60
LOGICAL !, INTENT(IN) :: FTSA2B.61
& LAND(L1) ! Land-sea mask (land .TRUE.) FTSA2B.62
& , SANAON ! Is SANA to be output ? AWI1F403.365
REAL !, INTENT(IN) :: FTSA2B.63
& AICE(L1), ! Sea-ice fraction FTSA2B.64
& TSTAR(L1), ! Surface temperature FTSA2B.65
& SFA(L1), ! Snow-free surface albedo FTSA2B.66
& MDSA(L1), ! Cold deep-snow albedo FTSA2B.67
& ! (These two are alpha sub 0 & alpha sub S resp. in UMDP 23.) FTSA2B.68
& COSZ(L1), ! cos(solar zenith angle) FTSA2B.69
& S(L1), ! Snow amount (mass/area) FTSA2B.70
& SULPH(L1) ! sulphate loading pattern FTSA2B.71
REAL!, INTENT(OUT) FTSA2B.72
& SALI(L1,NLALBS), ! Surface Albedos for Land AWI1F403.366
& SAOS(L1,2), ! and Ice, and for Open Sea, FTSA2B.74
C ! respectively, with zeroes for safety where no value applies FTSA2B.75
& SANA(L1,2) FTSA2B.76
C ! Grid box mean albedo as it would be with no aerosol. FTSA2B.77
C FTSA2B.78
C ! FTSA has no dynamically allocated workspace, no EXTERNAL calls FTSA2B.79
C ! and no significant structure - just a single loop and some FTSA2B.80
C ! IF blocks. FTSA2B.81
C* FTSA2B.82
INTEGER J ! Loops over points FTSA2B.83
REAL DSA, ! Deep-snow albedo (alphasubD) FTSA2B.84
& TICE ! Surface temperature for FTSA2B.85
C ! the sea-ice covered fraction of a grid-box. FTSA2B.86
REAL DTLAND, KLAND, TCLAND, ADIFC, ALPHAC, ALPHAM, DTICE, TCICE, FTSA2B.87
& ICE1, ICE2, ! Local PARAMETERs FTSA2B.88
& MASKD ! Masking depth (S in 3.6.1) FTSA2B.89
& , ALPHA, BETA ! Mass scattering coefficient FTSA2B.90
C ! and upward scattering fraction for the anthropogenic sulphate FTSA2B.91
& , AERCON ! Their product FTSA2B.92
PARAMETER ( MASKD = 0.2 ) FTSA2B.93
*CALL C_0_DG_C 
FTSA2B.94
C ! Basic quantities for land CSSA calculations: FTSA2B.95
PARAMETER ( DTLAND = 2., ! delta(T) in 3.6.2 FTSA2B.96
& FCATM = 0.3 ) ! Fraction by which deep-snow FTSA2B.97
C ! albedo changes (from "cold" value towards snow-free value) at TM FTSA2B.98
C ! From these, 2 constants precalculated for efficiency in 3.6.2: FTSA2B.99
PARAMETER ( KLAND = 0.3/DTLAND, FTSA2B.100
& TCLAND = TM-DTLAND ) FTSA2B.101
C FTSA2B.102
PARAMETER ( ADIFC = 0.06 ) ! Surface albedo of ice-free FTSA2B.103
C ! sea for the diffuse beam FTSA2B.104
PARAMETER ( ALPHA = 8500., BETA = 0.29, FTSA2B.105
& AERCON = ALPHA*BETA ) FTSA2B.106
FTSA2B.107
C ! derive 3 constants from the basic quantities (supplied in the FTSA2B.108
C ! namelist RUNCNST) for sea-ice CSSA calculations: FTSA2B.109
TCICE = TM - DTICE FTSA2B.110
ICE1 = (ALPHAM-ALPHAC) / DTICE FTSA2B.111
ICE2 = ALPHAM - TM*ICE1 FTSA2B.112
C FTSA2B.113
C FTSA2B.114
DO 100 J=1, L2 FTSA2B.115
IF (LAND(J)) THEN FTSA2B.116
C 3.6.2: FTSA2B.117
IF ( TSTAR(J) .LT. TCLAND ) THEN FTSA2B.118
DSA = MDSA(J) FTSA2B.119
ELSE FTSA2B.120
DSA= MDSA(J) + KLAND * (SFA(J)-MDSA(J)) * (TSTAR(J)-TCLAND) FTSA2B.121
ENDIF FTSA2B.122
C 3.6.1: FTSA2B.123
SALI(J,1) = SFA(J) + ( DSA-SFA(J) ) * (1. - EXP(-MASKD*S(J)) ) FTSA2B.124
SAOS(J,1) = SALI(J,1) FTSA2B.125
SAOS(J,2) = SALI(J,1) FTSA2B.126
ELSE FTSA2B.127
SAOS(J,1) = 0.05 / ( 1.1 * COSZ(J)**1.4 + 0.15 ) FTSA2B.128
SAOS(J,2) = ADIFC FTSA2B.129
C ! Note that the following will add in ICE1*(TSTAR-TFS) to CSSA FTSA2B.130
C ! if AICE#0 when it should be - even if only very small: for FTSA2B.131
C ! large enough TSTAR this will give very large surface heating FTSA2B.132
C ! and even negative atmospheric heating. FTSA2B.133
IF ( AICE(J) .EQ. 0. ) THEN FTSA2B.134
SALI(J,1)=0. FTSA2B.135
ELSE FTSA2B.136
C ! Recover TICE from TSTAR: FTSA2B.137
TICE = ( TSTAR(J) + (AICE(J)-1.) * TFS ) / AICE(J) FTSA2B.138
C ! 3.5.1: FTSA2B.139
IF ( TICE .LT. TCICE ) THEN FTSA2B.140
SALI(J,1) = ALPHAC FTSA2B.141
ELSE FTSA2B.142
SALI(J,1) = ICE1 * TICE + ICE2 FTSA2B.143
ENDIF FTSA2B.144
ENDIF FTSA2B.145
ENDIF FTSA2B.146
FTSA2B.147
100 CONTINUE AWI1F403.367
AWI1F403.368
IF ( NLALBS .EQ. 2 ) THEN ! Sulphate aerosol is to be used AWI1F403.369
AWI1F403.370
! The standard no-aerosol calculations have now been done. Next, FTSA2B.148
! set the diffuse land/ice albedo to match the direct, calculate FTSA2B.149
! the no-aerosol grid-box mean & then put the aerosol forcing in - FTSA2B.150
! to the direct beam only - limiting the new albedo to 90% as for FTSA2B.151
! low sun it could otherwise exceed 100%. FTSA2B.152
FTSA2B.153
IF ( SANAON ) THEN AWI1F403.371
DO J=1, L2 AWI1F403.372
IF (LAND(J)) THEN ! Compute grid box mean albedo AWI1F403.373
SANA(J,1) = SALI(J,1) AWI1F403.374
SANA(J,2) = SALI(J,1) AWI1F403.375
ELSE AWI1F403.376
SANA(J,1) = AWI1F403.377
& AICE(J) * SALI(J,1) + ( 1. - AICE(J) ) * SAOS(J,1) AWI1F403.378
SANA(J,2) = AWI1F403.379
& AICE(J) * SALI(J,1) + ( 1. - AICE(J) ) * SAOS(J,2) AWI1F403.380
ENDIF AWI1F403.381
ENDDO AWI1F403.382
ENDIF AWI1F403.383
AWI1F403.384
DO J=1, L2 AWI1F403.385
AWI1F403.386
SALI(J,2) = SALI(J,1) AWI1F403.387
AWI1F403.388
IF ( COSZ(J) .GT. 0. ) THEN AWI1F403.389
SAOS(J,1) = SAOS(J,1) + AWI1F403.390
& ( (1-SAOS(J,1)) **2 ) * AERCON * SULPH(J) / COSZ(J) AWI1F403.391
SALI(J,1) = SALI(J,1) + AWI1F403.392
& ( (1-SALI(J,1)) **2 ) * AERCON * SULPH(J) / COSZ(J) AWI1F403.393
ENDIF AWI1F403.394
AWI1F403.395
IF ( SAOS(J,1) .GT. 0.9 ) SAOS(J,1) = 0.9 AWI1F403.396
IF ( SALI(J,1) .GT. 0.9 ) SALI(J,1) = 0.9 AWI1F403.397
AWI1F403.398
ENDDO AWI1F403.399
ENDIF AWI1F403.400
FTSA2B.174
RETURN FTSA2B.175
END FTSA2B.176
*ENDIF DEF,A01_2B FTSA2B.177