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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 38 - (hide annotations)
Thu Jan 6 17:52:19 2011 UTC (13 years, 5 months ago) by guez
Original Path: trunk/libf/phylmd/Radlwsw/swu.f
File size: 5177 byte(s) 
Extracted ASCII art from "inigeom" into a separate text file in the
documentation.

"test_disvert" now creates a separate file for layer thicknesses.

Moved variables from module "yomcst" to module "suphec_m" because this
is where those variables are defined. Kept in "yomcst" only parameters
of Earth orbit. Gave the attribute "parameter" to some variables of
module "suphec_m".

Variables of module "yoethf" were defined in procedure "suphec". Moved
these definitions to a new procedure "yoethf" in module "yoethf_m".
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     REAL*8 PSCT
18     cIM ctes ds clesphys.h REAL*8 RCO2
19     REAL*8 PCLDSW(KDLON,KFLEV)
20     REAL*8 PPMB(KDLON,KFLEV+1)
21     REAL*8 PPSOL(KDLON)
22     REAL*8 PRMU0(KDLON)
23     REAL*8 PFRAC(KDLON)
24     REAL*8 PTAVE(KDLON,KFLEV)
25     REAL*8 PWV(KDLON,KFLEV)
26     C
27     REAL*8 PAKI(KDLON,2)
28     REAL*8 PCLD(KDLON,KFLEV)
29     REAL*8 PCLEAR(KDLON)
30     REAL*8 PDSIG(KDLON,KFLEV)
31     REAL*8 PFACT(KDLON)
32     REAL*8 PRMU(KDLON)
33     REAL*8 PSEC(KDLON)
34     REAL*8 PUD(KDLON,5,KFLEV+1)
35     C
36     C* LOCAL VARIABLES:
37     C
38     INTEGER IIND(2)
39     REAL*8 ZC1J(KDLON,KFLEV+1)
40     REAL*8 ZCLEAR(KDLON)
41     REAL*8 ZCLOUD(KDLON)
42     REAL*8 ZN175(KDLON)
43     REAL*8 ZN190(KDLON)
44     REAL*8 ZO175(KDLON)
45     REAL*8 ZO190(KDLON)
46     REAL*8 ZSIGN(KDLON)
47     REAL*8 ZR(KDLON,2)
48     REAL*8 ZSIGO(KDLON)
49     REAL*8 ZUD(KDLON,2)
50     REAL*8 ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW
51     INTEGER jl, jk, jkp1, jkl, jklp1, ja
52     C
53     C* Prescribed Data:
54     c
55     REAL*8 ZPDH2O,ZPDUMG
56     SAVE ZPDH2O,ZPDUMG
57     REAL*8 ZPRH2O,ZPRUMG
58     SAVE ZPRH2O,ZPRUMG
59     REAL*8 RTDH2O,RTDUMG
60     SAVE RTDH2O,RTDUMG
61     REAL*8 RTH2O ,RTUMG
62     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