phylmd/Radlwsw/sw1s.f

      SUBROUTINE SW1S ( KNU
     S  ,  PAER  , flag_aer, tauae, pizae, cgae
     S  ,  PALBD , PALBP, PCG  , PCLD , PCLEAR, PCLDSW
     S  ,  PDSIG , POMEGA, POZ  , PRMU , PSEC , PTAU  , PUD  
     S  ,  PFD   , PFU)
      use dimens_m
      use dimphy
      use raddim
      IMPLICIT none
C
C     ------------------------------------------------------------------
C     PURPOSE.
C     --------
C
C          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
C     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
C
C     METHOD.
C     -------
C
C          1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
C     CONTINUUM SCATTERING
C          2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
C
C     REFERENCE.
C     ----------
C
C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
C
C     AUTHOR.
C     -------
C        JEAN-JACQUES MORCRETTE  *ECMWF*
C
C     MODIFICATIONS.
C     --------------
C        ORIGINAL : 89-07-14
C        94-11-15   J.-J. MORCRETTE    DIRECT/DIFFUSE ALBEDO
C     ------------------------------------------------------------------
C
C* ARGUMENTS:
C
      INTEGER KNU
c-OB
      double precision flag_aer
      double precision tauae(kdlon,kflev,2)
      double precision pizae(kdlon,kflev,2)
      double precision cgae(kdlon,kflev,2)
      DOUBLE PRECISION PAER(KDLON,KFLEV,5)
      DOUBLE PRECISION PALBD(KDLON,2)
      DOUBLE PRECISION PALBP(KDLON,2)
      DOUBLE PRECISION PCG(KDLON,2,KFLEV)  
      DOUBLE PRECISION PCLD(KDLON,KFLEV)
      DOUBLE PRECISION PCLDSW(KDLON,KFLEV)
      DOUBLE PRECISION PCLEAR(KDLON)
      DOUBLE PRECISION PDSIG(KDLON,KFLEV)
      DOUBLE PRECISION POMEGA(KDLON,2,KFLEV)
      DOUBLE PRECISION POZ(KDLON,KFLEV)
      DOUBLE PRECISION PRMU(KDLON)
      DOUBLE PRECISION PSEC(KDLON)
      DOUBLE PRECISION PTAU(KDLON,2,KFLEV)
      DOUBLE PRECISION PUD(KDLON,5,KFLEV+1)
C
      DOUBLE PRECISION PFD(KDLON,KFLEV+1)
      DOUBLE PRECISION PFU(KDLON,KFLEV+1)
C
C* LOCAL VARIABLES:
C
      INTEGER IIND(4)
C      
      DOUBLE PRECISION ZCGAZ(KDLON,KFLEV) 
      DOUBLE PRECISION ZDIFF(KDLON)
      DOUBLE PRECISION ZDIRF(KDLON)        
      DOUBLE PRECISION ZPIZAZ(KDLON,KFLEV)
      DOUBLE PRECISION ZRAYL(KDLON)
      DOUBLE PRECISION ZRAY1(KDLON,KFLEV+1)
      DOUBLE PRECISION ZRAY2(KDLON,KFLEV+1)
      DOUBLE PRECISION ZREFZ(KDLON,2,KFLEV+1)
      DOUBLE PRECISION ZRJ(KDLON,6,KFLEV+1)
      DOUBLE PRECISION ZRJ0(KDLON,6,KFLEV+1)
      DOUBLE PRECISION ZRK(KDLON,6,KFLEV+1)
      DOUBLE PRECISION ZRK0(KDLON,6,KFLEV+1)
      DOUBLE PRECISION ZRMUE(KDLON,KFLEV+1)
      DOUBLE PRECISION ZRMU0(KDLON,KFLEV+1)
      DOUBLE PRECISION ZR(KDLON,4)
      DOUBLE PRECISION ZTAUAZ(KDLON,KFLEV)
      DOUBLE PRECISION ZTRA1(KDLON,KFLEV+1)
      DOUBLE PRECISION ZTRA2(KDLON,KFLEV+1)
      DOUBLE PRECISION ZW(KDLON,4)
C
      INTEGER jl, jk, k, jaj, ikm1, ikl
c
c Prescribed Data:
c
      DOUBLE PRECISION RSUN(2)
      SAVE RSUN
      DOUBLE PRECISION RRAY(2,6)
      SAVE RRAY
      DATA RSUN(1) / 0.441676 /
      DATA RSUN(2) / 0.558324 /
      DATA (RRAY(1,K),K=1,6) /
     S .428937E-01, .890743E+00,-.288555E+01,
     S .522744E+01,-.469173E+01, .161645E+01/
      DATA (RRAY(2,K),K=1,6) /
     S .697200E-02, .173297E-01,-.850903E-01,
     S .248261E+00,-.302031E+00, .129662E+00/
