*IF DEF,A01_1A,OR,DEF,A01_1B,OR,DEF,A01_2A,OR,DEF,A01_2B AWI3F402.5
C ******************************COPYRIGHT****************************** GTS2F400.10027
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10028
C GTS2F400.10029
C Use, duplication or disclosure of this code is subject to the GTS2F400.10030
C restrictions as set forth in the contract. GTS2F400.10031
C GTS2F400.10032
C Meteorological Office GTS2F400.10033
C London Road GTS2F400.10034
C BRACKNELL GTS2F400.10035
C Berkshire UK GTS2F400.10036
C RG12 2SZ GTS2F400.10037
C GTS2F400.10038
C If no contract has been raised with this copy of the code, the use, GTS2F400.10039
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10040
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10041
C Modelling at the above address. GTS2F400.10042
C ******************************COPYRIGHT****************************** GTS2F400.10043
C GTS2F400.10044
CLL Subroutine SWPTSC ---------------------------------------------- SWPTSC1A.3
CLL SWPTSC1A.4
CLL Purpose : SWPTSC1A.5
CLL It calculates scaled pathlengths of each gaseous absorber for each SWPTSC1A.6
CLL layer and returns them in DPATH for use by SWMAST, which sums them SWPTSC1A.7
CLL to get the total scaled pathlengths for each beam considered, so SWPTSC1A.8
CLL that the gaseous transmissivities can be calculated. SWPTSC1A.9
CLL SWPTSC1A.10
CLL Author: William Ingram SWPTSC1A.11
CLL SWPTSC1A.12
CLL Model Modification history from model version 3.0: SWPTSC1A.13
CLL version Date SWPTSC1A.14
CLL 4.2 Sept.96 T3E migration: *DEF CRAY removed; GSS1F402.19
CLL *DEF T3E used for T3E library functions; GSS1F402.20
CLL dynamic allocation no longer *DEF controlled. GSS1F402.21
CLL S.J.Swarbrick GSS1F402.22
CLL 4.3 Feb. 97 T3E optimisation: code restructured, cray vector GSS1F403.449
CLL library functions introduced. GSS1F403.450
CLL D.Salmond & S.J.Swarbrick GSS1F403.451
CLL GDR8F405.1
CLL 4.5 Jan. 98 T3E optimisation: rtor_v replaced by powr_v GDR8F405.2
CLL D.Salmond GDR8F405.3
CLL SWPTSC1A.15
CLL Programming standard : SWPTSC1A.16
CLL It conforms to standard A of UMDP 4 (version 3, 07/9/90). SWPTSC1A.17
CLL If UPDATE *DEF CRAY is off, a version is produced which except SWPTSC1A.18
CLL for the addition of ! comments is standard FORTRAN 77 with no SWPTSC1A.19
CLL 8X-deprecated features (and which sets the "vector length" to 1) SWPTSC1A.20
CLL but the standard version includes automatic arrays also. SWPTSC1A.21
CLL SWPTSC1A.22
CLL Logical components covered : P234 SWPTSC1A.23
CLL (interaction of shortwave radiation with the atmosphere) SWPTSC1A.24
CLL SWPTSC1A.25
CLL Project task : P23 (radiation) SWPTSC1A.26
CLL SWPTSC1A.27
CLL External documentation: UMDP 23. SWPTSC1A.28
CLL SWPTSC1A.29
CLLEND ----------------------------------------------------------------- SWPTSC1A.30
C*L SWPTSC1A.31
SUBROUTINE SWPTSC (H2O, CO2, O3, PSTAR, AB, BB, 3SWPTSC1A.32
& L2, GSS1F402.23
& NLEVS, NWET, NOZONE, L1, DPATH) SWPTSC1A.36
C* SWPTSC1A.37
*CALL SWNGASES 
SWPTSC1A.38
C*L SWPTSC1A.42
INTEGER!, INTENT (IN) :: SWPTSC1A.43
& L2, ! Number of points to be treated GSS1F402.24
& NLEVS, ! Number of levels SWPTSC1A.47
& NWET, ! Number of levels with moisture - SWPTSC1A.48
C ! above them a small value H2OMN is used (zero would give trouble) SWPTSC1A.49
& NOZONE, ! Number of levels with ozone data SWPTSC1A.50
C ! provided - below them the lowest layer's is used. SWPTSC1A.51
& L1 ! First dimension of input arrays SWPTSC1A.52
REAL!, INTENT(IN) :: SWPTSC1A.53
& H2O(L1,NWET), CO2, ! Mass mixing ratio (mK in UMDP 23) SWPTSC1A.54
& O3(L1,NOZONE), ! of each absorbing gas SWPTSC1A.55
& PSTAR(L1), ! Surface pressure SWPTSC1A.56
& AB(NLEVS+1), BB(NLEVS+1) ! As & Bs at layer boundaries SWPTSC1A.57
REAL!, INTENT(OUT) :: SWPTSC1A.58
& DPATH(L2,NGASES,NLEVS) SWPTSC1A.59
C ! The scaled pathlengths are returned in DPATH, indexed by NGASES SWPTSC1A.60
C ! 1 is H2O, 2 is O3 & 3 is CO2 SWPTSC1A.61
C* SWPTSC1A.62
CL ! SWPTSC has no EXTERNAL calls and no significant structure SWPTSC1A.63
CL ! but it has one dynamically allocated array, WORK. GSS1F402.25
C SWPTSC1A.67
REAL WORK(L2,2,2) SWPTSC1A.68
C ! WORK is used to hold powers of layer boundary pressures used SWPTSC1A.69
C ! in 2.3.1 and passed from one level to the next to save SWPTSC1A.70
C ! re-calculation. (This does prevent autotasking over levels.) SWPTSC1A.71
REAL PSNH2O, ! Pressure scaling normalization SWPTSC1A.72
& PSNCO2, ! constants for water vapour & CO2 SWPTSC1A.73
& PSXH2O, ! Pressure scaling exponents for SWPTSC1A.74
& PSXCO2, ! water vapour & CO2 SWPTSC1A.75
& PX1H2O, PX1CO2, ! 1+PSXH2O, 1+PSXCO2 SWPTSC1A.76
& PRFH2O, ! Reference pressures for scaling SWPTSC1A.77
& PRFCO2, ! water vapour & CO2 SWPTSC1A.78
& PSTRO3, ! Standard surface pressure for O3 SWPTSC1A.79
& H2OMN ! Minimum water vapour pathlength SWPTSC1A.80
REAL ! Pressure at top of current layer GSS1F403.452
& power,pbot(l2,nlevs+1),pbot_h2o(l2,nlevs+1), GDR8F405.4
& DPOBYG ! Pressure difference for ozone, /g SWPTSC1A.82
INTEGER LEVEL, J, ! Loopers over levels & points SWPTSC1A.83
& ONETWO, ! Flipper SWPTSC1A.84
& NDRY, ! Number of levels without moisture SWPTSC1A.85
& OLEVEL ! Index for the ozone to be used in SWPTSC1A.86
C ! the current level SWPTSC1A.87
*CALL C_G SWPTSC1A.88
*CALL C_EPSLON SWPTSC1A.89
PARAMETER ( PSTRO3 = 101325. ) SWPTSC1A.90
PARAMETER ( H2OMN = 1.E-10 ) SWPTSC1A.91
PARAMETER ( PSXH2O = 0.9, PX1H2O = 1. + PSXH2O, PRFH2O = 50000., SWPTSC1A.92
& PSXCO2 = 0.7, PX1CO2 = 1. + PSXCO2, PRFCO2 = 25000. ) SWPTSC1A.93
C ! FORTRAN 77 will not allow the next two constants to be SWPTSC1A.94
C ! defined in a PARAMETER statement, but the CRAY compiler will SWPTSC1A.95
C ! give the same effect as if they were. SWPTSC1A.96
PSNH2O = PRFH2O**(-PSXH2O) / (G*PX1H2O) SWPTSC1A.97
PSNCO2 = PRFCO2**(-PSXCO2) / (G*PX1CO2) SWPTSC1A.98
C SWPTSC1A.99
NDRY = NLEVS - NWET SWPTSC1A.100
C SWPTSC1A.101
C ! Initialize the WORK term for CO2: SWPTSC1A.102
C SWPTSC1A.103
power=px1co2 GDR8F405.5
do level=1, nlevs + 1 GSS1F403.457
DO 1 J=1, L2 SWPTSC1A.104
pbot(j,level) = ( PSTAR(J) * BB(level) + AB(level) ) GSS1F403.458
1 CONTINUE SWPTSC1A.106
*IF DEF,VECTLIB PXVECTLB.143
call powr_v(l2,pbot(1,level),power,pbot(1,level)) GDR8F405.6
*ELSE GSS1F403.461
do j=1,L2 GSS1F403.462
pbot(j,level)=pbot(j,level)**power GDR8F405.7
end do GSS1F403.464
*ENDIF GSS1F403.465
enddo GSS1F403.466
C SWPTSC1A.108
C ! The next loop deals with H2O and CO2 for levels where there is SWPTSC1A.109
C ! no moisture. We just put a minimum value in for moisture, SWPTSC1A.110
C ! treating CO2 as below. SWPTSC1A.111
C SWPTSC1A.112
DO 2 LEVEL=1, NDRY SWPTSC1A.113
DO 20 J=1, L2 SWPTSC1A.115
DPATH(J,1,LEVEL) = H2OMN SWPTSC1A.116
DPATH(J,3,LEVEL) = SWPTSC1A.119
& CO2 * PSNCO2 * ( pbot(j,level+1) - pbot(j,level) ) GSS1F403.467
20 CONTINUE SWPTSC1A.121
2 CONTINUE SWPTSC1A.123
power=(PX1H2O/PX1CO2) GDR8F405.8
C SWPTSC1A.130
C ! This is the more general loop, calculating scaled pathlengths SWPTSC1A.131
C ! for H2O and CO2. SWPTSC1A.132
C SWPTSC1A.133
do LEVEL=NDRY+1, NLEVS + 1 GSS1F403.469
*IF DEF,VECTLIB PXVECTLB.144
call powr_v(l2,pbot(1,level),power, GDR8F405.9
1 pbot_h2o(1,level)) GSS1F403.472
*ELSE GSS1F403.473
do j=1,L2 GSS1F403.474
pbot_h2o(j,level)=pbot(j,level)**power GDR8F405.10
end do GSS1F403.476
*ENDIF GSS1F403.477
enddo GSS1F403.478
DO 4 LEVEL=NDRY+1, NLEVS SWPTSC1A.134
DO 40 J=1, L2 SWPTSC1A.136
IF (H2O(J,LEVEL-NDRY) .NE. 0.) THEN GSS1F403.479
DPATH(J,1,LEVEL) = H2O(J,LEVEL-NDRY) * PSNH2O * SWPTSC1A.140
& ( pbot_h2o(j,level+1) - pbot_h2o(j,level) ) GSS1F403.480
ELSE GSS1F403.481
DPATH(J,1,LEVEL) = H2OMN GSS1F403.482
ENDIF GSS1F403.483
DPATH(J,3,LEVEL) = SWPTSC1A.145
& CO2 * PSNCO2 * ( pbot(j,level+1) - pbot(j,level) ) GSS1F403.484
40 CONTINUE SWPTSC1A.147
4 CONTINUE SWPTSC1A.150
C SWPTSC1A.151
C ! Ozone has no pressure scaling, and to calculate the pathlengths SWPTSC1A.152
C ! from the mass mixing ratios we use a "standard" surface SWPTSC1A.153
C ! pressure, so that the climatology can be used without SWPTSC1A.154
C ! interpolation but preserving total column ozone. There are SWPTSC1A.155
C ! thus no calculations in common with those for H2O and CO2, and SWPTSC1A.156
C ! it is most conveniently treated quite separately, with no SWPTSC1A.157
C ! repetition of code for wet and dry levels. SWPTSC1A.158
C SWPTSC1A.159
DO 5 LEVEL=1, NLEVS SWPTSC1A.160
DPOBYG = ( ( AB(LEVEL+1) - AB(LEVEL) ) + PSTRO3 * SWPTSC1A.161
& ( BB(LEVEL+1) - BB(LEVEL) ) ) / G SWPTSC1A.162
OLEVEL = MIN (LEVEL, NOZONE) SWPTSC1A.163
DO 50 J=1, L2 SWPTSC1A.165
DPATH(J,2,LEVEL) = DPOBYG * O3(J,OLEVEL) SWPTSC1A.166
50 CONTINUE SWPTSC1A.167
5 CONTINUE SWPTSC1A.168
C SWPTSC1A.169
RETURN SWPTSC1A.170
END SWPTSC1A.171
*ENDIF DEF,A01_1A,OR,DEF,A01_1B,OR,DEF,A01_2A SWPTSC1A.172