*IF DEF,A01_1A,OR,DEF,A01_1B,OR,DEF,A01_2A,OR,DEF,A01_2B AWI3F402.3
C ******************************COPYRIGHT****************************** GTS2F400.10009
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10010
C GTS2F400.10011
C Use, duplication or disclosure of this code is subject to the GTS2F400.10012
C restrictions as set forth in the contract. GTS2F400.10013
C GTS2F400.10014
C Meteorological Office GTS2F400.10015
C London Road GTS2F400.10016
C BRACKNELL GTS2F400.10017
C Berkshire UK GTS2F400.10018
C RG12 2SZ GTS2F400.10019
C GTS2F400.10020
C If no contract has been raised with this copy of the code, the use, GTS2F400.10021
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10022
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10023
C Modelling at the above address. GTS2F400.10024
C ******************************COPYRIGHT****************************** GTS2F400.10025
C GTS2F400.10026
CLL Subroutine SWMSAL ----------------------------------------------- WI250593.1
CLL SWMSAL1A.4
CLL Purpose : SWMSAL1A.5
CLL It is part of component P234 (interaction of shortwave radiation SWMSAL1A.6
CLL with the atmosphere) SWMSAL1A.7
CLL It modifies the surface albedo to allow crudely for multiple SWMSAL1A.8
CLL reflections. SWMSAL1A.9
CLL Release 2.8 of the UM modified to allow for direct & SWMSAL1A.10
CLL diffuse surface albedos being different. SWMSAL1A.11
CLL It is suitable for single column model use. SWMSAL1A.12
CLL SWMSAL1A.13
CLL Author: William Ingram SWMSAL1A.14
CLL SWMSAL1A.15
CLL Model Modification history from model version 3.0: SWMSAL1A.16
CLL version Date SWMSAL1A.17
CLL 4.2 Sept.96 T3E migration: *DEF CRAY removed; GSS1F402.13
CLL *DEF T3E used for T3E library functions; GSS1F402.14
CLL dynamic allocation no longer *DEF controlled. GSS1F402.15
CLL S.J.Swarbrick GSS1F402.16
CLL SWMSAL1A.18
CLL Programming standard : SWMSAL1A.19
CLL It conforms to programming standard A of UMDP 4, version 3 (07/9/90 SWMSAL1A.20
CLL Except for containing ! comments, it conforms to the FORTRAN 77 SWMSAL1A.21
CLL standard with no features deprecated by 8X if *DEF CRAY is off: SWMSAL1A.22
CLL otherwise it contains automatic arrays. SWMSAL1A.23
CLL SWMSAL1A.24
CLL Logical components covered : P234 SWMSAL1A.25
CLL SWMSAL1A.26
CLL Project task : P23 (radiation) SWMSAL1A.27
CLL SWMSAL1A.28
CLL External documentation: UMDP23 sub-section "Modifications to the SWMSAL1A.29
CLL surface albedo". SWMSAL1A.30
CLL SWMSAL1A.31
CLLEND ----------------------------------------------------------------- SWMSAL1A.32
C*L SWMSAL1A.33
SUBROUTINE SWMSAL (TSA, LCDDR, LCA, CCDDR, CCA, CCB, OFFSET, 4SWMSAL1A.34
& L2, SWMSAL1A.36
& L1, NBANDS, NCLDS, MSA) SWMSAL1A.38
INTEGER!, INTENT (IN) SWMSAL1A.42
& L1, ! First dimension of input arrays SWMSAL1A.43
& L2, ! Number of points to be treated GSS1F402.17
& NCLDS, ! Number of layers with cloud SWMSAL1A.47
& NBANDS ! Number of bands SWMSAL1A.48
REAL!, INTENT (IN) SWMSAL1A.49
& TSA(L1,NBANDS,2), ! True surface albedo - mean over SWMSAL1A.50
C ! the whole grid-box, direct-beam value followed by diffuse-beam SWMSAL1A.51
& LCA(L1,NCLDS), ! Layer cloud amount and SWMSAL1A.52
& LCDDR(L2,NBANDS,NCLDS), ! diffuse/diffuse reflectivity a5 SWMSAL1A.53
& CCA(L1), CCDDR(L2,NBANDS) ! Same for convective cloud SWMSAL1A.54
C ! - except that LCDDR has been multiplied by LCA and so is the SWMSAL1A.55
C ! mean value over the grid-box, or at least that part of the SWMSAL1A.56
C ! grid-box not occupied by any convective cloud at that level, SWMSAL1A.57
C ! while CCDDR is a mean over the convective cloud only. SWMSAL1A.58
INTEGER!, INTENT (IN) SWMSAL1A.59
& CCB(L1), ! Convective cloud base SWMSAL1A.60
& OFFSET ! Allows for CCB being numbered SWMSAL1A.61
C ! from the top of the model down, while LCA & LCDDR begin in the SWMSAL1A.62
C ! first layer where cloud is allowed SWMSAL1A.63
REAL!, INTENT (OUT) :: SWMSAL1A.64
& MSA(L2,NBANDS,2) ! Modified surface albedo SWMSAL1A.65
C SWMSAL1A.66
CL ! SWMSAL has no EXTERNAL calls and no significant structure SWMSAL1A.67
CL ! but two dynamically allocated arrays, REFRAC & VISFRC. GSS1F402.18
C SWMSAL1A.71
C* SWMSAL1A.72
REAL REFRAC(L2), ! The sky's fractional reflectivity SWMSAL1A.73
& VISFRC(L2) ! The fraction of the sky at the SWMSAL1A.74
C ! current level (and so, given random overlap, of the cloud in SWMSAL1A.75
C ! that level) visible from the surface. SWMSAL1A.76
REAL MODF ! Modification factor which SWMSAL1A.77
C ! converts TSA into MSA SWMSAL1A.78
C ! SWMSAL1A.79
INTEGER BAND, LEVEL, J ! Loopers over band, level & point SWMSAL1A.80
C ! SWMSAL1A.81
DO 100 BAND=1, NBANDS SWMSAL1A.82
Cfpp$ Select(CONCUR) SWMSAL1A.83
DO 110 J=1, L2 SWMSAL1A.84
C ! SWMSAL1A.85
C ! First, accumulate through the "DO 101" loop mean cloud SWMSAL1A.86
C ! reflectivity over all the box, with weighting by the area of SWMSAL1A.87
C ! each cloud visible at the surface. SWMSAL1A.88
C ! SWMSAL1A.89
REFRAC(J) = 0. SWMSAL1A.90
VISFRC(J) = 1. SWMSAL1A.91
110 CONTINUE SWMSAL1A.92
DO 101 LEVEL=NCLDS, 1, -1 SWMSAL1A.93
Cfpp$ Select(CONCUR) SWMSAL1A.94
DO 111 J=1, L2 SWMSAL1A.95
C ! Since LCA is in fact the fractional cover by layer cloud SWMSAL1A.96
C ! outside the convective cloud, we can do the calculations SWMSAL1A.97
C ! just by working up, allowing for the effects of each cloud SWMSAL1A.98
C ! on VISFRC and REFRAC as we reach its base, and treating SWMSAL1A.99
C ! convective cloud as if it were just below where it actually SWMSAL1A.100
C ! is. SWMSAL1A.101
IF ( CCB(J) .EQ. (LEVEL+OFFSET) ) THEN SWMSAL1A.102
REFRAC(J) = REFRAC(J) + VISFRC(J) * CCA(J) * CCDDR(J,BAND) SWMSAL1A.103
VISFRC(J) = VISFRC(J) * ( 1. - CCA(J) ) SWMSAL1A.104
ENDIF SWMSAL1A.105
REFRAC(J) = REFRAC(J) + VISFRC(J) * LCDDR(J,BAND,LEVEL) SWMSAL1A.106
VISFRC(J) = VISFRC(J) * ( 1. - LCA(J,LEVEL) ) SWMSAL1A.107
111 CONTINUE SWMSAL1A.108
101 CONTINUE SWMSAL1A.109
C ! SWMSAL1A.110
Cfpp$ Select(CONCUR) SWMSAL1A.111
DO 100 J=1, L2 SWMSAL1A.112
MODF = ( 1. - REFRAC(J) ) / ( 1. - TSA(J,BAND,2) * REFRAC(J) ) SWMSAL1A.113
MSA(J,BAND,1) = TSA(J,BAND,1) * MODF SWMSAL1A.114
MSA(J,BAND,2) = TSA(J,BAND,2) * MODF SWMSAL1A.115
C SWMSAL1A.116
100 CONTINUE SWMSAL1A.117
C SWMSAL1A.118
RETURN SWMSAL1A.119
END SWMSAL1A.120
*ENDIF DEF,A01_1A,OR,DEF,A01_1B,OR,DEF,A01_2A SWMSAL1A.121