C     ------------------------------------------------------------------
C
C*         1.     FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
C                 ----------------------- ------------------
C
 100  CONTINUE
C
C
C*         1.1    OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
C                 -----------------------------------------
C
 110  CONTINUE
C
      DO 111 JL = 1, KDLON
      ZRAYL(JL) =  RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)
     S          * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)
     S          * (RRAY(KNU,5) + PRMU(JL) *  RRAY(KNU,6)       ))))
 111  CONTINUE
C
C
C     ------------------------------------------------------------------
C
C*         2.    CONTINUUM SCATTERING CALCULATIONS
C                ---------------------------------
C
 200  CONTINUE
C
C*         2.1   CLEAR-SKY FRACTION OF THE COLUMN
C                --------------------------------
C  
 210  CONTINUE
C
      CALL SWCLR ( KNU
     S  , PAER   , flag_aer, tauae, pizae, cgae
     S  , PALBP  , PDSIG , ZRAYL, PSEC
     S  , ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
     S  , ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
C
C
C*         2.2   CLOUDY FRACTION OF THE COLUMN
C                -----------------------------
C
 220  CONTINUE
C
      CALL SWR ( KNU
     S  , PALBD ,PCG   ,PCLD  ,PDSIG ,POMEGA,ZRAYL
     S  , PSEC  ,PTAU
     S  , ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 ,ZREFZ ,ZRJ  ,ZRK,ZRMUE
     S  , ZTAUAZ,ZTRA1 ,ZTRA2)
C
C
C     ------------------------------------------------------------------
C
C*         3.    OZONE ABSORPTION
C                ----------------
C
 300  CONTINUE
C
      IIND(1)=1
      IIND(2)=3
      IIND(3)=1
      IIND(4)=3
C      
C
C*         3.1   DOWNWARD FLUXES
C                ---------------
C
 310  CONTINUE
C
      JAJ = 2
C
      DO 311 JL = 1, KDLON
      ZW(JL,1)=0.
      ZW(JL,2)=0.
      ZW(JL,3)=0.
      ZW(JL,4)=0.
      PFD(JL,KFLEV+1)=((1.-PCLEAR(JL))*ZRJ(JL,JAJ,KFLEV+1)
     S     + PCLEAR(JL) *ZRJ0(JL,JAJ,KFLEV+1)) * RSUN(KNU)
 311  CONTINUE
      DO 314 JK = 1 , KFLEV
      IKL = KFLEV+1-JK
      DO 312 JL = 1, KDLON
      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
      ZW(JL,2)=ZW(JL,2)+POZ(JL,  IKL)/ZRMUE(JL,IKL)
      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
      ZW(JL,4)=ZW(JL,4)+POZ(JL,  IKL)/ZRMU0(JL,IKL)
 312  CONTINUE
C
      CALL SWTT1(KNU, 4, IIND, ZW, ZR)
C
      DO 313 JL = 1, KDLON
      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRJ(JL,JAJ,IKL)
      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRJ0(JL,JAJ,IKL)
      PFD(JL,IKL) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
     S                  +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
 313  CONTINUE
 314  CONTINUE
C
C
C*         3.2   UPWARD FLUXES
C                -------------
C
 320  CONTINUE
C
      DO 325 JL = 1, KDLON
      PFU(JL,1) = ((1.-PCLEAR(JL))*ZDIFF(JL)*PALBD(JL,KNU)
     S               + PCLEAR(JL) *ZDIRF(JL)*PALBP(JL,KNU))
     S          * RSUN(KNU)
 325  CONTINUE
C
      DO 328 JK = 2 , KFLEV+1
      IKM1=JK-1
      DO 326 JL = 1, KDLON
      ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66
      ZW(JL,2)=ZW(JL,2)+POZ(JL,  IKM1)*1.66
      ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66
      ZW(JL,4)=ZW(JL,4)+POZ(JL,  IKM1)*1.66
 326  CONTINUE
C
      CALL SWTT1(KNU, 4, IIND, ZW, ZR)
C
      DO 327 JL = 1, KDLON
      ZDIFF(JL) = ZR(JL,1)*ZR(JL,2)*ZRK(JL,JAJ,JK)
      ZDIRF(JL) = ZR(JL,3)*ZR(JL,4)*ZRK0(JL,JAJ,JK)
      PFU(JL,JK) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
     S                 +PCLEAR(JL)  * ZDIRF(JL)) * RSUN(KNU)
 327  CONTINUE
 328  CONTINUE
C
C     ------------------------------------------------------------------
C
      RETURN
      END
