/[lmdze]/trunk/libf/phylmd/Radlwsw/swtt.f
ViewVC logotype

Contents of /trunk/libf/phylmd/Radlwsw/swtt.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 71 - (show annotations)
Mon Jul 8 18:12:18 2013 UTC (10 years, 9 months ago) by guez
File size: 4089 byte(s) 
No reason to call inidissip in ce0l.

In inidissip, set random seed to 1 beacuse PGI compiler does not
accept all zeros.

dq was computed needlessly in caladvtrac. Arguments masse and dq of
calfis not used.

Replaced real*8 by double precision.

Pass arrays with inverted order of vertical levels to conflx instead
of creating local variables for this inside conflx.
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 DOUBLE PRECISION PU(KDLON) ! ABSORBER AMOUNT
40 C
41 DOUBLE PRECISION PTR(KDLON) ! TRANSMISSION FUNCTION
42 C
43 C* LOCAL VARIABLES:
44 C
45 DOUBLE PRECISION ZR1(KDLON), ZR2(KDLON)
46 INTEGER jl, i,j
47 C
48 C* Prescribed Data:
49 C
50 DOUBLE PRECISION 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
  ViewVC Help
Powered by ViewVC 1.1.21