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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
File size: 4745 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.
1 guez 81 SUBROUTINE swu(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, paki, &
2     pcld, pclear, pdsig, pfact, prmu, psec, pud)
3 guez 118
4 guez 81 USE dimens_m
5     USE dimphy
6     USE clesphys
7     USE suphec_m
8     USE raddim
9     USE radepsi
10     USE radopt
11     IMPLICIT NONE
12    
13     ! * ARGUMENTS:
14    
15     DOUBLE PRECISION psct
16     ! IM ctes ds clesphys.h DOUBLE PRECISION RCO2
17     DOUBLE PRECISION pcldsw(kdlon, kflev)
18     DOUBLE PRECISION ppmb(kdlon, kflev+1)
19     DOUBLE PRECISION ppsol(kdlon)
20     DOUBLE PRECISION prmu0(kdlon)
21     DOUBLE PRECISION pfrac(kdlon)
22     DOUBLE PRECISION ptave(kdlon, kflev)
23     DOUBLE PRECISION pwv(kdlon, kflev)
24    
25     DOUBLE PRECISION paki(kdlon, 2)
26     DOUBLE PRECISION pcld(kdlon, kflev)
27     DOUBLE PRECISION pclear(kdlon)
28     DOUBLE PRECISION pdsig(kdlon, kflev)
29     DOUBLE PRECISION pfact(kdlon)
30     DOUBLE PRECISION prmu(kdlon)
31     DOUBLE PRECISION psec(kdlon)
32     DOUBLE PRECISION pud(kdlon, 5, kflev+1)
33    
34     ! * LOCAL VARIABLES:
35    
36     INTEGER iind(2)
37     DOUBLE PRECISION zc1j(kdlon, kflev+1)
38     DOUBLE PRECISION zclear(kdlon)
39     DOUBLE PRECISION zcloud(kdlon)
40     DOUBLE PRECISION zn175(kdlon)
41     DOUBLE PRECISION zn190(kdlon)
42     DOUBLE PRECISION zo175(kdlon)
43     DOUBLE PRECISION zo190(kdlon)
44     DOUBLE PRECISION zsign(kdlon)
45     DOUBLE PRECISION zr(kdlon, 2)
46     DOUBLE PRECISION zsigo(kdlon)
47     DOUBLE PRECISION zud(kdlon, 2)
48     DOUBLE PRECISION zrth, zrtu, zwh2o, zdsco2, zdsh2o, zfppw
49 guez 178 INTEGER jl, jk, jkp1, jkl, ja
50 guez 81
51     ! * Prescribed Data:
52    
53     DOUBLE PRECISION zpdh2o, zpdumg
54     SAVE zpdh2o, zpdumg
55     DOUBLE PRECISION zprh2o, zprumg
56     SAVE zprh2o, zprumg
57     DOUBLE PRECISION rtdh2o, rtdumg
58     SAVE rtdh2o, rtdumg
59     DOUBLE PRECISION rth2o, rtumg
60     SAVE rth2o, rtumg
61 guez 178 DATA zpdh2o, zpdumg/0.8d0, 0.75d0/
62     DATA zprh2o, zprumg/30000.d0, 30000.d0/
63     DATA rtdh2o, rtdumg/0.40d0, 0.375d0/
64     DATA rth2o, rtumg/240.d0, 240.d0/
65 guez 81 ! ------------------------------------------------------------------
66    
67     ! * 1. COMPUTES AMOUNTS OF ABSORBERS
68     ! -----------------------------
69    
70    
71     iind(1) = 1
72     iind(2) = 2
73    
74    
75     ! * 1.1 INITIALIZES QUANTITIES
76     ! ----------------------
77    
78    
79     DO jl = 1, kdlon
80     pud(jl, 1, kflev+1) = 0.
81     pud(jl, 2, kflev+1) = 0.
82     pud(jl, 3, kflev+1) = 0.
83     pud(jl, 4, kflev+1) = 0.
84     pud(jl, 5, kflev+1) = 0.
85     pfact(jl) = prmu0(jl)*pfrac(jl)*psct
86     prmu(jl) = sqrt(1224.*prmu0(jl)*prmu0(jl)+1.)/35.
87     psec(jl) = 1./prmu(jl)
88     zc1j(jl, kflev+1) = 0.
89     END DO
90    
91     ! * 1.3 AMOUNTS OF ABSORBERS
92     ! --------------------
93    
94    
95     DO jl = 1, kdlon
96     zud(jl, 1) = 0.
97     zud(jl, 2) = 0.
98     zo175(jl) = ppsol(jl)**(zpdumg+1.)
99     zo190(jl) = ppsol(jl)**(zpdh2o+1.)
100     zsigo(jl) = ppsol(jl)
101     zclear(jl) = 1.
102     zcloud(jl) = 0.
103     END DO
104    
105     DO jk = 1, kflev
106     jkp1 = jk + 1
107     jkl = kflev + 1 - jk
108     DO jl = 1, kdlon
109     zrth = (rth2o/ptave(jl,jk))**rtdh2o
110     zrtu = (rtumg/ptave(jl,jk))**rtdumg
111     zwh2o = max(pwv(jl,jk), zepscq)
112     zsign(jl) = 100.*ppmb(jl, jkp1)
113     pdsig(jl, jk) = (zsigo(jl)-zsign(jl))/ppsol(jl)
114     zn175(jl) = zsign(jl)**(zpdumg+1.)
115     zn190(jl) = zsign(jl)**(zpdh2o+1.)
116     zdsco2 = zo175(jl) - zn175(jl)
117     zdsh2o = zo190(jl) - zn190(jl)
118     pud(jl, 1, jk) = 1./(10.*rg*(zpdh2o+1.))/(zprh2o**zpdh2o)*zdsh2o*zwh2o* &
119     zrth
120     pud(jl, 2, jk) = 1./(10.*rg*(zpdumg+1.))/(zprumg**zpdumg)*zdsco2*rco2* &
121     zrtu
122     zfppw = 1.6078*zwh2o/(1.+0.608*zwh2o)
123     pud(jl, 4, jk) = pud(jl, 1, jk)*zfppw
124     pud(jl, 5, jk) = pud(jl, 1, jk)*(1.-zfppw)
125     zud(jl, 1) = zud(jl, 1) + pud(jl, 1, jk)
126     zud(jl, 2) = zud(jl, 2) + pud(jl, 2, jk)
127     zsigo(jl) = zsign(jl)
128     zo175(jl) = zn175(jl)
129     zo190(jl) = zn190(jl)
130    
131     IF (novlp==1) THEN
132     zclear(jl) = zclear(jl)*(1.-max(pcldsw(jl,jkl),zcloud(jl)))/(1.-min( &
133     zcloud(jl),1.-zepsec))
134     zc1j(jl, jkl) = 1.0 - zclear(jl)
135     zcloud(jl) = pcldsw(jl, jkl)
136     ELSE IF (novlp==2) THEN
137     zcloud(jl) = max(pcldsw(jl,jkl), zcloud(jl))
138     zc1j(jl, jkl) = zcloud(jl)
139     ELSE IF (novlp==3) THEN
140     zclear(jl) = zclear(jl)*(1.-pcldsw(jl,jkl))
141     zcloud(jl) = 1.0 - zclear(jl)
142     zc1j(jl, jkl) = zcloud(jl)
143 guez 24 END IF
144 guez 81 END DO
145     END DO
146     DO jl = 1, kdlon
147     pclear(jl) = 1. - zc1j(jl, 1)
148     END DO
149     DO jk = 1, kflev
150     DO jl = 1, kdlon
151     IF (pclear(jl)<1.) THEN
152     pcld(jl, jk) = pcldsw(jl, jk)/(1.-pclear(jl))
153 guez 24 ELSE
154 guez 81 pcld(jl, jk) = 0.
155 guez 24 END IF
156 guez 81 END DO
157     END DO
158    
159    
160     ! * 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
161     ! -----------------------------------------------
162    
163    
164     DO ja = 1, 2
165     DO jl = 1, kdlon
166     zud(jl, ja) = zud(jl, ja)*psec(jl)
167     END DO
168     END DO
169    
170     CALL swtt1(2, 2, iind, zud, zr)
171    
172     DO ja = 1, 2
173     DO jl = 1, kdlon
174     paki(jl, ja) = -log(zr(jl,ja))/zud(jl, ja)
175     END DO
176     END DO
177    
178     END SUBROUTINE swu
  ViewVC Help
Powered by ViewVC 1.1.21