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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 346 - (hide annotations)
Mon Dec 9 20:15:29 2019 UTC (4 years, 5 months ago) by guez
File size: 7795 byte(s) 
Rename block to `my_block` in procedure `CLOUDS_GNO` because block is
a Fortran keyword.

Remove computation of palpbla in procedure sw. It was not used nor
output. (Not used nor output either in LMDZ.)

In procedure physiq, define `d_[uv]_con` and add them to `[uv]_seri`
only if `conv_Emanuel`. Thus, we do not need to initialize
`d_[uv]_con` to 0, we do not have to save them and we do not add 0 to
`[uv]_seri`.

In procedure physiq, no need to initialize rnebcon to 0, it is defined
by phyetat0 afterwards.

Check that `iflag_cldcon` is between - 2 and 3.
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 346 PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, PTOPSW, &
9     PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, PTOPSWAD, &
10     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 guez 346 DOUBLE PRECISION PSCT ! constante solaire
42 guez 53 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 PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
60     DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
61     DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
62     DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
63 guez 217 DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
64     DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
65     DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
66     DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
67 guez 53
68 guez 220 DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON)
69 guez 217 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
70 guez 53
71 guez 220 DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON)
72 guez 217 ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
73    
74     logical, intent(in):: ok_ade ! use aerosol forcings or not?
75    
76     ! Local:
77    
78 guez 53 DOUBLE PRECISION ZOZ(KDLON, KFLEV)
79 guez 220 DOUBLE PRECISION ZAKI(KDLON, 2)
80 guez 53 DOUBLE PRECISION ZCLD(KDLON, KFLEV)
81 guez 220 DOUBLE PRECISION ZCLEAR(KDLON)
82 guez 53 DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
83     DOUBLE PRECISION ZFACT(KDLON)
84     DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
85     DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
86     DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
87     DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
88     DOUBLE PRECISION ZRMU(KDLON)
89     DOUBLE PRECISION ZSEC(KDLON)
90     DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
91     DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
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    
101     !jq - Fluxes including aerosol effects
102 guez 72 DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
103     DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
104 guez 53
105 guez 72 logical:: initialized = .false.
106 guez 118 REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
107 guez 72
108 guez 53 !-------------------------------------------------------------------
109    
110     if(.not.initialized) then
111     initialized=.TRUE.
112 guez 72 ZFSUPAD = 0.
113     ZFSDNAD = 0.
114 guez 53 endif
115     !rv
116    
117     IF (appel1er) THEN
118     PRINT*, 'SW calling frequency: ', swpas
119     PRINT*, " In general, it should be 1"
120     appel1er = .FALSE.
121     ENDIF
122    
123 guez 220 IF (MOD(itapsw, swpas) == 0) THEN
124     DO JK = 1, KFLEV
125 guez 53 DO JL = 1, KDLON
126     ZCLDSW0(JL, JK) = 0.0
127 guez 118 ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
128 guez 53 ENDDO
129     ENDDO
130    
131     ! clear-sky:
132     CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
133     PRMU0, PFRAC, PTAVE, PWV, &
134     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
135     INU = 1
136 guez 219 CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
137     ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
138 guez 53 INU = 2
139 guez 219 CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
140     ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
141 guez 220 DO JK = 1, KFLEV+1
142 guez 53 DO JL = 1, KDLON
143     ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
144     ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
145     ENDDO
146     ENDDO
147    
148     CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
149     PRMU0, PFRAC, PTAVE, PWV, &
150     ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
151     INU = 1
152 guez 219 CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
153     ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
154 guez 53 INU = 2
155 guez 219 CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
156     ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
157 guez 53
158     ! cloudy-sky:
159    
160 guez 220 DO JK = 1, KFLEV+1
161 guez 53 DO JL = 1, KDLON
162     ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
163     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
164     ENDDO
165     ENDDO
166    
167     IF (ok_ade) THEN
168     ! cloudy-sky + aerosol dir OB
169 guez 217 CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, PRMU0, PFRAC, PTAVE, PWV, ZAKI, &
170     ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
171 guez 53 INU = 1
172 guez 219 CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
173     ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
174 guez 53 INU = 2
175 guez 219 CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
176     POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
177 guez 220 DO JK = 1, KFLEV+1
178 guez 53 DO JL = 1, KDLON
179 guez 220 ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
180     ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
181 guez 53 ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
182     ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
183     ENDDO
184     ENDDO
185     ENDIF
186    
187     itapsw = 0
188     ENDIF
189     itapsw = itapsw + 1
190    
191     DO k = 1, KFLEV
192     kpl1 = k+1
193     DO i = 1, KDLON
194     PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
195     -(ZFSDN(i, k)-ZFSDN(i, kpl1))
196     PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
197     PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
198     -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
199     PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
200     ENDDO
201     ENDDO
202     DO i = 1, KDLON
203     PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
204     PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
205    
206     PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
207     PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
208    
209     PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
210     PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
211     ENDDO
212    
213     END SUBROUTINE SW
214    
215     end module sw_m
  ViewVC Help
Powered by ViewVC 1.1.21