1 |
SUBROUTINE SWTT (KNU,KA,PU,PTR) |
2 |
use dimens_m |
3 |
use dimphy |
4 |
use raddim |
5 |
IMPLICIT none |
6 |
C |
7 |
C----------------------------------------------------------------------- |
8 |
C PURPOSE. |
9 |
C -------- |
10 |
C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE |
11 |
C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL |
12 |
C INTERVALS. |
13 |
C |
14 |
C METHOD. |
15 |
C ------- |
16 |
C |
17 |
C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS |
18 |
C AND HORNER'S ALGORITHM. |
19 |
C |
20 |
C REFERENCE. |
21 |
C ---------- |
22 |
C |
23 |
C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
24 |
C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
25 |
C |
26 |
C AUTHOR. |
27 |
C ------- |
28 |
C JEAN-JACQUES MORCRETTE *ECMWF* |
29 |
C |
30 |
C MODIFICATIONS. |
31 |
C -------------- |
32 |
C ORIGINAL : 88-12-15 |
33 |
C----------------------------------------------------------------------- |
34 |
C |
35 |
C* ARGUMENTS |
36 |
C |
37 |
INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
38 |
INTEGER KA ! INDEX OF THE ABSORBER |
39 |
REAL*8 PU(KDLON) ! ABSORBER AMOUNT |
40 |
C |
41 |
REAL*8 PTR(KDLON) ! TRANSMISSION FUNCTION |
42 |
C |
43 |
C* LOCAL VARIABLES: |
44 |
C |
45 |
REAL*8 ZR1(KDLON), ZR2(KDLON) |
46 |
INTEGER jl, i,j |
47 |
C |
48 |
C* Prescribed Data: |
49 |
C |
50 |
REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) |
51 |
SAVE APAD, BPAD, D |
52 |
DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
53 |
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
54 |
S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
55 |
S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
56 |
S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
57 |
S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
58 |
S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
59 |
S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
60 |
DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
61 |
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
62 |
S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
63 |
S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
64 |
S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
65 |
S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
66 |
S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
67 |
S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
68 |
C |
69 |
DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
70 |
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
71 |
S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
72 |
S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
73 |
S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
74 |
S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
75 |
S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
76 |
S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
77 |
DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
78 |
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
79 |
S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
80 |
S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
81 |
S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
82 |
S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
83 |
S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
84 |
S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
85 |
c |
86 |
DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
87 |
DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
88 |
C |
89 |
C----------------------------------------------------------------------- |
90 |
C |
91 |
C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
92 |
C |
93 |
100 CONTINUE |
94 |
C |
95 |
DO 201 JL = 1, KDLON |
96 |
ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL) |
97 |
S * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL) |
98 |
S * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL) |
99 |
S * ( APAD(KNU,KA,7) )))))) |
100 |
C |
101 |
ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL) |
102 |
S * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL) |
103 |
S * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL) |
104 |
S * ( BPAD(KNU,KA,7) )))))) |
105 |
C |
106 |
C |
107 |
C* 2. ADD THE BACKGROUND TRANSMISSION |
108 |
C |
109 |
200 CONTINUE |
110 |
C |
111 |
C |
112 |
PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA) |
113 |
201 CONTINUE |
114 |
C |
115 |
RETURN |
116 |
END |