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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 220 - (hide annotations)
Tue Apr 4 14:52:21 2017 UTC (7 years, 1 month ago) by guez
File size: 7952 byte(s) 
Removed unused aerosol variables. In procedure sw, ptopswai and
psolswai were always 0.
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 217 PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, PALBPLA, &
9     PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, &
10 guez 220 PTOPSWAD, PSOLSWAD, ok_ade)
11 guez 53
12 guez 72 ! Purpose.
13     ! This routine computes the shortwave radiation fluxes in two
14     ! spectral intervals following Fouquart and Bonnel (1980).
15 guez 53
16 guez 72 ! Method.
17     ! 1. Computes absorber amounts (swu)
18     ! 2. Computes fluxes in 1st spectral interval (SW1S)
19     ! 3. Computes fluxes in 2nd spectral interval (SW2S)
20 guez 53
21 guez 72 ! Reference.
22     ! See radiation part of the ECMWF research department
23     ! documentation, and Fouquart and Bonnel (1980)
24 guez 53
25 guez 72 ! Author.
26     ! Jean-Jacques Morcrette *ecmwf*
27 guez 53
28 guez 72 ! Modifications.
29     ! Original: 89-07-14
30     ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
31     ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
32 guez 53
33 guez 72 USE raddim, ONLY: kdlon, kflev
34 guez 118 USE suphec_m, ONLY: rcpd, rday, rg
35 guez 178 use sw1s_m, only: sw1s
36     use sw2s_m, only: sw2s
37 guez 220 use swu_m, only: swu
38 guez 53
39     ! ARGUMENTS:
40    
41     DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
42     DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
43     DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
44 guez 217 DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
45     DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
46     DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
47     DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
48     DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
49 guez 53 DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
50     DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
51     DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
52     DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
53     DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
54     DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
55 guez 217 DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
56 guez 53 DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
57     DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
58     DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
59     DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
60     DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
61     DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
62     DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
63     DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
64 guez 217 DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
65     DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
66     DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
67     DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
68 guez 53
69 guez 220 DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON)
70 guez 217 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
71 guez 53
72 guez 220 DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON)
73 guez 217 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
74    
75     logical, intent(in):: ok_ade ! use aerosol forcings or not?
76    
77     ! Local:
78    
79 guez 53 DOUBLE PRECISION ZOZ(KDLON, KFLEV)
80 guez 220 DOUBLE PRECISION ZAKI(KDLON, 2)
81 guez 53 DOUBLE PRECISION ZCLD(KDLON, KFLEV)
82 guez 220 DOUBLE PRECISION ZCLEAR(KDLON)
83 guez 53 DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
84     DOUBLE PRECISION ZFACT(KDLON)
85     DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
86     DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
87     DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
88     DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
89     DOUBLE PRECISION ZRMU(KDLON)
90     DOUBLE PRECISION ZSEC(KDLON)
91     DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
92     DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
93    
94     INTEGER inu, jl, jk, i, k, kpl1
95    
96 guez 72 INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
97 guez 53
98 guez 72 INTEGER:: itapsw = 0
99     LOGICAL:: appel1er = .TRUE.
100 guez 53 !jq-Introduced for aerosol forcings
101    
102     !jq - Fluxes including aerosol effects
103 guez 72 DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
104     DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
105 guez 53
106 guez 72 logical:: initialized = .false.
107 guez 118 REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
108 guez 72
109 guez 53 !-------------------------------------------------------------------
110    
111     if(.not.initialized) then
112     initialized=.TRUE.
113 guez 72 ZFSUPAD = 0.
114     ZFSDNAD = 0.
115 guez 53 endif
116     !rv
117    
118     IF (appel1er) THEN
119     PRINT*, 'SW calling frequency: ', swpas
120     PRINT*, " In general, it should be 1"
121     appel1er = .FALSE.
122     ENDIF
123    
124 guez 220 IF (MOD(itapsw, swpas) == 0) THEN
125     DO JK = 1, KFLEV
126 guez 53 DO JL = 1, KDLON
127     ZCLDSW0(JL, JK) = 0.0
128 guez 118 ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
129 guez 53 ENDDO
130     ENDDO
131    
132     ! clear-sky:
133     CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
134     PRMU0, PFRAC, PTAVE, PWV, &
135     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
136     INU = 1
137 guez 219 CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
138     ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
139 guez 53 INU = 2
140 guez 219 CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
141     ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
142 guez 220 DO JK = 1, KFLEV+1
143 guez 53 DO JL = 1, KDLON
144     ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
145     ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
146     ENDDO
147     ENDDO
148    
149     CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
150     PRMU0, PFRAC, PTAVE, PWV, &
151     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
152     INU = 1
153 guez 219 CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
154     ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
155 guez 53 INU = 2
156 guez 219 CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
157     ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
158 guez 53
159     ! cloudy-sky:
160    
161 guez 220 DO JK = 1, KFLEV+1
162 guez 53 DO JL = 1, KDLON
163     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
164     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
165     ENDDO
166     ENDDO
167    
168     IF (ok_ade) THEN
169     ! cloudy-sky + aerosol dir OB
170 guez 217 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, PRMU0, PFRAC, PTAVE, PWV, ZAKI, &
171     ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
172 guez 53 INU = 1
173 guez 219 CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
174     ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
175 guez 53 INU = 2
176 guez 219 CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
177     POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
178 guez 220 DO JK = 1, KFLEV+1
179 guez 53 DO JL = 1, KDLON
180 guez 220 ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
181     ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
182 guez 53 ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
183     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
184     ENDDO
185     ENDDO
186     ENDIF
187    
188     itapsw = 0
189     ENDIF
190     itapsw = itapsw + 1
191    
192     DO k = 1, KFLEV
193     kpl1 = k+1
194     DO i = 1, KDLON
195     PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
196     -(ZFSDN(i, k)-ZFSDN(i, kpl1))
197     PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
198     PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
199     -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
200     PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
201     ENDDO
202     ENDDO
203     DO i = 1, KDLON
204     PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
205    
206     PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
207     PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
208    
209     PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
210     PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
211    
212     PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
213     PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
214     ENDDO
215    
216     END SUBROUTINE SW
217    
218     end module sw_m
  ViewVC Help
Powered by ViewVC 1.1.21