1 |
guez |
24 |
SUBROUTINE SWTT1(KNU,KABS,KIND, 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 : 95-01-20 |
33 |
|
|
C----------------------------------------------------------------------- |
34 |
|
|
C* ARGUMENTS: |
35 |
|
|
C |
36 |
|
|
INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL |
37 |
|
|
INTEGER KABS ! NUMBER OF ABSORBERS |
38 |
|
|
INTEGER KIND(KABS) ! INDICES OF THE ABSORBERS |
39 |
|
|
REAL*8 PU(KDLON,KABS) ! ABSORBER AMOUNT |
40 |
|
|
C |
41 |
|
|
REAL*8 PTR(KDLON,KABS) ! TRANSMISSION FUNCTION |
42 |
|
|
C |
43 |
|
|
C* LOCAL VARIABLES: |
44 |
|
|
C |
45 |
|
|
REAL*8 ZR1(KDLON) |
46 |
|
|
REAL*8 ZR2(KDLON) |
47 |
|
|
REAL*8 ZU(KDLON) |
48 |
|
|
INTEGER jl, ja, i, j, ia |
49 |
|
|
C |
50 |
|
|
C* Prescribed Data: |
51 |
|
|
C |
52 |
|
|
REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3) |
53 |
|
|
SAVE APAD, BPAD, D |
54 |
|
|
DATA ((APAD(1,I,J),I=1,3),J=1,7) / |
55 |
|
|
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
56 |
|
|
S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01, |
57 |
|
|
S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00, |
58 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02, |
59 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02, |
60 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02, |
61 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 / |
62 |
|
|
DATA ((APAD(2,I,J),I=1,3),J=1,7) / |
63 |
|
|
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
64 |
|
|
S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02, |
65 |
|
|
S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00, |
66 |
|
|
S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00, |
67 |
|
|
S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00, |
68 |
|
|
S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00, |
69 |
|
|
S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 / |
70 |
|
|
C |
71 |
|
|
DATA ((BPAD(1,I,J),I=1,3),J=1,7) / |
72 |
|
|
S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04, |
73 |
|
|
S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01, |
74 |
|
|
S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00, |
75 |
|
|
S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02, |
76 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02, |
77 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02, |
78 |
|
|
S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 / |
79 |
|
|
DATA ((BPAD(2,I,J),I=1,3),J=1,7) / |
80 |
|
|
S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03, |
81 |
|
|
S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02, |
82 |
|
|
S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01, |
83 |
|
|
S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00, |
84 |
|
|
S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00, |
85 |
|
|
S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00, |
86 |
|
|
S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 / |
87 |
|
|
c |
88 |
|
|
DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 / |
89 |
|
|
DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 / |
90 |
|
|
C----------------------------------------------------------------------- |
91 |
|
|
C |
92 |
|
|
C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION |
93 |
|
|
C |
94 |
|
|
100 CONTINUE |
95 |
|
|
C |
96 |
|
|
DO 202 JA = 1,KABS |
97 |
|
|
IA=KIND(JA) |
98 |
|
|
DO 201 JL = 1, KDLON |
99 |
|
|
ZU(JL) = PU(JL,JA) |
100 |
|
|
ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL) |
101 |
|
|
S * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL) |
102 |
|
|
S * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL) |
103 |
|
|
S * ( APAD(KNU,IA,7) )))))) |
104 |
|
|
C |
105 |
|
|
ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL) |
106 |
|
|
S * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL) |
107 |
|
|
S * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL) |
108 |
|
|
S * ( BPAD(KNU,IA,7) )))))) |
109 |
|
|
C |
110 |
|
|
C |
111 |
|
|
C* 2. ADD THE BACKGROUND TRANSMISSION |
112 |
|
|
C |
113 |
|
|
200 CONTINUE |
114 |
|
|
C |
115 |
|
|
PTR(JL,JA) = (ZR1(JL)/ZR2(JL)) * (1.-D(KNU,IA)) + D(KNU,IA) |
116 |
|
|
201 CONTINUE |
117 |
|
|
202 CONTINUE |
118 |
|
|
C |
119 |
|
|
RETURN |
120 |
|
|
END |