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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 71 - (hide annotations)
Mon Jul 8 18:12:18 2013 UTC (10 years, 10 months ago) by guez
File size: 5507 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 c
2     cIM ctes ds clesphys.h SUBROUTINE SWU (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,
3     SUBROUTINE SWU (PSCT,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,
4     S PTAVE,PWV,PAKI,PCLD,PCLEAR,PDSIG,PFACT,
5     S PRMU,PSEC,PUD)
6     use dimens_m
7     use dimphy
8     use clesphys
9 guez 38 use SUPHEC_M
10 guez 24 use raddim
11     use radepsi
12     use radopt
13     IMPLICIT none
14     C
15     C* ARGUMENTS:
16     C
17 guez 71 DOUBLE PRECISION PSCT
18     cIM ctes ds clesphys.h DOUBLE PRECISION RCO2
19     DOUBLE PRECISION PCLDSW(KDLON,KFLEV)
20     DOUBLE PRECISION PPMB(KDLON,KFLEV+1)
21     DOUBLE PRECISION PPSOL(KDLON)
22     DOUBLE PRECISION PRMU0(KDLON)
23     DOUBLE PRECISION PFRAC(KDLON)
24     DOUBLE PRECISION PTAVE(KDLON,KFLEV)
25     DOUBLE PRECISION PWV(KDLON,KFLEV)
26 guez 24 C
27 guez 71 DOUBLE PRECISION PAKI(KDLON,2)
28     DOUBLE PRECISION PCLD(KDLON,KFLEV)
29     DOUBLE PRECISION PCLEAR(KDLON)
30     DOUBLE PRECISION PDSIG(KDLON,KFLEV)
31     DOUBLE PRECISION PFACT(KDLON)
32     DOUBLE PRECISION PRMU(KDLON)
33     DOUBLE PRECISION PSEC(KDLON)
34     DOUBLE PRECISION PUD(KDLON,5,KFLEV+1)
35 guez 24 C
36     C* LOCAL VARIABLES:
37     C
38     INTEGER IIND(2)
39 guez 71 DOUBLE PRECISION ZC1J(KDLON,KFLEV+1)
40     DOUBLE PRECISION ZCLEAR(KDLON)
41     DOUBLE PRECISION ZCLOUD(KDLON)
42     DOUBLE PRECISION ZN175(KDLON)
43     DOUBLE PRECISION ZN190(KDLON)
44     DOUBLE PRECISION ZO175(KDLON)
45     DOUBLE PRECISION ZO190(KDLON)
46     DOUBLE PRECISION ZSIGN(KDLON)
47     DOUBLE PRECISION ZR(KDLON,2)
48     DOUBLE PRECISION ZSIGO(KDLON)
49     DOUBLE PRECISION ZUD(KDLON,2)
50     DOUBLE PRECISION ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW
51 guez 24 INTEGER jl, jk, jkp1, jkl, jklp1, ja
52     C
53     C* Prescribed Data:
54     c
55 guez 71 DOUBLE PRECISION ZPDH2O,ZPDUMG
56 guez 24 SAVE ZPDH2O,ZPDUMG
57 guez 71 DOUBLE PRECISION ZPRH2O,ZPRUMG
58 guez 24 SAVE ZPRH2O,ZPRUMG
59 guez 71 DOUBLE PRECISION RTDH2O,RTDUMG
60 guez 24 SAVE RTDH2O,RTDUMG
61 guez 71 DOUBLE PRECISION RTH2O ,RTUMG
62 guez 24 SAVE RTH2O ,RTUMG
63     DATA ZPDH2O,ZPDUMG / 0.8 , 0.75 /
64     DATA ZPRH2O,ZPRUMG / 30000., 30000. /
65     DATA RTDH2O,RTDUMG / 0.40 , 0.375 /
66     DATA RTH2O ,RTUMG / 240. , 240. /
67     C ------------------------------------------------------------------
68     C
69     C* 1. COMPUTES AMOUNTS OF ABSORBERS
70     C -----------------------------
71     C
72     100 CONTINUE
73     C
74     IIND(1)=1
75     IIND(2)=2
76     C
77     C
78     C* 1.1 INITIALIZES QUANTITIES
79     C ----------------------
80     C
81     110 CONTINUE
82     C
83     DO 111 JL = 1, KDLON
84     PUD(JL,1,KFLEV+1)=0.
85     PUD(JL,2,KFLEV+1)=0.
86     PUD(JL,3,KFLEV+1)=0.
87     PUD(JL,4,KFLEV+1)=0.
88     PUD(JL,5,KFLEV+1)=0.
89     PFACT(JL)= PRMU0(JL) * PFRAC(JL) * PSCT
90     PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
91     PSEC(JL)=1./PRMU(JL)
92     ZC1J(JL,KFLEV+1)=0.
93     111 CONTINUE
94     C
95     C* 1.3 AMOUNTS OF ABSORBERS
96     C --------------------
97     C
98     130 CONTINUE
99     C
100     DO 131 JL= 1, KDLON
101     ZUD(JL,1) = 0.
102     ZUD(JL,2) = 0.
103     ZO175(JL) = PPSOL(JL)** (ZPDUMG+1.)
104     ZO190(JL) = PPSOL(JL)** (ZPDH2O+1.)
105     ZSIGO(JL) = PPSOL(JL)
106     ZCLEAR(JL)=1.
107     ZCLOUD(JL)=0.
108     131 CONTINUE
109     C
110     DO 133 JK = 1 , KFLEV
111     JKP1 = JK + 1
112     JKL = KFLEV+1 - JK
113     JKLP1 = JKL+1
114     DO 132 JL = 1, KDLON
115     ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O
116     ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG
117     ZWH2O = MAX (PWV(JL,JK) , ZEPSCQ )
118     ZSIGN(JL) = 100. * PPMB(JL,JKP1)
119     PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL)
120     ZN175(JL) = ZSIGN(JL) ** (ZPDUMG+1.)
121     ZN190(JL) = ZSIGN(JL) ** (ZPDH2O+1.)
122     ZDSCO2 = ZO175(JL) - ZN175(JL)
123     ZDSH2O = ZO190(JL) - ZN190(JL)
124     PUD(JL,1,JK) = 1./( 10.* RG * (ZPDH2O+1.) )/(ZPRH2O**ZPDH2O)
125     . * ZDSH2O * ZWH2O * ZRTH
126     PUD(JL,2,JK) = 1./( 10.* RG * (ZPDUMG+1.) )/(ZPRUMG**ZPDUMG)
127     . * ZDSCO2 * RCO2 * ZRTU
128     ZFPPW=1.6078*ZWH2O/(1.+0.608*ZWH2O)
129     PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW
130     PUD(JL,5,JK)=PUD(JL,1,JK)*(1.-ZFPPW)
131     ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK)
132     ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK)
133     ZSIGO(JL) = ZSIGN(JL)
134     ZO175(JL) = ZN175(JL)
135     ZO190(JL) = ZN190(JL)
136     C
137     IF (NOVLP.EQ.1) THEN
138     ZCLEAR(JL)=ZCLEAR(JL)
139     S *(1.-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))
140     S /(1.-MIN(ZCLOUD(JL),1.-ZEPSEC))
141     ZC1J(JL,JKL)= 1.0 - ZCLEAR(JL)
142     ZCLOUD(JL) = PCLDSW(JL,JKL)
143     ELSE IF (NOVLP.EQ.2) THEN
144     ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL))
145     ZC1J(JL,JKL) = ZCLOUD(JL)
146     ELSE IF (NOVLP.EQ.3) THEN
147     ZCLEAR(JL) = ZCLEAR(JL)*(1.-PCLDSW(JL,JKL))
148     ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
149     ZC1J(JL,JKL) = ZCLOUD(JL)
150     END IF
151     132 CONTINUE
152     133 CONTINUE
153     DO 134 JL=1, KDLON
154     PCLEAR(JL)=1.-ZC1J(JL,1)
155     134 CONTINUE
156     DO 136 JK=1,KFLEV
157     DO 135 JL=1, KDLON
158     IF (PCLEAR(JL).LT.1.) THEN
159     PCLD(JL,JK)=PCLDSW(JL,JK)/(1.-PCLEAR(JL))
160     ELSE
161     PCLD(JL,JK)=0.
162     END IF
163     135 CONTINUE
164     136 CONTINUE
165     C
166     C
167     C* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
168     C -----------------------------------------------
169     C
170     140 CONTINUE
171     C
172     DO 142 JA = 1,2
173     DO 141 JL = 1, KDLON
174     ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL)
175     141 CONTINUE
176     142 CONTINUE
177     C
178     CALL SWTT1(2, 2, IIND, ZUD, ZR)
179     C
180     DO 144 JA = 1,2
181     DO 143 JL = 1, KDLON
182     PAKI(JL,JA) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA)
183     143 CONTINUE
184     144 CONTINUE
185     C
186     C
187     C ------------------------------------------------------------------
188     C
189     RETURN
190     END
  ViewVC Help
Powered by ViewVC 1.1.21