1	guez	24	SUBROUTINE SW1S ( KNU
2			S , PAER , flag_aer, tauae, pizae, cgae
3			S , PALBD , PALBP, PCG , PCLD , PCLEAR, PCLDSW
4			S , PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD
5			S , PFD , PFU)
6			use dimens_m
7			use dimphy
8			use raddim
9			IMPLICIT none
10			C
11			C ------------------------------------------------------------------
12			C PURPOSE.
13			C --------
14			C
15			C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
16			C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
17			C
18			C METHOD.
19			C -------
20			C
21			C 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
22			C CONTINUUM SCATTERING
23			C 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
24			C
25			C REFERENCE.
26			C ----------
27			C
28			C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
29			C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
30			C
31			C AUTHOR.
32			C -------
33			C JEAN-JACQUES MORCRETTE ECMWF
34			C
35			C MODIFICATIONS.
36			C --------------
37			C ORIGINAL : 89-07-14
38			C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
39			C ------------------------------------------------------------------
40			C
41			C* ARGUMENTS:
42			C
43			INTEGER KNU
44			c-OB
45	guez	71	double precision flag_aer
46			double precision tauae(kdlon,kflev,2)
47			double precision pizae(kdlon,kflev,2)
48			double precision cgae(kdlon,kflev,2)
49			DOUBLE PRECISION PAER(KDLON,KFLEV,5)
50			DOUBLE PRECISION PALBD(KDLON,2)
51			DOUBLE PRECISION PALBP(KDLON,2)
52			DOUBLE PRECISION PCG(KDLON,2,KFLEV)
53			DOUBLE PRECISION PCLD(KDLON,KFLEV)
54			DOUBLE PRECISION PCLDSW(KDLON,KFLEV)
55			DOUBLE PRECISION PCLEAR(KDLON)
56			DOUBLE PRECISION PDSIG(KDLON,KFLEV)
57			DOUBLE PRECISION POMEGA(KDLON,2,KFLEV)
58			DOUBLE PRECISION POZ(KDLON,KFLEV)
59			DOUBLE PRECISION PRMU(KDLON)
60			DOUBLE PRECISION PSEC(KDLON)
61			DOUBLE PRECISION PTAU(KDLON,2,KFLEV)
62			DOUBLE PRECISION PUD(KDLON,5,KFLEV+1)
63	guez	24	C
64	guez	71	DOUBLE PRECISION PFD(KDLON,KFLEV+1)
65			DOUBLE PRECISION PFU(KDLON,KFLEV+1)
66	guez	24	C
67			C* LOCAL VARIABLES:
68			C
69			INTEGER IIND(4)
70			C
71	guez	71	DOUBLE PRECISION ZCGAZ(KDLON,KFLEV)
72			DOUBLE PRECISION ZDIFF(KDLON)
73			DOUBLE PRECISION ZDIRF(KDLON)
74			DOUBLE PRECISION ZPIZAZ(KDLON,KFLEV)
75			DOUBLE PRECISION ZRAYL(KDLON)
76			DOUBLE PRECISION ZRAY1(KDLON,KFLEV+1)
77			DOUBLE PRECISION ZRAY2(KDLON,KFLEV+1)
78			DOUBLE PRECISION ZREFZ(KDLON,2,KFLEV+1)
79			DOUBLE PRECISION ZRJ(KDLON,6,KFLEV+1)
80			DOUBLE PRECISION ZRJ0(KDLON,6,KFLEV+1)
81			DOUBLE PRECISION ZRK(KDLON,6,KFLEV+1)
82			DOUBLE PRECISION ZRK0(KDLON,6,KFLEV+1)
83			DOUBLE PRECISION ZRMUE(KDLON,KFLEV+1)
84			DOUBLE PRECISION ZRMU0(KDLON,KFLEV+1)
85			DOUBLE PRECISION ZR(KDLON,4)
86			DOUBLE PRECISION ZTAUAZ(KDLON,KFLEV)
87			DOUBLE PRECISION ZTRA1(KDLON,KFLEV+1)
88			DOUBLE PRECISION ZTRA2(KDLON,KFLEV+1)
89			DOUBLE PRECISION ZW(KDLON,4)
90	guez	24	C
91			INTEGER jl, jk, k, jaj, ikm1, ikl
92			c
93			c Prescribed Data:
94			c
95	guez	71	DOUBLE PRECISION RSUN(2)
96	guez	24	SAVE RSUN
97	guez	71	DOUBLE PRECISION RRAY(2,6)
98	guez	24	SAVE RRAY
99			DATA RSUN(1) / 0.441676 /
100			DATA RSUN(2) / 0.558324 /
101			DATA (RRAY(1,K),K=1,6) /
102			S .428937E-01, .890743E+00,-.288555E+01,
103			S .522744E+01,-.469173E+01, .161645E+01/
104			DATA (RRAY(2,K),K=1,6) /
105			S .697200E-02, .173297E-01,-.850903E-01,
106			S .248261E+00,-.302031E+00, .129662E+00/
107			C ------------------------------------------------------------------
108			C
109			C* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
110			C ----------------------- ------------------
111			C
112			100 CONTINUE
113			C
114			C
115			C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
116			C -----------------------------------------
117			C
118			110 CONTINUE
119			C
120			DO 111 JL = 1, KDLON
121			ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)
122			S * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)
123			S * (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) ))))
124			111 CONTINUE
125			C
126			C
127			C ------------------------------------------------------------------
128			C
129			C* 2. CONTINUUM SCATTERING CALCULATIONS
130			C ---------------------------------
131			C
132			200 CONTINUE
133			C
134			C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN
135			C --------------------------------
136			C
137			210 CONTINUE
138			C
139			CALL SWCLR ( KNU
140			S , PAER , flag_aer, tauae, pizae, cgae
141			S , PALBP , PDSIG , ZRAYL, PSEC
142			S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
143			S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
144			C
145			C
146			C* 2.2 CLOUDY FRACTION OF THE COLUMN
147			C -----------------------------
148			C
149			220 CONTINUE
150			C
151			CALL SWR ( KNU
152			S , PALBD ,PCG ,PCLD ,PDSIG ,POMEGA,ZRAYL
153			S , PSEC ,PTAU
154			S , ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 ,ZREFZ ,ZRJ ,ZRK,ZRMUE
155			S , ZTAUAZ,ZTRA1 ,ZTRA2)
156			C
157			C
158			C ------------------------------------------------------------------
159			C
160			C* 3. OZONE ABSORPTION
161			C ----------------
162			C
163			300 CONTINUE
164			C
165			IIND(1)=1
166			IIND(2)=3
167			IIND(3)=1
168			IIND(4)=3
169			C
170			C
171			C* 3.1 DOWNWARD FLUXES
172			C ---------------
173			C
174			310 CONTINUE
175			C
176			JAJ = 2
177			C
178			DO 311 JL = 1, KDLON
179			ZW(JL,1)=0.
180			ZW(JL,2)=0.
181			ZW(JL,3)=0.
182			ZW(JL,4)=0.
183			PFD(JL,KFLEV+1)=((1.-PCLEAR(JL))*ZRJ(JL,JAJ,KFLEV+1)
184			S + PCLEAR(JL) ZRJ0(JL,JAJ,KFLEV+1)) RSUN(KNU)
185			311 CONTINUE
186			DO 314 JK = 1 , KFLEV
187			IKL = KFLEV+1-JK
188			DO 312 JL = 1, KDLON
189			ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
190			ZW(JL,2)=ZW(JL,2)+POZ(JL, IKL)/ZRMUE(JL,IKL)
191			ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
192			ZW(JL,4)=ZW(JL,4)+POZ(JL, IKL)/ZRMU0(JL,IKL)
193			312 CONTINUE
194			C
195			CALL SWTT1(KNU, 4, IIND, ZW, ZR)
196			C
197			DO 313 JL = 1, KDLON
198			ZDIFF(JL) = ZR(JL,1)ZR(JL,2)ZRJ(JL,JAJ,IKL)
199			ZDIRF(JL) = ZR(JL,3)ZR(JL,4)ZRJ0(JL,JAJ,IKL)
200			PFD(JL,IKL) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
201			S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU)
202			313 CONTINUE
203			314 CONTINUE
204			C
205			C
206			C* 3.2 UPWARD FLUXES
207			C -------------
208			C
209			320 CONTINUE
210			C
211			DO 325 JL = 1, KDLON
212			PFU(JL,1) = ((1.-PCLEAR(JL))ZDIFF(JL)PALBD(JL,KNU)
213			S + PCLEAR(JL) ZDIRF(JL)PALBP(JL,KNU))
214			S * RSUN(KNU)
215			325 CONTINUE
216			C
217			DO 328 JK = 2 , KFLEV+1
218			IKM1=JK-1
219			DO 326 JL = 1, KDLON
220			ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66
221			ZW(JL,2)=ZW(JL,2)+POZ(JL, IKM1)*1.66
222			ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66
223			ZW(JL,4)=ZW(JL,4)+POZ(JL, IKM1)*1.66
224			326 CONTINUE
225			C
226			CALL SWTT1(KNU, 4, IIND, ZW, ZR)
227			C
228			DO 327 JL = 1, KDLON
229			ZDIFF(JL) = ZR(JL,1)ZR(JL,2)ZRK(JL,JAJ,JK)
230			ZDIRF(JL) = ZR(JL,3)ZR(JL,4)ZRK0(JL,JAJ,JK)
231			PFU(JL,JK) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
232			S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU)
233			327 CONTINUE
234			328 CONTINUE
235			C
236			C ------------------------------------------------------------------
237			C
238			RETURN
239			END