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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 3 months ago) by guez
Original Path: trunk/Sources/phylmd/Radlwsw/sw.f
File size: 10629 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 53 module sw_m
2 guez 24
3 guez 53 IMPLICIT none
4 guez 24
5 guez 53 contains
6    
7     SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
8 guez 178 PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, &
9 guez 53 PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &
10     ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &
11     PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)
12    
13 guez 72 ! Purpose.
14     ! This routine computes the shortwave radiation fluxes in two
15     ! spectral intervals following Fouquart and Bonnel (1980).
16 guez 53
17 guez 72 ! Method.
18     ! 1. Computes absorber amounts (swu)
19     ! 2. Computes fluxes in 1st spectral interval (SW1S)
20     ! 3. Computes fluxes in 2nd spectral interval (SW2S)
21 guez 53
22 guez 72 ! Reference.
23     ! See radiation part of the ECMWF research department
24     ! documentation, and Fouquart and Bonnel (1980)
25 guez 53
26 guez 72 ! Author.
27     ! Jean-Jacques Morcrette *ecmwf*
28 guez 53
29 guez 72 ! Modifications.
30     ! Original: 89-07-14
31     ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
32     ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
33 guez 53
34 guez 72 USE raddim, ONLY: kdlon, kflev
35 guez 118 USE suphec_m, ONLY: rcpd, rday, rg
36 guez 178 use sw1s_m, only: sw1s
37     use sw2s_m, only: sw2s
38 guez 53
39     ! ARGUMENTS:
40    
41     DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
42    
43     DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
44     DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
45     DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
46    
47     DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
48     DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
49    
50     DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
51     DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
52     DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
53     DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
54    
55     DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
56     DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
57    
58     DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
59     DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
60     DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
61     DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
62    
63     DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
64     DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
65     DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
66     DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
67     DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
68     DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
69     DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
70    
71     ! LOCAL VARIABLES:
72    
73     DOUBLE PRECISION ZOZ(KDLON, KFLEV)
74     DOUBLE PRECISION ZAKI(KDLON, 2)
75     DOUBLE PRECISION ZCLD(KDLON, KFLEV)
76     DOUBLE PRECISION ZCLEAR(KDLON)
77     DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
78     DOUBLE PRECISION ZFACT(KDLON)
79     DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
80     DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
81     DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
82     DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
83     DOUBLE PRECISION ZRMU(KDLON)
84     DOUBLE PRECISION ZSEC(KDLON)
85     DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
86     DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
87    
88     DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
89     DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
90     DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
91     DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
92    
93     INTEGER inu, jl, jk, i, k, kpl1
94    
95 guez 72 INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
96 guez 53
97 guez 72 INTEGER:: itapsw = 0
98     LOGICAL:: appel1er = .TRUE.
99 guez 53 !jq-Introduced for aerosol forcings
100 guez 72 double precision, save:: flag_aer
101 guez 62 logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
102 guez 53 double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
103     double precision pizae(kdlon, kflev, 2)
104     ! aerosol optical properties(see aeropt.F)
105    
106     double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
107     DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
108     ! CLOUD OPTICAL THICKNESS (pre-industrial value)
109    
110     DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
111     DOUBLE PRECISION PTOPSWAD(KDLON)
112     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
113    
114     DOUBLE PRECISION PSOLSWAD(KDLON)
115     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
116    
117     DOUBLE PRECISION PTOPSWAI(KDLON)
118     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
119    
120     DOUBLE PRECISION PSOLSWAI(KDLON)
121     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
122    
123     !jq - Fluxes including aerosol effects
124 guez 72 DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
125     DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
126     DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
127     DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
128 guez 53
129 guez 72 logical:: initialized = .false.
130 guez 118 REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
131 guez 72
132 guez 53 !-------------------------------------------------------------------
133    
134     if(.not.initialized) then
135     flag_aer=0.
136     initialized=.TRUE.
137 guez 72 ZFSUPAD = 0.
138     ZFSDNAD = 0.
139     ZFSUPAI = 0.
140     ZFSDNAI = 0.
141 guez 53 endif
142     !rv
143    
144     IF (appel1er) THEN
145     PRINT*, 'SW calling frequency: ', swpas
146     PRINT*, " In general, it should be 1"
147     appel1er = .FALSE.
148     ENDIF
149    
150     IF (MOD(itapsw, swpas).EQ.0) THEN
151     DO JK = 1 , KFLEV
152     DO JL = 1, KDLON
153     ZCLDSW0(JL, JK) = 0.0
154 guez 118 ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
155 guez 53 ENDDO
156     ENDDO
157    
158     ! clear-sky:
159     CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
160     PRMU0, PFRAC, PTAVE, PWV, &
161     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
162     INU = 1
163     CALL SW1S(INU, &
164 guez 178 flag_aer, tauae, pizae, cgae, &
165     PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
166 guez 53 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
167     ZFD, ZFU)
168     INU = 2
169     CALL SW2S(INU, &
170 guez 178 flag_aer, tauae, pizae, cgae, &
171     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
172 guez 53 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
173     PWV, PQS, &
174     ZFDOWN, ZFUP)
175     DO JK = 1 , KFLEV+1
176     DO JL = 1, KDLON
177     ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
178     ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
179     ENDDO
180     ENDDO
181    
182 guez 62 flag_aer=0.
183 guez 53 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
184     PRMU0, PFRAC, PTAVE, PWV, &
185     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
186     INU = 1
187     CALL SW1S(INU, &
188 guez 178 flag_aer, tauae, pizae, cgae, &
189     PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
190 guez 53 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
191     ZFD, ZFU)
192     INU = 2
193     CALL SW2S(INU, &
194 guez 178 flag_aer, tauae, pizae, cgae, &
195     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
196 guez 53 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
197     PWV, PQS, &
198     ZFDOWN, ZFUP)
199    
200     ! cloudy-sky:
201    
202     DO JK = 1 , KFLEV+1
203     DO JL = 1, KDLON
204     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
205     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
206     ENDDO
207     ENDDO
208    
209     IF (ok_ade) THEN
210     ! cloudy-sky + aerosol dir OB
211 guez 62 flag_aer=1.
212 guez 53 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
213     PRMU0, PFRAC, PTAVE, PWV, &
214     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
215     INU = 1
216     CALL SW1S(INU, &
217 guez 178 flag_aer, tauae, pizae, cgae, &
218     PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
219 guez 53 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
220     ZFD, ZFU)
221     INU = 2
222     CALL SW2S(INU, &
223 guez 178 flag_aer, tauae, pizae, cgae, &
224     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
225 guez 53 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
226     PWV, PQS, &
227     ZFDOWN, ZFUP)
228     DO JK = 1 , KFLEV+1
229     DO JL = 1, KDLON
230     ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
231     ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
232     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
233     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
234     ENDDO
235     ENDDO
236     ENDIF
237    
238     IF (ok_aie) THEN
239     !jq cloudy-sky + aerosol direct + aerosol indirect
240     flag_aer=1.0
241     CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
242     PRMU0, PFRAC, PTAVE, PWV, &
243     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
244     INU = 1
245     CALL SW1S(INU, &
246 guez 178 flag_aer, tauae, pizae, cgae, &
247     PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
248 guez 53 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
249     ZFD, ZFU)
250     INU = 2
251     CALL SW2S(INU, &
252 guez 178 flag_aer, tauae, pizae, cgae, &
253     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
254 guez 53 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
255     PWV, PQS, &
256     ZFDOWN, ZFUP)
257     DO JK = 1 , KFLEV+1
258     DO JL = 1, KDLON
259     ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
260     ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
261     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
262     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
263     ENDDO
264     ENDDO
265     ENDIF
266    
267     itapsw = 0
268     ENDIF
269     itapsw = itapsw + 1
270    
271     DO k = 1, KFLEV
272     kpl1 = k+1
273     DO i = 1, KDLON
274     PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
275     -(ZFSDN(i, k)-ZFSDN(i, kpl1))
276     PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
277     PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
278     -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
279     PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
280     ENDDO
281     ENDDO
282     DO i = 1, KDLON
283     PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
284    
285     PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
286     PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
287    
288     PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
289     PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
290    
291     PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
292     PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
293    
294     PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
295     PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
296     ENDDO
297    
298     END SUBROUTINE SW
299    
300     end module sw_m
  ViewVC Help
Powered by ViewVC 1.1.21