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

Annotation of /trunk/libf/phylmd/Radlwsw/swtt1.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 71 - (hide annotations)
Mon Jul 8 18:12:18 2013 UTC (10 years, 11 months ago) by guez
File size: 4312 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 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 guez 71 DOUBLE PRECISION PU(KDLON,KABS) ! ABSORBER AMOUNT
40 guez 24 C
41 guez 71 DOUBLE PRECISION PTR(KDLON,KABS) ! TRANSMISSION FUNCTION
42 guez 24 C
43     C* LOCAL VARIABLES:
44     C
45 guez 71 DOUBLE PRECISION ZR1(KDLON)
46     DOUBLE PRECISION ZR2(KDLON)
47     DOUBLE PRECISION ZU(KDLON)
48 guez 24 INTEGER jl, ja, i, j, ia
49     C
50     C* Prescribed Data:
51     C
52 guez 71 DOUBLE PRECISION APAD(2,3,7), BPAD(2,3,7), D(2,3)
53 guez 24 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
  ViewVC Help
Powered by ViewVC 1.1.21