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
      real*8 flag_aer
      real*8 tauae(kdlon,kflev,2)
      real*8 pizae(kdlon,kflev,2)
      real*8 cgae(kdlon,kflev,2)
      REAL*8 PAER(KDLON,KFLEV,5)
      REAL*8 PALBD(KDLON,2)
      REAL*8 PALBP(KDLON,2)
      REAL*8 PCG(KDLON,2,KFLEV)  
      REAL*8 PCLD(KDLON,KFLEV)
      REAL*8 PCLDSW(KDLON,KFLEV)
      REAL*8 PCLEAR(KDLON)
      REAL*8 PDSIG(KDLON,KFLEV)
      REAL*8 POMEGA(KDLON,2,KFLEV)
      REAL*8 POZ(KDLON,KFLEV)
      REAL*8 PRMU(KDLON)
      REAL*8 PSEC(KDLON)
      REAL*8 PTAU(KDLON,2,KFLEV)
      REAL*8 PUD(KDLON,5,KFLEV+1)
C
      REAL*8 PFD(KDLON,KFLEV+1)
      REAL*8 PFU(KDLON,KFLEV+1)
C
C* LOCAL VARIABLES:
C
      INTEGER IIND(4)
C      
      REAL*8 ZCGAZ(KDLON,KFLEV) 
      REAL*8 ZDIFF(KDLON)
      REAL*8 ZDIRF(KDLON)        
      REAL*8 ZPIZAZ(KDLON,KFLEV)
      REAL*8 ZRAYL(KDLON)
      REAL*8 ZRAY1(KDLON,KFLEV+1)
      REAL*8 ZRAY2(KDLON,KFLEV+1)
      REAL*8 ZREFZ(KDLON,2,KFLEV+1)
      REAL*8 ZRJ(KDLON,6,KFLEV+1)
      REAL*8 ZRJ0(KDLON,6,KFLEV+1)
      REAL*8 ZRK(KDLON,6,KFLEV+1)
      REAL*8 ZRK0(KDLON,6,KFLEV+1)
      REAL*8 ZRMUE(KDLON,KFLEV+1)
      REAL*8 ZRMU0(KDLON,KFLEV+1)
      REAL*8 ZR(KDLON,4)
      REAL*8 ZTAUAZ(KDLON,KFLEV)
      REAL*8 ZTRA1(KDLON,KFLEV+1)
      REAL*8 ZTRA2(KDLON,KFLEV+1)
      REAL*8 ZW(KDLON,4)
C
      INTEGER jl, jk, k, jaj, ikm1, ikl
c
c Prescribed Data:
c
      REAL*8 RSUN(2)
      SAVE RSUN
      REAL*8 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			real*8 flag_aer
46			real*8 tauae(kdlon,kflev,2)
47			real*8 pizae(kdlon,kflev,2)
48			real*8 cgae(kdlon,kflev,2)
49			REAL*8 PAER(KDLON,KFLEV,5)
50			REAL*8 PALBD(KDLON,2)
51			REAL*8 PALBP(KDLON,2)
52			REAL*8 PCG(KDLON,2,KFLEV)
53			REAL*8 PCLD(KDLON,KFLEV)
54			REAL*8 PCLDSW(KDLON,KFLEV)
55			REAL*8 PCLEAR(KDLON)
56			REAL*8 PDSIG(KDLON,KFLEV)
57			REAL*8 POMEGA(KDLON,2,KFLEV)
58			REAL*8 POZ(KDLON,KFLEV)
59			REAL*8 PRMU(KDLON)
60			REAL*8 PSEC(KDLON)
61			REAL*8 PTAU(KDLON,2,KFLEV)
62			REAL*8 PUD(KDLON,5,KFLEV+1)
63			C
64			REAL*8 PFD(KDLON,KFLEV+1)
65			REAL*8 PFU(KDLON,KFLEV+1)
66			C
67			C* LOCAL VARIABLES:
68			C
69			INTEGER IIND(4)
70			C
71			REAL*8 ZCGAZ(KDLON,KFLEV)
72			REAL*8 ZDIFF(KDLON)
73			REAL*8 ZDIRF(KDLON)
74			REAL*8 ZPIZAZ(KDLON,KFLEV)
75			REAL*8 ZRAYL(KDLON)
76			REAL*8 ZRAY1(KDLON,KFLEV+1)
77			REAL*8 ZRAY2(KDLON,KFLEV+1)
78			REAL*8 ZREFZ(KDLON,2,KFLEV+1)
79			REAL*8 ZRJ(KDLON,6,KFLEV+1)
80			REAL*8 ZRJ0(KDLON,6,KFLEV+1)
81			REAL*8 ZRK(KDLON,6,KFLEV+1)
82			REAL*8 ZRK0(KDLON,6,KFLEV+1)
83			REAL*8 ZRMUE(KDLON,KFLEV+1)
84			REAL*8 ZRMU0(KDLON,KFLEV+1)
85			REAL*8 ZR(KDLON,4)
86			REAL*8 ZTAUAZ(KDLON,KFLEV)
87			REAL*8 ZTRA1(KDLON,KFLEV+1)
88			REAL*8 ZTRA2(KDLON,KFLEV+1)
89			REAL*8 ZW(KDLON,4)
90			C
91			INTEGER jl, jk, k, jaj, ikm1, ikl
92			c
93			c Prescribed Data:
94			c
95			REAL*8 RSUN(2)
96			SAVE RSUN
97			REAL*8 RRAY(2,6)
98			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