Context Navigation

radlwsw.F @ 226

Last change on this file since 226 was 177, checked in by lmdzadmin, 24 years ago

Lots of stuff, plus particulierement:

appel a ORCHIDEE en etat de marche (pb de grille subsiste)
modifs de Pascale sur soil dans le cas ou ok_veget=false -

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 184.9 KB

Rev	Line
[2]	1	SUBROUTINE radlwsw(dist, rmu0, fract, co2_ppm, solaire,
	2	. paprs, pplay,tsol,albedo, t,q,wo,
	3	. cldfra, cldemi, cldtau,
	4	. heat,heat0,cool,cool0,radsol,albpla,
	5	. topsw,toplw,solsw,sollw,
[177]	6	. sollwdown,
[2]	7	. topsw0,toplw0,solsw0,sollw0)
	8	IMPLICIT none
	9	c======================================================================
	10	c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
	11	c Objet: interface entre le modele et les rayonnements
	12	c Arguments:
	13	c dist-----input-R- distance astronomique terre-soleil
	14	c rmu0-----input-R- cosinus de l'angle zenithal
	15	c fract----input-R- duree d'ensoleillement normalisee
	16	c co2_ppm--input-R- concentration du gaz carbonique (en ppm)
	17	c solaire--input-R- constante solaire (W/m**2)
	18	c paprs----input-R- pression a inter-couche (Pa)
	19	c pplay----input-R- pression au milieu de couche (Pa)
	20	c tsol-----input-R- temperature du sol (en K)
	21	c albedo---input-R- albedo du sol (entre 0 et 1)
	22	c t--------input-R- temperature (K)
	23	c q--------input-R- vapeur d'eau (en kg/kg)
	24	c wo-------input-R- contenu en ozone (en cm.atm)
	25	c cldfra---input-R- fraction nuageuse (entre 0 et 1)
	26	c cldtau---input-R- epaisseur optique des nuages dans le visible
	27	c cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
	28	c
	29	c heat-----output-R- echauffement atmospherique (visible) (K/jour)
	30	c cool-----output-R- refroidissement dans l'IR (K/jour)
	31	c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
	32	c albpla---output-R- albedo planetaire (entre 0 et 1)
	33	c topsw----output-R- ray. solaire absorbe au sommet de l'atm.
	34	c toplw----output-R- ray. IR emis au sommet de l'atmosphere
	35	c solsw----output-R- ray. solaire net absorbe a la surface
	36	c sollw----output-R- ray. IR net emis par la surface
	37	c======================================================================
	38	#include "dimensions.h"
	39	#include "dimphy.h"
	40	#include "raddim.h"
	41	c
	42	real rmu0(klon), fract(klon), dist
	43	real co2_ppm
	44	real solaire
	45	c
	46	real paprs(klon,klev+1), pplay(klon,klev)
	47	real albedo(klon), tsol(klon)
	48	real t(klon,klev), q(klon,klev), wo(klon,klev)
	49	real cldfra(klon,klev), cldemi(klon,klev), cldtau(klon,klev)
	50	real heat(klon,klev), cool(klon,klev)
	51	real heat0(klon,klev), cool0(klon,klev)
	52	real radsol(klon), topsw(klon), toplw(klon)
	53	real solsw(klon), sollw(klon), albpla(klon)
	54	real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
[177]	55	real sollwdown(klon)
[2]	56	c
	57	REAL*8 zx_alpha1, zx_alpha2
	58	c
	59	#include "YOMCST.h"
	60	c
	61	INTEGER k, kk, i, j, iof, nb_gr
	62	EXTERNAL lw, sw
	63	c
	64	REAL*8 RCO2, RCH4, RN2O, RCFC11, RCFC12
	65	REAL*8 PSCT
	66	c
	67	REAL*8 PALBD(kdlon,2), PALBP(kdlon,2)
	68	REAL*8 PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
	69	REAL*8 PPSOL(kdlon), PDP(kdlon,klev)
	70	REAL*8 PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
	71	REAL*8 PTAVE(kdlon,kflev)
	72	REAL*8 PWV(kdlon,kflev), PQS(kdlon,kflev), POZON(kdlon,kflev)
	73	REAL*8 PAER(kdlon,kflev,5)
	74	REAL*8 PCLDLD(kdlon,kflev)
	75	REAL*8 PCLDLU(kdlon,kflev)
	76	REAL*8 PCLDSW(kdlon,kflev)
	77	REAL*8 PTAU(kdlon,2,kflev)
	78	REAL*8 POMEGA(kdlon,2,kflev)
	79	REAL*8 PCG(kdlon,2,kflev)
	80	c
	81	REAL*8 zfract(kdlon), zrmu0(kdlon), zdist
	82	c
	83	REAL*8 zheat(kdlon,kflev), zcool(kdlon,kflev)
	84	REAL*8 zheat0(kdlon,kflev), zcool0(kdlon,kflev)
	85	REAL*8 ztopsw(kdlon), ztoplw(kdlon)
	86	REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
[177]	87	REAL*8 zsollwdown(kdlon)
[2]	88	REAL*8 ztopsw0(kdlon), ztoplw0(kdlon)
	89	REAL*8 zsolsw0(kdlon), zsollw0(kdlon)
	90
	91	c
	92	c-------------------------------------------
	93	nb_gr = klon / kdlon
	94	IF (nb_gr*kdlon .NE. klon) THEN
	95	PRINT*, "kdlon mauvais:", klon, kdlon, nb_gr
	96	CALL abort
	97	ENDIF
	98	IF (kflev .NE. klev) THEN
	99	PRINT*, "kflev differe de klev, kflev, klev"
	100	CALL abort
	101	ENDIF
	102	c-------------------------------------------
	103	DO k = 1, klev
	104	DO i = 1, klon
	105	heat(i,k)=0.
	106	cool(i,k)=0.
	107	heat0(i,k)=0.
	108	cool0(i,k)=0.
	109	ENDDO
	110	ENDDO
	111	c
	112	zdist = dist
	113	c
	114	RCO2 = co2_ppm * 1.0e-06 * 44.011/28.97
	115	RCH4 = 1.72E-06* 16.043/28.97
	116	RN2O = 310.E-09* 44.013/28.97
	117	RCFC11 = 280.E-12* 137.3686/28.97
	118	RCFC12 = 484.E-12* 120.9140/28.97
	119	PSCT = solaire/zdist/zdist
	120	c
	121	DO 99999 j = 1, nb_gr
	122	iof = kdlon*(j-1)
	123	c
	124	DO i = 1, kdlon
	125	zfract(i) = fract(iof+i)
	126	zrmu0(i) = rmu0(iof+i)
	127	PALBD(i,1) = albedo(iof+i)
	128	PALBD(i,2) = albedo(iof+i)
	129	PALBP(i,1) = albedo(iof+i)
	130	PALBP(i,2) = albedo(iof+i)
	131	PEMIS(i) = 0.96
	132	PVIEW(i) = 1.66
	133	PPSOL(i) = paprs(iof+i,1)
	134	zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))
	135	. / (pplay(iof+i,1)-pplay(iof+i,2))
	136	zx_alpha2 = 1.0 - zx_alpha1
	137	PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
	138	PTL(i,klev+1) = t(iof+i,klev)
	139	PDT0(i) = tsol(iof+i) - PTL(i,1)
	140	ENDDO
	141	DO k = 2, kflev
	142	DO i = 1, kdlon
	143	PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
	144	ENDDO
	145	ENDDO
	146	DO k = 1, kflev
	147	DO i = 1, kdlon
	148	PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
	149	PTAVE(i,k) = t(iof+i,k)
	150	PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
	151	PQS(i,k) = PWV(i,k)
	152	c wo: cm.atm (epaisseur en cm dans la situation standard)
	153	c POZON: kg/kg
	154	POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968
	155	. /(paprs(iof+i,k)-paprs(iof+i,k+1))
	156	. *(paprs(iof+i,1)/101325.0)
	157	PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
	158	PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
	159	PCLDSW(i,k) = cldfra(iof+i,k)
	160	PTAU(i,1,k) = MAX(cldtau(iof+i,k), 1.0e-05)! 1e-12 serait instable
	161	PTAU(i,2,k) = MAX(cldtau(iof+i,k), 1.0e-05)! pour 32-bit machines
	162	POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
	163	POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
	164	PCG(i,1,k) = 0.865
	165	PCG(i,2,k) = 0.910
	166	ENDDO
	167	ENDDO
	168	c
	169	DO k = 1, kflev+1
	170	DO i = 1, kdlon
	171	PPMB(i,k) = paprs(iof+i,k)/100.0
	172	ENDDO
	173	ENDDO
	174	c
	175	DO kk = 1, 5
	176	DO k = 1, kflev
	177	DO i = 1, kdlon
	178	PAER(i,k,kk) = 1.0E-15
	179	ENDDO
	180	ENDDO
	181	ENDDO
	182	c
	183	c======================================================================
	184	CALL LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
	185	. PPMB, PDP,
	186	. PPSOL,PDT0,PEMIS,
	187	. PTL, PTAVE, PWV, POZON, PAER,
	188	. PCLDLD,PCLDLU,
	189	. PVIEW,
	190	. zcool, zcool0,
[177]	191	. ztoplw,zsollw,ztoplw0,zsollw0,
	192	. zsollwdown)
[2]	193	CALL SW(PSCT, RCO2, zrmu0, zfract,
	194	S PPMB, PDP,
	195	S PPSOL, PALBD, PALBP,
	196	S PTAVE, PWV, PQS, POZON, PAER,
	197	S PCLDSW, PTAU, POMEGA, PCG,
	198	S zheat, zheat0,
	199	S zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0)
	200	c======================================================================
	201	DO i = 1, kdlon
	202	radsol(iof+i) = zsolsw(i) + zsollw(i)
	203	topsw(iof+i) = ztopsw(i)
	204	toplw(iof+i) = ztoplw(i)
	205	solsw(iof+i) = zsolsw(i)
	206	sollw(iof+i) = zsollw(i)
[177]	207	sollwdown(iof+i) = zsollwdown(i)
[2]	208	topsw0(iof+i) = ztopsw0(i)
	209	toplw0(iof+i) = ztoplw0(i)
	210	solsw0(iof+i) = zsolsw0(i)
	211	sollw0(iof+i) = zsollw0(i)
	212	albpla(iof+i) = zalbpla(i)
	213	ENDDO
	214	DO k = 1, kflev
	215	DO i = 1, kdlon
	216	heat(iof+i,k) = zheat(i,k)
	217	cool(iof+i,k) = zcool(i,k)
	218	heat0(iof+i,k) = zheat0(i,k)
	219	cool0(iof+i,k) = zcool0(i,k)
	220	ENDDO
	221	ENDDO
	222	c
	223	99999 CONTINUE
	224	RETURN
	225	END
	226	SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC,
	227	S PPMB, PDP,
	228	S PPSOL, PALBD, PALBP,
	229	S PTAVE, PWV, PQS, POZON, PAER,
	230	S PCLDSW, PTAU, POMEGA, PCG,
	231	S PHEAT, PHEAT0,
	232	S PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0)
	233	IMPLICIT none
	234
	235	#include "dimensions.h"
	236	#include "dimphy.h"
	237	#include "raddim.h"
	238	#include "YOMCST.h"
	239	C
	240	C ------------------------------------------------------------------
	241	C
	242	C PURPOSE.
	243	C --------
	244	C
	245	C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
	246	C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
	247	C
	248	C METHOD.
	249	C -------
	250	C
	251	C 1. COMPUTES ABSORBER AMOUNTS (SWU)
	252	C 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
	253	C 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
	254	C
	255	C REFERENCE.
	256	C ----------
	257	C
	258	C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	259	C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	260	C
	261	C AUTHOR.
	262	C -------
	263	C JEAN-JACQUES MORCRETTE ECMWF
	264	C
	265	C MODIFICATIONS.
	266	C --------------
	267	C ORIGINAL : 89-07-14
	268	C 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
	269	C ------------------------------------------------------------------
	270	C
	271	C* ARGUMENTS:
	272	C
	273	REAL*8 PSCT ! constante solaire (valeur conseillee: 1370)
	274	REAL8 RCO2 ! concentration CO2 (IPCC: 353.E-0644.011/28.97)
	275	C
	276	REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (PA)
	277	REAL*8 PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA)
	278	REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
	279	C
	280	REAL*8 PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
	281	REAL*8 PFRAC(KDLON) ! fraction de la journee
	282	C
	283	REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
	284	REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
	285	REAL*8 PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
	286	REAL*8 POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG)
	287	REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
	288	C
	289	REAL*8 PALBD(KDLON,2) ! albedo du sol (lumiere diffuse)
	290	REAL*8 PALBP(KDLON,2) ! albedo du sol (lumiere parallele)
	291	C
	292	REAL*8 PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION
	293	REAL*8 PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS
	294	REAL*8 PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR
	295	REAL*8 POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
	296	C
	297	REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
	298	REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
	299	REAL*8 PALBPLA(KDLON) ! PLANETARY ALBEDO
	300	REAL*8 PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
	301	REAL*8 PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
	302	REAL*8 PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
	303	REAL*8 PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
	304	C
	305	C* LOCAL VARIABLES:
	306	C
	307	REAL*8 ZOZ(KDLON,KFLEV)
	308	REAL*8 ZAKI(KDLON,2)
	309	REAL*8 ZCLD(KDLON,KFLEV)
	310	REAL*8 ZCLEAR(KDLON)
	311	REAL*8 ZDSIG(KDLON,KFLEV)
	312	REAL*8 ZFACT(KDLON)
	313	REAL*8 ZFD(KDLON,KFLEV+1)
	314	REAL*8 ZFDOWN(KDLON,KFLEV+1)
	315	REAL*8 ZFU(KDLON,KFLEV+1)
	316	REAL*8 ZFUP(KDLON,KFLEV+1)
	317	REAL*8 ZRMU(KDLON)
	318	REAL*8 ZSEC(KDLON)
	319	REAL*8 ZUD(KDLON,5,KFLEV+1)
	320	REAL*8 ZCLDSW0(KDLON,KFLEV)
	321	c
	322	REAL*8 ZFSUP(KDLON,KFLEV+1)
	323	REAL*8 ZFSDN(KDLON,KFLEV+1)
	324	REAL*8 ZFSUP0(KDLON,KFLEV+1)
	325	REAL*8 ZFSDN0(KDLON,KFLEV+1)
	326	SAVE ZFSUP, ZFSDN, ZFSUP0, ZFSDN0
	327	C
	328	INTEGER inu, jl, jk, i, k, kpl1
	329	c
	330	INTEGER swpas ! Every swpas steps, sw is calculated
	331	PARAMETER(swpas=1)
	332	c
	333	INTEGER itapsw
	334	LOGICAL appel1er
	335	DATA itapsw /0/
	336	DATA appel1er /.TRUE./
	337	c
	338	IF (appel1er) THEN
	339	PRINT*, 'SW calling frequency : ', swpas
	340	PRINT*, " In general, it should be 1"
	341	appel1er = .FALSE.
	342	ENDIF
	343	C ------------------------------------------------------------------
	344	IF (MOD(itapsw,swpas).EQ.0) THEN
	345	c
	346	DO JK = 1 , KFLEV
	347	DO JL = 1, KDLON
	348	ZCLDSW0(JL,JK) = 0.0
	349	ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG
	350	. PDP(JL,JK)(101325.0/PPSOL(JL))
	351	ENDDO
	352	ENDDO
	353	C
	354	C
	355	c clear-sky:
	356	CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,
	357	S PRMU0,PFRAC,PTAVE,PWV,
	358	S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	359	INU = 1
	360	CALL SW1S(INU,
	361	S PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
	362	S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
	363	S ZFD, ZFU)
	364	INU = 2
	365	CALL SW2S(INU,
	366	S PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
	367	S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
	368	S PWV, PQS,
	369	S ZFDOWN, ZFUP)
	370	DO JK = 1 , KFLEV+1
	371	DO JL = 1, KDLON
	372	ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	373	ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
	374	ENDDO
	375	ENDDO
	376	c cloudy-sky:
	377	CALL SWU(PSCT,RCO2,PCLDSW,PPMB,PPSOL,
	378	S PRMU0,PFRAC,PTAVE,PWV,
	379	S ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	380	INU = 1
	381	CALL SW1S(INU,
	382	S PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
	383	S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
	384	S ZFD, ZFU)
	385	INU = 2
	386	CALL SW2S(INU,
	387	S PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
	388	S ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
	389	S PWV, PQS,
	390	S ZFDOWN, ZFUP)
	391	DO JK = 1 , KFLEV+1
	392	DO JL = 1, KDLON
	393	ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	394	ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
	395	ENDDO
	396	ENDDO
	397	c
	398	itapsw = 0
	399	ENDIF
	400	itapsw = itapsw + 1
	401	C
	402	DO k = 1, KFLEV
	403	kpl1 = k+1
	404	DO i = 1, KDLON
	405	PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))
	406	. -(ZFSDN(i,k)-ZFSDN(i,kpl1))
	407	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
	408	PHEAT0(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))
	409	. -(ZFSDN(i,k)-ZFSDN(i,kpl1))
	410	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
	411	ENDDO
	412	ENDDO
	413	DO i = 1, KDLON
	414	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
	415	c
	416	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
	417	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
	418	c
	419	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
	420	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
	421	ENDDO
	422	C
	423	RETURN
	424	END
	425	c
	426	SUBROUTINE SWU (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,
	427	S PTAVE,PWV,PAKI,PCLD,PCLEAR,PDSIG,PFACT,
	428	S PRMU,PSEC,PUD)
	429	IMPLICIT none
	430	#include "dimensions.h"
	431	#include "dimphy.h"
	432	#include "raddim.h"
	433	#include "radepsi.h"
	434	#include "radopt.h"
	435	#include "YOMCST.h"
	436	C
	437	C* ARGUMENTS:
	438	C
	439	REAL*8 PSCT
	440	REAL*8 RCO2
	441	REAL*8 PCLDSW(KDLON,KFLEV)
	442	REAL*8 PPMB(KDLON,KFLEV+1)
	443	REAL*8 PPSOL(KDLON)
	444	REAL*8 PRMU0(KDLON)
	445	REAL*8 PFRAC(KDLON)
	446	REAL*8 PTAVE(KDLON,KFLEV)
	447	REAL*8 PWV(KDLON,KFLEV)
	448	C
	449	REAL*8 PAKI(KDLON,2)
	450	REAL*8 PCLD(KDLON,KFLEV)
	451	REAL*8 PCLEAR(KDLON)
	452	REAL*8 PDSIG(KDLON,KFLEV)
	453	REAL*8 PFACT(KDLON)
	454	REAL*8 PRMU(KDLON)
	455	REAL*8 PSEC(KDLON)
	456	REAL*8 PUD(KDLON,5,KFLEV+1)
	457	C
	458	C* LOCAL VARIABLES:
	459	C
	460	INTEGER IIND(2)
	461	REAL*8 ZC1J(KDLON,KFLEV+1)
	462	REAL*8 ZCLEAR(KDLON)
	463	REAL*8 ZCLOUD(KDLON)
	464	REAL*8 ZN175(KDLON)
	465	REAL*8 ZN190(KDLON)
	466	REAL*8 ZO175(KDLON)
	467	REAL*8 ZO190(KDLON)
	468	REAL*8 ZSIGN(KDLON)
	469	REAL*8 ZR(KDLON,2)
	470	REAL*8 ZSIGO(KDLON)
	471	REAL*8 ZUD(KDLON,2)
	472	REAL*8 ZRTH, ZRTU, ZWH2O, ZDSCO2, ZDSH2O, ZFPPW
	473	INTEGER jl, jk, jkp1, jkl, jklp1, ja
	474	C
	475	C* Prescribed Data:
	476	c
	477	REAL*8 ZPDH2O,ZPDUMG
	478	SAVE ZPDH2O,ZPDUMG
	479	REAL*8 ZPRH2O,ZPRUMG
	480	SAVE ZPRH2O,ZPRUMG
	481	REAL*8 RTDH2O,RTDUMG
	482	SAVE RTDH2O,RTDUMG
	483	REAL*8 RTH2O ,RTUMG
	484	SAVE RTH2O ,RTUMG
	485	DATA ZPDH2O,ZPDUMG / 0.8 , 0.75 /
	486	DATA ZPRH2O,ZPRUMG / 30000., 30000. /
	487	DATA RTDH2O,RTDUMG / 0.40 , 0.375 /
	488	DATA RTH2O ,RTUMG / 240. , 240. /
	489	C ------------------------------------------------------------------
	490	C
	491	C* 1. COMPUTES AMOUNTS OF ABSORBERS
	492	C -----------------------------
	493	C
	494	100 CONTINUE
	495	C
	496	IIND(1)=1
	497	IIND(2)=2
	498	C
	499	C
	500	C* 1.1 INITIALIZES QUANTITIES
	501	C ----------------------
	502	C
	503	110 CONTINUE
	504	C
	505	DO 111 JL = 1, KDLON
	506	PUD(JL,1,KFLEV+1)=0.
	507	PUD(JL,2,KFLEV+1)=0.
	508	PUD(JL,3,KFLEV+1)=0.
	509	PUD(JL,4,KFLEV+1)=0.
	510	PUD(JL,5,KFLEV+1)=0.
	511	PFACT(JL)= PRMU0(JL) * PFRAC(JL) * PSCT
	512	PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
	513	PSEC(JL)=1./PRMU(JL)
	514	ZC1J(JL,KFLEV+1)=0.
	515	111 CONTINUE
	516	C
	517	C* 1.3 AMOUNTS OF ABSORBERS
	518	C --------------------
	519	C
	520	130 CONTINUE
	521	C
	522	DO 131 JL= 1, KDLON
	523	ZUD(JL,1) = 0.
	524	ZUD(JL,2) = 0.
	525	ZO175(JL) = PPSOL(JL)** (ZPDUMG+1.)
	526	ZO190(JL) = PPSOL(JL)** (ZPDH2O+1.)
	527	ZSIGO(JL) = PPSOL(JL)
	528	ZCLEAR(JL)=1.
	529	ZCLOUD(JL)=0.
	530	131 CONTINUE
	531	C
	532	DO 133 JK = 1 , KFLEV
	533	JKP1 = JK + 1
	534	JKL = KFLEV+1 - JK
	535	JKLP1 = JKL+1
	536	DO 132 JL = 1, KDLON
	537	ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O
	538	ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG
	539	ZWH2O = MAX (PWV(JL,JK) , ZEPSCQ )
	540	ZSIGN(JL) = 100. * PPMB(JL,JKP1)
	541	PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL)
	542	ZN175(JL) = ZSIGN(JL) ** (ZPDUMG+1.)
	543	ZN190(JL) = ZSIGN(JL) ** (ZPDH2O+1.)
	544	ZDSCO2 = ZO175(JL) - ZN175(JL)
	545	ZDSH2O = ZO190(JL) - ZN190(JL)
	546	PUD(JL,1,JK) = 1./( 10.* RG * (ZPDH2O+1.) )/(ZPRH2O**ZPDH2O)
	547	. * ZDSH2O * ZWH2O * ZRTH
	548	PUD(JL,2,JK) = 1./( 10.* RG * (ZPDUMG+1.) )/(ZPRUMG**ZPDUMG)
	549	. * ZDSCO2 * RCO2 * ZRTU
	550	ZFPPW=1.6078ZWH2O/(1.+0.608ZWH2O)
	551	PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW
	552	PUD(JL,5,JK)=PUD(JL,1,JK)*(1.-ZFPPW)
	553	ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK)
	554	ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK)
	555	ZSIGO(JL) = ZSIGN(JL)
	556	ZO175(JL) = ZN175(JL)
	557	ZO190(JL) = ZN190(JL)
	558	C
	559	IF (NOVLP.EQ.1) THEN
	560	ZCLEAR(JL)=ZCLEAR(JL)
	561	S *(1.-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))
	562	S /(1.-MIN(ZCLOUD(JL),1.-ZEPSEC))
	563	ZC1J(JL,JKL)= 1.0 - ZCLEAR(JL)
	564	ZCLOUD(JL) = PCLDSW(JL,JKL)
	565	ELSE IF (NOVLP.EQ.2) THEN
	566	ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL))
	567	ZC1J(JL,JKL) = ZCLOUD(JL)
	568	ELSE IF (NOVLP.EQ.3) THEN
	569	ZCLEAR(JL) = ZCLEAR(JL)*(1.-PCLDSW(JL,JKL))
	570	ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
	571	ZC1J(JL,JKL) = ZCLOUD(JL)
	572	END IF
	573	132 CONTINUE
	574	133 CONTINUE
	575	DO 134 JL=1, KDLON
	576	PCLEAR(JL)=1.-ZC1J(JL,1)
	577	134 CONTINUE
	578	DO 136 JK=1,KFLEV
	579	DO 135 JL=1, KDLON
	580	IF (PCLEAR(JL).LT.1.) THEN
	581	PCLD(JL,JK)=PCLDSW(JL,JK)/(1.-PCLEAR(JL))
	582	ELSE
	583	PCLD(JL,JK)=0.
	584	END IF
	585	135 CONTINUE
	586	136 CONTINUE
	587	C
	588	C
	589	C* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
	590	C -----------------------------------------------
	591	C
	592	140 CONTINUE
	593	C
	594	DO 142 JA = 1,2
	595	DO 141 JL = 1, KDLON
	596	ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL)
	597	141 CONTINUE
	598	142 CONTINUE
	599	C
	600	CALL SWTT1(2, 2, IIND, ZUD, ZR)
	601	C
	602	DO 144 JA = 1,2
	603	DO 143 JL = 1, KDLON
	604	PAKI(JL,JA) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA)
	605	143 CONTINUE
	606	144 CONTINUE
	607	C
	608	C
	609	C ------------------------------------------------------------------
	610	C
	611	RETURN
	612	END
	613	SUBROUTINE SW1S ( KNU
	614	S , PAER , PALBD , PALBP, PCG , PCLD , PCLEAR, PCLDSW
	615	S , PDSIG , POMEGA, POZ , PRMU , PSEC , PTAU , PUD
	616	S , PFD , PFU)
	617	IMPLICIT none
	618	#include "dimensions.h"
	619	#include "dimphy.h"
	620	#include "raddim.h"
	621	C
	622	C ------------------------------------------------------------------
	623	C PURPOSE.
	624	C --------
	625	C
	626	C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
	627	C SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
	628	C
	629	C METHOD.
	630	C -------
	631	C
	632	C 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
	633	C CONTINUUM SCATTERING
	634	C 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
	635	C
	636	C REFERENCE.
	637	C ----------
	638	C
	639	C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	640	C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	641	C
	642	C AUTHOR.
	643	C -------
	644	C JEAN-JACQUES MORCRETTE ECMWF
	645	C
	646	C MODIFICATIONS.
	647	C --------------
	648	C ORIGINAL : 89-07-14
	649	C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
	650	C ------------------------------------------------------------------
	651	C
	652	C* ARGUMENTS:
	653	C
	654	INTEGER KNU
	655	REAL*8 PAER(KDLON,KFLEV,5)
	656	REAL*8 PALBD(KDLON,2)
	657	REAL*8 PALBP(KDLON,2)
	658	REAL*8 PCG(KDLON,2,KFLEV)
	659	REAL*8 PCLD(KDLON,KFLEV)
	660	REAL*8 PCLDSW(KDLON,KFLEV)
	661	REAL*8 PCLEAR(KDLON)
	662	REAL*8 PDSIG(KDLON,KFLEV)
	663	REAL*8 POMEGA(KDLON,2,KFLEV)
	664	REAL*8 POZ(KDLON,KFLEV)
	665	REAL*8 PRMU(KDLON)
	666	REAL*8 PSEC(KDLON)
	667	REAL*8 PTAU(KDLON,2,KFLEV)
	668	REAL*8 PUD(KDLON,5,KFLEV+1)
	669	C
	670	REAL*8 PFD(KDLON,KFLEV+1)
	671	REAL*8 PFU(KDLON,KFLEV+1)
	672	C
	673	C* LOCAL VARIABLES:
	674	C
	675	INTEGER IIND(4)
	676	C
	677	REAL*8 ZCGAZ(KDLON,KFLEV)
	678	REAL*8 ZDIFF(KDLON)
	679	REAL*8 ZDIRF(KDLON)
	680	REAL*8 ZPIZAZ(KDLON,KFLEV)
	681	REAL*8 ZRAYL(KDLON)
	682	REAL*8 ZRAY1(KDLON,KFLEV+1)
	683	REAL*8 ZRAY2(KDLON,KFLEV+1)
	684	REAL*8 ZREFZ(KDLON,2,KFLEV+1)
	685	REAL*8 ZRJ(KDLON,6,KFLEV+1)
	686	REAL*8 ZRJ0(KDLON,6,KFLEV+1)
	687	REAL*8 ZRK(KDLON,6,KFLEV+1)
	688	REAL*8 ZRK0(KDLON,6,KFLEV+1)
	689	REAL*8 ZRMUE(KDLON,KFLEV+1)
	690	REAL*8 ZRMU0(KDLON,KFLEV+1)
	691	REAL*8 ZR(KDLON,4)
	692	REAL*8 ZTAUAZ(KDLON,KFLEV)
	693	REAL*8 ZTRA1(KDLON,KFLEV+1)
	694	REAL*8 ZTRA2(KDLON,KFLEV+1)
	695	REAL*8 ZW(KDLON,4)
	696	C
	697	INTEGER jl, jk, k, jaj, ikm1, ikl
	698	c
	699	c Prescribed Data:
	700	c
	701	REAL*8 RSUN(2)
	702	SAVE RSUN
	703	REAL*8 RRAY(2,6)
	704	SAVE RRAY
	705	DATA RSUN(1) / 0.441676 /
	706	DATA RSUN(2) / 0.558324 /
	707	DATA (RRAY(1,K),K=1,6) /
	708	S .428937E-01, .890743E+00,-.288555E+01,
	709	S .522744E+01,-.469173E+01, .161645E+01/
	710	DATA (RRAY(2,K),K=1,6) /
	711	S .697200E-02, .173297E-01,-.850903E-01,
	712	S .248261E+00,-.302031E+00, .129662E+00/
	713	C ------------------------------------------------------------------
	714	C
	715	C* 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
	716	C ----------------------- ------------------
	717	C
	718	100 CONTINUE
	719	C
	720	C
	721	C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
	722	C -----------------------------------------
	723	C
	724	110 CONTINUE
	725	C
	726	DO 111 JL = 1, KDLON
	727	ZRAYL(JL) = RRAY(KNU,1) + PRMU(JL) * (RRAY(KNU,2) + PRMU(JL)
	728	S * (RRAY(KNU,3) + PRMU(JL) * (RRAY(KNU,4) + PRMU(JL)
	729	S * (RRAY(KNU,5) + PRMU(JL) * RRAY(KNU,6) ))))
	730	111 CONTINUE
	731	C
	732	C
	733	C ------------------------------------------------------------------
	734	C
	735	C* 2. CONTINUUM SCATTERING CALCULATIONS
	736	C ---------------------------------
	737	C
	738	200 CONTINUE
	739	C
	740	C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN
	741	C --------------------------------
	742	C
	743	210 CONTINUE
	744	C
	745	CALL SWCLR ( KNU
	746	S , PAER , PALBP , PDSIG , ZRAYL, PSEC
	747	S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
	748	S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
	749	C
	750	C
	751	C* 2.2 CLOUDY FRACTION OF THE COLUMN
	752	C -----------------------------
	753	C
	754	220 CONTINUE
	755	C
	756	CALL SWR ( KNU
	757	S , PALBD ,PCG ,PCLD ,PDSIG ,POMEGA,ZRAYL
	758	S , PSEC ,PTAU
	759	S , ZCGAZ ,ZPIZAZ,ZRAY1 ,ZRAY2 ,ZREFZ ,ZRJ ,ZRK,ZRMUE
	760	S , ZTAUAZ,ZTRA1 ,ZTRA2)
	761	C
	762	C
	763	C ------------------------------------------------------------------
	764	C
	765	C* 3. OZONE ABSORPTION
	766	C ----------------
	767	C
	768	300 CONTINUE
	769	C
	770	IIND(1)=1
	771	IIND(2)=3
	772	IIND(3)=1
	773	IIND(4)=3
	774	C
	775	C
	776	C* 3.1 DOWNWARD FLUXES
	777	C ---------------
	778	C
	779	310 CONTINUE
	780	C
	781	JAJ = 2
	782	C
	783	DO 311 JL = 1, KDLON
	784	ZW(JL,1)=0.
	785	ZW(JL,2)=0.
	786	ZW(JL,3)=0.
	787	ZW(JL,4)=0.
	788	PFD(JL,KFLEV+1)=((1.-PCLEAR(JL))*ZRJ(JL,JAJ,KFLEV+1)
	789	S + PCLEAR(JL) ZRJ0(JL,JAJ,KFLEV+1)) RSUN(KNU)
	790	311 CONTINUE
	791	DO 314 JK = 1 , KFLEV
	792	IKL = KFLEV+1-JK
	793	DO 312 JL = 1, KDLON
	794	ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKL)/ZRMUE(JL,IKL)
	795	ZW(JL,2)=ZW(JL,2)+POZ(JL, IKL)/ZRMUE(JL,IKL)
	796	ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
	797	ZW(JL,4)=ZW(JL,4)+POZ(JL, IKL)/ZRMU0(JL,IKL)
	798	312 CONTINUE
	799	C
	800	CALL SWTT1(KNU, 4, IIND, ZW, ZR)
	801	C
	802	DO 313 JL = 1, KDLON
	803	ZDIFF(JL) = ZR(JL,1)ZR(JL,2)ZRJ(JL,JAJ,IKL)
	804	ZDIRF(JL) = ZR(JL,3)ZR(JL,4)ZRJ0(JL,JAJ,IKL)
	805	PFD(JL,IKL) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
	806	S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU)
	807	313 CONTINUE
	808	314 CONTINUE
	809	C
	810	C
	811	C* 3.2 UPWARD FLUXES
	812	C -------------
	813	C
	814	320 CONTINUE
	815	C
	816	DO 325 JL = 1, KDLON
	817	PFU(JL,1) = ((1.-PCLEAR(JL))ZDIFF(JL)PALBD(JL,KNU)
	818	S + PCLEAR(JL) ZDIRF(JL)PALBP(JL,KNU))
	819	S * RSUN(KNU)
	820	325 CONTINUE
	821	C
	822	DO 328 JK = 2 , KFLEV+1
	823	IKM1=JK-1
	824	DO 326 JL = 1, KDLON
	825	ZW(JL,1)=ZW(JL,1)+PUD(JL,1,IKM1)*1.66
	826	ZW(JL,2)=ZW(JL,2)+POZ(JL, IKM1)*1.66
	827	ZW(JL,3)=ZW(JL,3)+PUD(JL,1,IKM1)*1.66
	828	ZW(JL,4)=ZW(JL,4)+POZ(JL, IKM1)*1.66
	829	326 CONTINUE
	830	C
	831	CALL SWTT1(KNU, 4, IIND, ZW, ZR)
	832	C
	833	DO 327 JL = 1, KDLON
	834	ZDIFF(JL) = ZR(JL,1)ZR(JL,2)ZRK(JL,JAJ,JK)
	835	ZDIRF(JL) = ZR(JL,3)ZR(JL,4)ZRK0(JL,JAJ,JK)
	836	PFU(JL,JK) = ((1.-PCLEAR(JL)) * ZDIFF(JL)
	837	S +PCLEAR(JL) * ZDIRF(JL)) * RSUN(KNU)
	838	327 CONTINUE
	839	328 CONTINUE
	840	C
	841	C ------------------------------------------------------------------
	842	C
	843	RETURN
	844	END
	845	SUBROUTINE SW2S ( KNU
	846	S , PAER ,PAKI, PALBD, PALBP, PCG , PCLD, PCLEAR, PCLDSW
	847	S , PDSIG ,POMEGA,POZ , PRMU , PSEC , PTAU
	848	S , PUD ,PWV , PQS
	849	S , PFDOWN,PFUP )
	850	IMPLICIT none
	851	#include "dimensions.h"
	852	#include "dimphy.h"
	853	#include "raddim.h"
	854	#include "radepsi.h"
	855	C
	856	C ------------------------------------------------------------------
	857	C PURPOSE.
	858	C --------
	859	C
	860	C THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE
	861	C SECOND SPECTRAL INTERVAL FOLLOWING FOUQUART AND BONNEL (1980).
	862	C
	863	C METHOD.
	864	C -------
	865	C
	866	C 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO
	867	C CONTINUUM SCATTERING
	868	C 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR
	869	C A GREY MOLECULAR ABSORPTION
	870	C 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS
	871	C OF ABSORBERS
	872	C 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS
	873	C 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION
	874	C
	875	C REFERENCE.
	876	C ----------
	877	C
	878	C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	879	C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	880	C
	881	C AUTHOR.
	882	C -------
	883	C JEAN-JACQUES MORCRETTE ECMWF
	884	C
	885	C MODIFICATIONS.
	886	C --------------
	887	C ORIGINAL : 89-07-14
	888	C 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
	889	C ------------------------------------------------------------------
	890	C* ARGUMENTS:
	891	C
	892	INTEGER KNU
	893	REAL*8 PAER(KDLON,KFLEV,5)
	894	REAL*8 PAKI(KDLON,2)
	895	REAL*8 PALBD(KDLON,2)
	896	REAL*8 PALBP(KDLON,2)
	897	REAL*8 PCG(KDLON,2,KFLEV)
	898	REAL*8 PCLD(KDLON,KFLEV)
	899	REAL*8 PCLDSW(KDLON,KFLEV)
	900	REAL*8 PCLEAR(KDLON)
	901	REAL*8 PDSIG(KDLON,KFLEV)
	902	REAL*8 POMEGA(KDLON,2,KFLEV)
	903	REAL*8 POZ(KDLON,KFLEV)
	904	REAL*8 PQS(KDLON,KFLEV)
	905	REAL*8 PRMU(KDLON)
	906	REAL*8 PSEC(KDLON)
	907	REAL*8 PTAU(KDLON,2,KFLEV)
	908	REAL*8 PUD(KDLON,5,KFLEV+1)
	909	REAL*8 PWV(KDLON,KFLEV)
	910	C
	911	REAL*8 PFDOWN(KDLON,KFLEV+1)
	912	REAL*8 PFUP(KDLON,KFLEV+1)
	913	C
	914	C* LOCAL VARIABLES:
	915	C
	916	INTEGER IIND2(2), IIND3(3)
	917	REAL*8 ZCGAZ(KDLON,KFLEV)
	918	REAL*8 ZFD(KDLON,KFLEV+1)
	919	REAL*8 ZFU(KDLON,KFLEV+1)
	920	REAL*8 ZG(KDLON)
	921	REAL*8 ZGG(KDLON)
	922	REAL*8 ZPIZAZ(KDLON,KFLEV)
	923	REAL*8 ZRAYL(KDLON)
	924	REAL*8 ZRAY1(KDLON,KFLEV+1)
	925	REAL*8 ZRAY2(KDLON,KFLEV+1)
	926	REAL*8 ZREF(KDLON)
	927	REAL*8 ZREFZ(KDLON,2,KFLEV+1)
	928	REAL*8 ZRE1(KDLON)
	929	REAL*8 ZRE2(KDLON)
	930	REAL*8 ZRJ(KDLON,6,KFLEV+1)
	931	REAL*8 ZRJ0(KDLON,6,KFLEV+1)
	932	REAL*8 ZRK(KDLON,6,KFLEV+1)
	933	REAL*8 ZRK0(KDLON,6,KFLEV+1)
	934	REAL*8 ZRL(KDLON,8)
	935	REAL*8 ZRMUE(KDLON,KFLEV+1)
	936	REAL*8 ZRMU0(KDLON,KFLEV+1)
	937	REAL*8 ZRMUZ(KDLON)
	938	REAL*8 ZRNEB(KDLON)
	939	REAL*8 ZRUEF(KDLON,8)
	940	REAL*8 ZR1(KDLON)
	941	REAL*8 ZR2(KDLON,2)
	942	REAL*8 ZR3(KDLON,3)
	943	REAL*8 ZR4(KDLON)
	944	REAL*8 ZR21(KDLON)
	945	REAL*8 ZR22(KDLON)
	946	REAL*8 ZS(KDLON)
	947	REAL*8 ZTAUAZ(KDLON,KFLEV)
	948	REAL*8 ZTO1(KDLON)
	949	REAL*8 ZTR(KDLON,2,KFLEV+1)
	950	REAL*8 ZTRA1(KDLON,KFLEV+1)
	951	REAL*8 ZTRA2(KDLON,KFLEV+1)
	952	REAL*8 ZTR1(KDLON)
	953	REAL*8 ZTR2(KDLON)
	954	REAL*8 ZW(KDLON)
	955	REAL*8 ZW1(KDLON)
	956	REAL*8 ZW2(KDLON,2)
	957	REAL*8 ZW3(KDLON,3)
	958	REAL*8 ZW4(KDLON)
	959	REAL*8 ZW5(KDLON)
	960	C
	961	INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1
	962	INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs
	963	REAL*8 ZRMUM1, ZWH2O, ZCNEB, ZAA, ZBB, ZRKI, ZRE11
	964	C
	965	C* Prescribed Data:
	966	C
	967	REAL*8 RSUN(2)
	968	SAVE RSUN
	969	REAL*8 RRAY(2,6)
	970	SAVE RRAY
	971	DATA RSUN(1) / 0.441676 /
	972	DATA RSUN(2) / 0.558324 /
	973	DATA (RRAY(1,K),K=1,6) /
	974	S .428937E-01, .890743E+00,-.288555E+01,
	975	S .522744E+01,-.469173E+01, .161645E+01/
	976	DATA (RRAY(2,K),K=1,6) /
	977	S .697200E-02, .173297E-01,-.850903E-01,
	978	S .248261E+00,-.302031E+00, .129662E+00/
	979	C
	980	C ------------------------------------------------------------------
	981	C
	982	C* 1. SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON)
	983	C -------------------------------------------
	984	C
	985	100 CONTINUE
	986	C
	987	C
	988	C* 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
	989	C -----------------------------------------
	990	C
	991	110 CONTINUE
	992	C
	993	DO 111 JL = 1, KDLON
	994	ZRMUM1 = 1. - PRMU(JL)
	995	ZRAYL(JL) = RRAY(KNU,1) + ZRMUM1 * (RRAY(KNU,2) + ZRMUM1
	996	S * (RRAY(KNU,3) + ZRMUM1 * (RRAY(KNU,4) + ZRMUM1
	997	S * (RRAY(KNU,5) + ZRMUM1 * RRAY(KNU,6) ))))
	998	111 CONTINUE
	999	C
	1000	C
	1001	C ------------------------------------------------------------------
	1002	C
	1003	C* 2. CONTINUUM SCATTERING CALCULATIONS
	1004	C ---------------------------------
	1005	C
	1006	200 CONTINUE
	1007	C
	1008	C* 2.1 CLEAR-SKY FRACTION OF THE COLUMN
	1009	C --------------------------------
	1010	C
	1011	210 CONTINUE
	1012	C
	1013	CALL SWCLR ( KNU
	1014	S , PAER , PALBP , PDSIG , ZRAYL, PSEC
	1015	S , ZCGAZ , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
	1016	S , ZRK0 , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
	1017	C
	1018	C
	1019	C* 2.2 CLOUDY FRACTION OF THE COLUMN
	1020	C -----------------------------
	1021	C
	1022	220 CONTINUE
	1023	C
	1024	CALL SWR ( KNU
	1025	S , PALBD , PCG , PCLD , PDSIG, POMEGA, ZRAYL
	1026	S , PSEC , PTAU
	1027	S , ZCGAZ , ZPIZAZ, ZRAY1, ZRAY2, ZREFZ , ZRJ , ZRK, ZRMUE
	1028	S , ZTAUAZ, ZTRA1 , ZTRA2)
	1029	C
	1030	C
	1031	C ------------------------------------------------------------------
	1032	C
	1033	C* 3. SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION
	1034	C ------------------------------------------------------
	1035	C
	1036	300 CONTINUE
	1037	C
	1038	JN = 2
	1039	C
	1040	DO 361 JABS=1,2
	1041	C
	1042	C
	1043	C* 3.1 SURFACE CONDITIONS
	1044	C ------------------
	1045	C
	1046	310 CONTINUE
	1047	C
	1048	DO 311 JL = 1, KDLON
	1049	ZREFZ(JL,2,1) = PALBD(JL,KNU)
	1050	ZREFZ(JL,1,1) = PALBD(JL,KNU)
	1051	311 CONTINUE
	1052	C
	1053	C
	1054	C* 3.2 INTRODUCING CLOUD EFFECTS
	1055	C -------------------------
	1056	C
	1057	320 CONTINUE
	1058	C
	1059	DO 324 JK = 2 , KFLEV+1
	1060	JKM1 = JK - 1
	1061	IKL=KFLEV+1-JKM1
	1062	DO 322 JL = 1, KDLON
	1063	ZRNEB(JL) = PCLD(JL,JKM1)
	1064	IF (JABS.EQ.1 .AND. ZRNEB(JL).GT.2.*ZEELOG) THEN
	1065	ZWH2O=MAX(PWV(JL,JKM1),ZEELOG)
	1066	ZCNEB=MAX(ZEELOG,MIN(ZRNEB(JL),1.-ZEELOG))
	1067	ZBB=PUD(JL,JABS,JKM1)*PQS(JL,JKM1)/ZWH2O
	1068	ZAA=MAX((PUD(JL,JABS,JKM1)-ZCNEB*ZBB)/(1.-ZCNEB),ZEELOG)
	1069	ELSE
	1070	ZAA=PUD(JL,JABS,JKM1)
	1071	ZBB=ZAA
	1072	END IF
	1073	ZRKI = PAKI(JL,JABS)
	1074	ZS(JL) = EXP(-ZRKI * ZAA * 1.66)
	1075	ZG(JL) = EXP(-ZRKI * ZAA / ZRMUE(JL,JK))
	1076	ZTR1(JL) = 0.
	1077	ZRE1(JL) = 0.
	1078	ZTR2(JL) = 0.
	1079	ZRE2(JL) = 0.
	1080	C
	1081	ZW(JL)= POMEGA(JL,KNU,JKM1)
	1082	ZTO1(JL) = PTAU(JL,KNU,JKM1) / ZW(JL)
	1083	S + ZTAUAZ(JL,JKM1) / ZPIZAZ(JL,JKM1)
	1084	S + ZBB * ZRKI
	1085
	1086	ZR21(JL) = PTAU(JL,KNU,JKM1) + ZTAUAZ(JL,JKM1)
	1087	ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
	1088	ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)
	1089	S + (1. - ZR22(JL)) * ZCGAZ(JL,JKM1)
	1090	ZW(JL) = ZR21(JL) / ZTO1(JL)
	1091	ZREF(JL) = ZREFZ(JL,1,JKM1)
	1092	ZRMUZ(JL) = ZRMUE(JL,JK)
	1093	322 CONTINUE
	1094	C
	1095	CALL SWDE(ZGG, ZREF, ZRMUZ, ZTO1, ZW,
	1096	S ZRE1, ZRE2, ZTR1, ZTR2)
	1097	C
	1098	DO 323 JL = 1, KDLON
	1099	C
	1100	ZREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (ZRAY1(JL,JKM1)
	1101	S + ZREFZ(JL,2,JKM1) * ZTRA1(JL,JKM1)
	1102	S * ZTRA2(JL,JKM1) ) * ZG(JL) * ZS(JL)
	1103	S + ZRNEB(JL) * ZRE1(JL)
	1104	C
	1105	ZTR(JL,2,JKM1)=ZRNEB(JL)*ZTR1(JL)
	1106	S + (ZTRA1(JL,JKM1)) * ZG(JL) * (1.-ZRNEB(JL))
	1107	C
	1108	ZREFZ(JL,1,JK)=(1.-ZRNEB(JL))*(ZRAY1(JL,JKM1)
	1109	S +ZREFZ(JL,1,JKM1)ZTRA1(JL,JKM1)ZTRA2(JL,JKM1)
	1110	S /(1.-ZRAY2(JL,JKM1)ZREFZ(JL,1,JKM1)))ZG(JL)*ZS(JL)
	1111	S + ZRNEB(JL) * ZRE2(JL)
	1112	C
	1113	ZTR(JL,1,JKM1)= ZRNEB(JL) * ZTR2(JL)
	1114	S + (ZTRA1(JL,JKM1)/(1.-ZRAY2(JL,JKM1)
	1115	S * ZREFZ(JL,1,JKM1)))
	1116	S * ZG(JL) * (1. -ZRNEB(JL))
	1117	C
	1118	323 CONTINUE
	1119	324 CONTINUE
	1120	C
	1121	C* 3.3 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
	1122	C -------------------------------------------------
	1123	C
	1124	330 CONTINUE
	1125	C
	1126	DO 351 JREF=1,2
	1127	C
	1128	JN = JN + 1
	1129	C
	1130	DO 331 JL = 1, KDLON
	1131	ZRJ(JL,JN,KFLEV+1) = 1.
	1132	ZRK(JL,JN,KFLEV+1) = ZREFZ(JL,JREF,KFLEV+1)
	1133	331 CONTINUE
	1134	C
	1135	DO 333 JK = 1 , KFLEV
	1136	JKL = KFLEV+1 - JK
	1137	JKLP1 = JKL + 1
	1138	DO 332 JL = 1, KDLON
	1139	ZRE11 = ZRJ(JL,JN,JKLP1) * ZTR(JL,JREF,JKL)
	1140	ZRJ(JL,JN,JKL) = ZRE11
	1141	ZRK(JL,JN,JKL) = ZRE11 * ZREFZ(JL,JREF,JKL)
	1142	332 CONTINUE
	1143	333 CONTINUE
	1144	351 CONTINUE
	1145	361 CONTINUE
	1146	C
	1147	C
	1148	C ------------------------------------------------------------------
	1149	C
	1150	C* 4. INVERT GREY AND CONTINUUM FLUXES
	1151	C --------------------------------
	1152	C
	1153	400 CONTINUE
	1154	C
	1155	C
	1156	C* 4.1 UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES
	1157	C ---------------------------------------------
	1158	C
	1159	410 CONTINUE
	1160	C
	1161	DO 414 JK = 1 , KFLEV+1
	1162	DO 413 JAJ = 1 , 5 , 2
	1163	JAJP = JAJ + 1
	1164	DO 412 JL = 1, KDLON
	1165	ZRJ(JL,JAJ,JK)= ZRJ(JL,JAJ,JK) - ZRJ(JL,JAJP,JK)
	1166	ZRK(JL,JAJ,JK)= ZRK(JL,JAJ,JK) - ZRK(JL,JAJP,JK)
	1167	ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG )
	1168	ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG )
	1169	412 CONTINUE
	1170	413 CONTINUE
	1171	414 CONTINUE
	1172	C
	1173	DO 417 JK = 1 , KFLEV+1
	1174	DO 416 JAJ = 2 , 6 , 2
	1175	DO 415 JL = 1, KDLON
	1176	ZRJ(JL,JAJ,JK)= MAX( ZRJ(JL,JAJ,JK) , ZEELOG )
	1177	ZRK(JL,JAJ,JK)= MAX( ZRK(JL,JAJ,JK) , ZEELOG )
	1178	415 CONTINUE
	1179	416 CONTINUE
	1180	417 CONTINUE
	1181	C
	1182	C* 4.2 EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE
	1183	C ---------------------------------------------
	1184	C
	1185	420 CONTINUE
	1186	C
	1187	DO 437 JK = 1 , KFLEV+1
	1188	JKKI = 1
	1189	DO 425 JAJ = 1 , 2
	1190	IIND2(1)=JAJ
	1191	IIND2(2)=JAJ
	1192	DO 424 JN = 1 , 2
	1193	JN2J = JN + 2 * JAJ
	1194	JKKP4 = JKKI + 4
	1195	C
	1196	C* 4.2.1 EFFECTIVE ABSORBER AMOUNTS
	1197	C --------------------------
	1198	C
	1199	4210 CONTINUE
	1200	C
	1201	DO 4211 JL = 1, KDLON
	1202	ZW2(JL,1) = LOG( ZRJ(JL,JN,JK) / ZRJ(JL,JN2J,JK))
	1203	S / PAKI(JL,JAJ)
	1204	ZW2(JL,2) = LOG( ZRK(JL,JN,JK) / ZRK(JL,JN2J,JK))
	1205	S / PAKI(JL,JAJ)
	1206	4211 CONTINUE
	1207	C
	1208	C* 4.2.2 TRANSMISSION FUNCTION
	1209	C ---------------------
	1210	C
	1211	4220 CONTINUE
	1212	C
	1213	CALL SWTT1(KNU, 2, IIND2, ZW2, ZR2)
	1214	C
	1215	DO 4221 JL = 1, KDLON
	1216	ZRL(JL,JKKI) = ZR2(JL,1)
	1217	ZRUEF(JL,JKKI) = ZW2(JL,1)
	1218	ZRL(JL,JKKP4) = ZR2(JL,2)
	1219	ZRUEF(JL,JKKP4) = ZW2(JL,2)
	1220	4221 CONTINUE
	1221	C
	1222	JKKI=JKKI+1
	1223	424 CONTINUE
	1224	425 CONTINUE
	1225	C
	1226	C* 4.3 UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION
	1227	C ------------------------------------------------------
	1228	C
	1229	430 CONTINUE
	1230	C
	1231	DO 431 JL = 1, KDLON
	1232	PFDOWN(JL,JK) = ZRJ(JL,1,JK) * ZRL(JL,1) * ZRL(JL,3)
	1233	S + ZRJ(JL,2,JK) * ZRL(JL,2) * ZRL(JL,4)
	1234	PFUP(JL,JK) = ZRK(JL,1,JK) * ZRL(JL,5) * ZRL(JL,7)
	1235	S + ZRK(JL,2,JK) * ZRL(JL,6) * ZRL(JL,8)
	1236	431 CONTINUE
	1237	437 CONTINUE
	1238	C
	1239	C
	1240	C ------------------------------------------------------------------
	1241	C
	1242	C* 5. MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES
	1243	C ----------------------------------------
	1244	C
	1245	500 CONTINUE
	1246	C
	1247	C
	1248	C* 5.1 DOWNWARD FLUXES
	1249	C ---------------
	1250	C
	1251	510 CONTINUE
	1252	C
	1253	JAJ = 2
	1254	IIND3(1)=1
	1255	IIND3(2)=2
	1256	IIND3(3)=3
	1257	C
	1258	DO 511 JL = 1, KDLON
	1259	ZW3(JL,1)=0.
	1260	ZW3(JL,2)=0.
	1261	ZW3(JL,3)=0.
	1262	ZW4(JL) =0.
	1263	ZW5(JL) =0.
	1264	ZR4(JL) =1.
	1265	ZFD(JL,KFLEV+1)= ZRJ0(JL,JAJ,KFLEV+1)
	1266	511 CONTINUE
	1267	DO 514 JK = 1 , KFLEV
	1268	IKL = KFLEV+1-JK
	1269	DO 512 JL = 1, KDLON
	1270	ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKL)/ZRMU0(JL,IKL)
	1271	ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKL)/ZRMU0(JL,IKL)
	1272	ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKL)/ZRMU0(JL,IKL)
	1273	ZW4(JL) =ZW4(JL) +PUD(JL,4,IKL)/ZRMU0(JL,IKL)
	1274	ZW5(JL) =ZW5(JL) +PUD(JL,5,IKL)/ZRMU0(JL,IKL)
	1275	512 CONTINUE
	1276	C
	1277	CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3)
	1278	C
	1279	DO 513 JL = 1, KDLON
	1280	C ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
	1281	ZFD(JL,IKL) = ZR3(JL,1)ZR3(JL,2)ZR3(JL,3)*ZR4(JL)
	1282	S * ZRJ0(JL,JAJ,IKL)
	1283	513 CONTINUE
	1284	514 CONTINUE
	1285	C
	1286	C
	1287	C* 5.2 UPWARD FLUXES
	1288	C -------------
	1289	C
	1290	520 CONTINUE
	1291	C
	1292	DO 525 JL = 1, KDLON
	1293	ZFU(JL,1) = ZFD(JL,1)*PALBP(JL,KNU)
	1294	525 CONTINUE
	1295	C
	1296	DO 528 JK = 2 , KFLEV+1
	1297	IKM1=JK-1
	1298	DO 526 JL = 1, KDLON
	1299	ZW3(JL,1)=ZW3(JL,1)+PUD(JL,1,IKM1)*1.66
	1300	ZW3(JL,2)=ZW3(JL,2)+PUD(JL,2,IKM1)*1.66
	1301	ZW3(JL,3)=ZW3(JL,3)+POZ(JL, IKM1)*1.66
	1302	ZW4(JL) =ZW4(JL) +PUD(JL,4,IKM1)*1.66
	1303	ZW5(JL) =ZW5(JL) +PUD(JL,5,IKM1)*1.66
	1304	526 CONTINUE
	1305	C
	1306	CALL SWTT1(KNU, 3, IIND3, ZW3, ZR3)
	1307	C
	1308	DO 527 JL = 1, KDLON
	1309	C ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
	1310	ZFU(JL,JK) = ZR3(JL,1)ZR3(JL,2)ZR3(JL,3)*ZR4(JL)
	1311	S * ZRK0(JL,JAJ,JK)
	1312	527 CONTINUE
	1313	528 CONTINUE
	1314	C
	1315	C
	1316	C ------------------------------------------------------------------
	1317	C
	1318	C* 6. INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION
	1319	C --------------------------------------------------
	1320	C
	1321	600 CONTINUE
	1322	IABS=3
	1323	C
	1324	C* 6.1 DOWNWARD FLUXES
	1325	C ---------------
	1326	C
	1327	610 CONTINUE
	1328	DO 611 JL = 1, KDLON
	1329	ZW1(JL)=0.
	1330	ZW4(JL)=0.
	1331	ZW5(JL)=0.
	1332	ZR1(JL)=0.
	1333	PFDOWN(JL,KFLEV+1) = ((1.-PCLEAR(JL))*PFDOWN(JL,KFLEV+1)
	1334	S + PCLEAR(JL) * ZFD(JL,KFLEV+1)) * RSUN(KNU)
	1335	611 CONTINUE
	1336	C
	1337	DO 614 JK = 1 , KFLEV
	1338	IKL=KFLEV+1-JK
	1339	DO 612 JL = 1, KDLON
	1340	ZW1(JL) = ZW1(JL)+POZ(JL, IKL)/ZRMUE(JL,IKL)
	1341	ZW4(JL) = ZW4(JL)+PUD(JL,4,IKL)/ZRMUE(JL,IKL)
	1342	ZW5(JL) = ZW5(JL)+PUD(JL,5,IKL)/ZRMUE(JL,IKL)
	1343	C ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
	1344	612 CONTINUE
	1345	C
	1346	CALL SWTT(KNU, IABS, ZW1, ZR1)
	1347	C
	1348	DO 613 JL = 1, KDLON
	1349	PFDOWN(JL,IKL) = ((1.-PCLEAR(JL))ZR1(JL)ZR4(JL)*PFDOWN(JL,IKL)
	1350	S +PCLEAR(JL)ZFD(JL,IKL)) RSUN(KNU)
	1351	613 CONTINUE
	1352	614 CONTINUE
	1353	C
	1354	C
	1355	C* 6.2 UPWARD FLUXES
	1356	C -------------
	1357	C
	1358	620 CONTINUE
	1359	DO 621 JL = 1, KDLON
	1360	PFUP(JL,1) = ((1.-PCLEAR(JL))ZR1(JL)ZR4(JL) * PFUP(JL,1)
	1361	S +PCLEAR(JL)ZFU(JL,1)) RSUN(KNU)
	1362	621 CONTINUE
	1363	C
	1364	DO 624 JK = 2 , KFLEV+1
	1365	IKM1=JK-1
	1366	DO 622 JL = 1, KDLON
	1367	ZW1(JL) = ZW1(JL)+POZ(JL ,IKM1)*1.66
	1368	ZW4(JL) = ZW4(JL)+PUD(JL,4,IKM1)*1.66
	1369	ZW5(JL) = ZW5(JL)+PUD(JL,5,IKM1)*1.66
	1370	C ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
	1371	622 CONTINUE
	1372	C
	1373	CALL SWTT(KNU, IABS, ZW1, ZR1)
	1374	C
	1375	DO 623 JL = 1, KDLON
	1376	PFUP(JL,JK) = ((1.-PCLEAR(JL))ZR1(JL)ZR4(JL) * PFUP(JL,JK)
	1377	S +PCLEAR(JL)ZFU(JL,JK)) RSUN(KNU)
	1378	623 CONTINUE
	1379	624 CONTINUE
	1380	C
	1381	C ------------------------------------------------------------------
	1382	C
	1383	RETURN
	1384	END
	1385	SUBROUTINE SWCLR ( KNU
	1386	S , PAER , PALBP , PDSIG , PRAYL , PSEC
	1387	S , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ
	1388	S , PRK , PRMU0 , PTAUAZ, PTRA1 , PTRA2 )
	1389	IMPLICIT none
	1390	#include "dimensions.h"
	1391	#include "dimphy.h"
	1392	#include "raddim.h"
	1393	#include "radepsi.h"
	1394	#include "radopt.h"
	1395	C
	1396	C ------------------------------------------------------------------
	1397	C PURPOSE.
	1398	C --------
	1399	C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
	1400	C CLEAR-SKY COLUMN
	1401	C
	1402	C REFERENCE.
	1403	C ----------
	1404	C
	1405	C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	1406	C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	1407	C
	1408	C AUTHOR.
	1409	C -------
	1410	C JEAN-JACQUES MORCRETTE ECMWF
	1411	C
	1412	C MODIFICATIONS.
	1413	C --------------
	1414	C ORIGINAL : 94-11-15
	1415	C ------------------------------------------------------------------
	1416	C* ARGUMENTS:
	1417	C
	1418	INTEGER KNU
	1419	REAL*8 PAER(KDLON,KFLEV,5)
	1420	REAL*8 PALBP(KDLON,2)
	1421	REAL*8 PDSIG(KDLON,KFLEV)
	1422	REAL*8 PRAYL(KDLON)
	1423	REAL*8 PSEC(KDLON)
	1424	C
	1425	REAL*8 PCGAZ(KDLON,KFLEV)
	1426	REAL*8 PPIZAZ(KDLON,KFLEV)
	1427	REAL*8 PRAY1(KDLON,KFLEV+1)
	1428	REAL*8 PRAY2(KDLON,KFLEV+1)
	1429	REAL*8 PREFZ(KDLON,2,KFLEV+1)
	1430	REAL*8 PRJ(KDLON,6,KFLEV+1)
	1431	REAL*8 PRK(KDLON,6,KFLEV+1)
	1432	REAL*8 PRMU0(KDLON,KFLEV+1)
	1433	REAL*8 PTAUAZ(KDLON,KFLEV)
	1434	REAL*8 PTRA1(KDLON,KFLEV+1)
	1435	REAL*8 PTRA2(KDLON,KFLEV+1)
	1436	C
	1437	C* LOCAL VARIABLES:
	1438	C
	1439	REAL*8 ZC0I(KDLON,KFLEV+1)
	1440	REAL*8 ZCLE0(KDLON,KFLEV)
	1441	REAL*8 ZCLEAR(KDLON)
	1442	REAL*8 ZR21(KDLON)
	1443	REAL*8 ZR23(KDLON)
	1444	REAL*8 ZSS0(KDLON)
	1445	REAL*8 ZSCAT(KDLON)
	1446	REAL*8 ZTR(KDLON,2,KFLEV+1)
	1447	C
	1448	INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in
	1449	REAL*8 ZTRAY, ZGAR, ZRATIO, ZFF, ZFACOA, ZCORAE
	1450	REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZMU1, ZDEN1
	1451	REAL*8 ZBMU0, ZBMU1, ZRE11
	1452	C
	1453	C* Prescribed Data for Aerosols:
	1454	C
	1455	REAL*8 TAUA(2,5), RPIZA(2,5), RCGA(2,5)
	1456	SAVE TAUA, RPIZA, RCGA
	1457	DATA ((TAUA(IN,JA),JA=1,5),IN=1,2) /
	1458	S .730719, .912819, .725059, .745405, .682188 ,
	1459	S .730719, .912819, .725059, .745405, .682188 /
	1460	DATA ((RPIZA(IN,JA),JA=1,5),IN=1,2) /
	1461	S .872212, .982545, .623143, .944887, .997975 ,
	1462	S .872212, .982545, .623143, .944887, .997975 /
	1463	DATA ((RCGA (IN,JA),JA=1,5),IN=1,2) /
	1464	S .647596, .739002, .580845, .662657, .624246 ,
	1465	S .647596, .739002, .580845, .662657, .624246 /
	1466	C ------------------------------------------------------------------
	1467	C
	1468	C* 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
	1469	C --------------------------------------------
	1470	C
	1471	100 CONTINUE
	1472	C
	1473	DO 103 JK = 1 , KFLEV+1
	1474	DO 102 JA = 1 , 6
	1475	DO 101 JL = 1, KDLON
	1476	PRJ(JL,JA,JK) = 0.
	1477	PRK(JL,JA,JK) = 0.
	1478	101 CONTINUE
	1479	102 CONTINUE
	1480	103 CONTINUE
	1481	C
	1482	DO 108 JK = 1 , KFLEV
	1483	DO 104 JL = 1, KDLON
	1484	PCGAZ(JL,JK) = 0.
	1485	PPIZAZ(JL,JK) = 0.
	1486	PTAUAZ(JL,JK) = 0.
	1487	104 CONTINUE
	1488	DO 106 JAE=1,5
	1489	DO 105 JL = 1, KDLON
	1490	PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
	1491	S +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
	1492	PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
	1493	S * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
	1494	PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JK,JAE)
	1495	S * TAUA(KNU,JAE)RPIZA(KNU,JAE)RCGA(KNU,JAE)
	1496	105 CONTINUE
	1497	106 CONTINUE
	1498	C
	1499	DO 107 JL = 1, KDLON
	1500	IF (KAER.NE.0) THEN
	1501	PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
	1502	PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
	1503	ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
	1504	ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
	1505	ZGAR = PCGAZ(JL,JK)
	1506	ZFF = ZGAR * ZGAR
	1507	PTAUAZ(JL,JK)=ZTRAY+PTAUAZ(JL,JK)(1.-PPIZAZ(JL,JK)ZFF)
	1508	PCGAZ(JL,JK) = ZGAR * (1. - ZRATIO) / (1. + ZGAR)
	1509	PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)PPIZAZ(JL,JK)(1.-ZFF)
	1510	S / (1. - PPIZAZ(JL,JK) * ZFF)
	1511	ELSE
	1512	ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
	1513	PTAUAZ(JL,JK) = ZTRAY
	1514	PCGAZ(JL,JK) = 0.
	1515	PPIZAZ(JL,JK) = 1.-REPSCT
	1516	END IF
	1517	107 CONTINUE
	1518	c PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)
	1519	c $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)
	1520	c 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)
	1521	C
	1522	108 CONTINUE
	1523	C
	1524	C ------------------------------------------------------------------
	1525	C
	1526	C* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
	1527	C ----------------------------------------------
	1528	C
	1529	200 CONTINUE
	1530	C
	1531	DO 201 JL = 1, KDLON
	1532	ZR23(JL) = 0.
	1533	ZC0I(JL,KFLEV+1) = 0.
	1534	ZCLEAR(JL) = 1.
	1535	ZSCAT(JL) = 0.
	1536	201 CONTINUE
	1537	C
	1538	JK = 1
	1539	JKL = KFLEV+1 - JK
	1540	JKLP1 = JKL + 1
	1541	DO 202 JL = 1, KDLON
	1542	ZFACOA = 1. - PPIZAZ(JL,JKL)PCGAZ(JL,JKL)PCGAZ(JL,JKL)
	1543	ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
	1544	ZR21(JL) = EXP(-ZCORAE )
	1545	ZSS0(JL) = 1.-ZR21(JL)
	1546	ZCLE0(JL,JKL) = ZSS0(JL)
	1547	C
	1548	IF (NOVLP.EQ.1) THEN
	1549	c* maximum-random
	1550	ZCLEAR(JL) = ZCLEAR(JL)
	1551	S *(1.0-MAX(ZSS0(JL),ZSCAT(JL)))
	1552	S /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC))
	1553	ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL)
	1554	ZSCAT(JL) = ZSS0(JL)
	1555	ELSE IF (NOVLP.EQ.2) THEN
	1556	C* maximum
	1557	ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
	1558	ZC0I(JL,JKL) = ZSCAT(JL)
	1559	ELSE IF (NOVLP.EQ.3) THEN
	1560	c* random
	1561	ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL))
	1562	ZSCAT(JL) = 1.0 - ZCLEAR(JL)
	1563	ZC0I(JL,JKL) = ZSCAT(JL)
	1564	END IF
	1565	202 CONTINUE
	1566	C
	1567	DO 205 JK = 2 , KFLEV
	1568	JKL = KFLEV+1 - JK
	1569	JKLP1 = JKL + 1
	1570	DO 204 JL = 1, KDLON
	1571	ZFACOA = 1. - PPIZAZ(JL,JKL)PCGAZ(JL,JKL)PCGAZ(JL,JKL)
	1572	ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
	1573	ZR21(JL) = EXP(-ZCORAE )
	1574	ZSS0(JL) = 1.-ZR21(JL)
	1575	ZCLE0(JL,JKL) = ZSS0(JL)
	1576	c
	1577	IF (NOVLP.EQ.1) THEN
	1578	c* maximum-random
	1579	ZCLEAR(JL) = ZCLEAR(JL)
	1580	S *(1.0-MAX(ZSS0(JL),ZSCAT(JL)))
	1581	S /(1.0-MIN(ZSCAT(JL),1.-ZEPSEC))
	1582	ZC0I(JL,JKL) = 1.0 - ZCLEAR(JL)
	1583	ZSCAT(JL) = ZSS0(JL)
	1584	ELSE IF (NOVLP.EQ.2) THEN
	1585	C* maximum
	1586	ZSCAT(JL) = MAX( ZSS0(JL) , ZSCAT(JL) )
	1587	ZC0I(JL,JKL) = ZSCAT(JL)
	1588	ELSE IF (NOVLP.EQ.3) THEN
	1589	c* random
	1590	ZCLEAR(JL)=ZCLEAR(JL)*(1.0-ZSS0(JL))
	1591	ZSCAT(JL) = 1.0 - ZCLEAR(JL)
	1592	ZC0I(JL,JKL) = ZSCAT(JL)
	1593	END IF
	1594	204 CONTINUE
	1595	205 CONTINUE
	1596	C
	1597	C ------------------------------------------------------------------
	1598	C
	1599	C* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
	1600	C -----------------------------------------------
	1601	C
	1602	300 CONTINUE
	1603	C
	1604	DO 301 JL = 1, KDLON
	1605	PRAY1(JL,KFLEV+1) = 0.
	1606	PRAY2(JL,KFLEV+1) = 0.
	1607	PREFZ(JL,2,1) = PALBP(JL,KNU)
	1608	PREFZ(JL,1,1) = PALBP(JL,KNU)
	1609	PTRA1(JL,KFLEV+1) = 1.
	1610	PTRA2(JL,KFLEV+1) = 1.
	1611	301 CONTINUE
	1612	C
	1613	DO 346 JK = 2 , KFLEV+1
	1614	JKM1 = JK-1
	1615	DO 342 JL = 1, KDLON
	1616	C
	1617	C
	1618	C ------------------------------------------------------------------
	1619	C
	1620	C* 3.1 EQUIVALENT ZENITH ANGLE
	1621	C -----------------------
	1622	C
	1623	310 CONTINUE
	1624	C
	1625	ZMUE = (1.-ZC0I(JL,JK)) * PSEC(JL)
	1626	S + ZC0I(JL,JK) * 1.66
	1627	PRMU0(JL,JK) = 1./ZMUE
	1628	C
	1629	C
	1630	C ------------------------------------------------------------------
	1631	C
	1632	C* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
	1633	C ----------------------------------------------------
	1634	C
	1635	320 CONTINUE
	1636	C
	1637	ZGAP = PCGAZ(JL,JKM1)
	1638	ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
	1639	ZWW = PPIZAZ(JL,JKM1)
	1640	ZTO = PTAUAZ(JL,JKM1)
	1641	ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
	1642	S + (1-ZWW) * (1. - ZWW +2.ZBMU0ZWW)ZTOZTOZMUEZMUE
	1643	PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
	1644	PTRA1(JL,JKM1) = 1. / ZDEN
	1645	C
	1646	ZMU1 = 0.5
	1647	ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
	1648	ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
	1649	S + (1-ZWW) * (1. - ZWW +2.ZBMU1ZWW)ZTOZTO/ZMU1/ZMU1
	1650	PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
	1651	PTRA2(JL,JKM1) = 1. / ZDEN1
	1652	C
	1653	C
	1654	C
	1655	PREFZ(JL,1,JK) = (PRAY1(JL,JKM1)
	1656	S + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)
	1657	S * PTRA2(JL,JKM1)
	1658	S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
	1659	C
	1660	ZTR(JL,1,JKM1) = (PTRA1(JL,JKM1)
	1661	S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
	1662	C
	1663	PREFZ(JL,2,JK) = (PRAY1(JL,JKM1)
	1664	S + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)
	1665	S * PTRA2(JL,JKM1) )
	1666	C
	1667	ZTR(JL,2,JKM1) = PTRA1(JL,JKM1)
	1668	C
	1669	342 CONTINUE
	1670	346 CONTINUE
	1671	DO 347 JL = 1, KDLON
	1672	ZMUE = (1.-ZC0I(JL,1))PSEC(JL)+ZC0I(JL,1)1.66
	1673	PRMU0(JL,1)=1./ZMUE
	1674	347 CONTINUE
	1675	C
	1676	C
	1677	C ------------------------------------------------------------------
	1678	C
	1679	C* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
	1680	C -------------------------------------------------
	1681	C
	1682	350 CONTINUE
	1683	C
	1684	IF (KNU.EQ.1) THEN
	1685	JAJ = 2
	1686	DO 351 JL = 1, KDLON
	1687	PRJ(JL,JAJ,KFLEV+1) = 1.
	1688	PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1)
	1689	351 CONTINUE
	1690	C
	1691	DO 353 JK = 1 , KFLEV
	1692	JKL = KFLEV+1 - JK
	1693	JKLP1 = JKL + 1
	1694	DO 352 JL = 1, KDLON
	1695	ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL)
	1696	PRJ(JL,JAJ,JKL) = ZRE11
	1697	PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL)
	1698	352 CONTINUE
	1699	353 CONTINUE
	1700	354 CONTINUE
	1701	C
	1702	ELSE
	1703	C
	1704	DO 358 JAJ = 1 , 2
	1705	DO 355 JL = 1, KDLON
	1706	PRJ(JL,JAJ,KFLEV+1) = 1.
	1707	PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1)
	1708	355 CONTINUE
	1709	C
	1710	DO 357 JK = 1 , KFLEV
	1711	JKL = KFLEV+1 - JK
	1712	JKLP1 = JKL + 1
	1713	DO 356 JL = 1, KDLON
	1714	ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
	1715	PRJ(JL,JAJ,JKL) = ZRE11
	1716	PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
	1717	356 CONTINUE
	1718	357 CONTINUE
	1719	358 CONTINUE
	1720	C
	1721	END IF
	1722	C
	1723	C ------------------------------------------------------------------
	1724	C
	1725	RETURN
	1726	END
	1727	SUBROUTINE SWR ( KNU
	1728	S , PALBD , PCG , PCLD , PDSIG, POMEGA, PRAYL
	1729	S , PSEC , PTAU
	1730	S , PCGAZ , PPIZAZ, PRAY1, PRAY2, PREFZ , PRJ , PRK , PRMUE
	1731	S , PTAUAZ, PTRA1 , PTRA2 )
	1732	IMPLICIT none
	1733	#include "dimensions.h"
	1734	#include "dimphy.h"
	1735	#include "raddim.h"
	1736	#include "radepsi.h"
	1737	#include "radopt.h"
	1738	C
	1739	C ------------------------------------------------------------------
	1740	C PURPOSE.
	1741	C --------
	1742	C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
	1743	C CONTINUUM SCATTERING
	1744	C
	1745	C METHOD.
	1746	C -------
	1747	C
	1748	C 1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
	1749	C OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)
	1750	C
	1751	C REFERENCE.
	1752	C ----------
	1753	C
	1754	C SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	1755	C DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	1756	C
	1757	C AUTHOR.
	1758	C -------
	1759	C JEAN-JACQUES MORCRETTE ECMWF
	1760	C
	1761	C MODIFICATIONS.
	1762	C --------------
	1763	C ORIGINAL : 89-07-14
	1764	C ------------------------------------------------------------------
	1765	C* ARGUMENTS:
	1766	C
	1767	INTEGER KNU
	1768	REAL*8 PALBD(KDLON,2)
	1769	REAL*8 PCG(KDLON,2,KFLEV)
	1770	REAL*8 PCLD(KDLON,KFLEV)
	1771	REAL*8 PDSIG(KDLON,KFLEV)
	1772	REAL*8 POMEGA(KDLON,2,KFLEV)
	1773	REAL*8 PRAYL(KDLON)
	1774	REAL*8 PSEC(KDLON)
	1775	REAL*8 PTAU(KDLON,2,KFLEV)
	1776	C
	1777	REAL*8 PRAY1(KDLON,KFLEV+1)
	1778	REAL*8 PRAY2(KDLON,KFLEV+1)
	1779	REAL*8 PREFZ(KDLON,2,KFLEV+1)
	1780	REAL*8 PRJ(KDLON,6,KFLEV+1)
	1781	REAL*8 PRK(KDLON,6,KFLEV+1)
	1782	REAL*8 PRMUE(KDLON,KFLEV+1)
	1783	REAL*8 PCGAZ(KDLON,KFLEV)
	1784	REAL*8 PPIZAZ(KDLON,KFLEV)
	1785	REAL*8 PTAUAZ(KDLON,KFLEV)
	1786	REAL*8 PTRA1(KDLON,KFLEV+1)
	1787	REAL*8 PTRA2(KDLON,KFLEV+1)
	1788	C
	1789	C* LOCAL VARIABLES:
	1790	C
	1791	REAL*8 ZC1I(KDLON,KFLEV+1)
	1792	REAL*8 ZCLEQ(KDLON,KFLEV)
	1793	REAL*8 ZCLEAR(KDLON)
	1794	REAL*8 ZCLOUD(KDLON)
	1795	REAL*8 ZGG(KDLON)
	1796	REAL*8 ZREF(KDLON)
	1797	REAL*8 ZRE1(KDLON)
	1798	REAL*8 ZRE2(KDLON)
	1799	REAL*8 ZRMUZ(KDLON)
	1800	REAL*8 ZRNEB(KDLON)
	1801	REAL*8 ZR21(KDLON)
	1802	REAL*8 ZR22(KDLON)
	1803	REAL*8 ZR23(KDLON)
	1804	REAL*8 ZSS1(KDLON)
	1805	REAL*8 ZTO1(KDLON)
	1806	REAL*8 ZTR(KDLON,2,KFLEV+1)
	1807	REAL*8 ZTR1(KDLON)
	1808	REAL*8 ZTR2(KDLON)
	1809	REAL*8 ZW(KDLON)
	1810	C
	1811	INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj
	1812	REAL*8 ZFACOA, ZFACOC, ZCORAE, ZCORCD
	1813	REAL*8 ZMUE, ZGAP, ZWW, ZTO, ZDEN, ZDEN1
	1814	REAL*8 ZMU1, ZRE11, ZBMU0, ZBMU1
	1815	C
	1816	C ------------------------------------------------------------------
	1817	C
	1818	C* 1. INITIALIZATION
	1819	C --------------
	1820	C
	1821	100 CONTINUE
	1822	C
	1823	DO 103 JK = 1 , KFLEV+1
	1824	DO 102 JA = 1 , 6
	1825	DO 101 JL = 1, KDLON
	1826	PRJ(JL,JA,JK) = 0.
	1827	PRK(JL,JA,JK) = 0.
	1828	101 CONTINUE
	1829	102 CONTINUE
	1830	103 CONTINUE
	1831	C
	1832	C
	1833	C ------------------------------------------------------------------
	1834	C
	1835	C* 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
	1836	C ----------------------------------------------
	1837	C
	1838	200 CONTINUE
	1839	C
	1840	DO 201 JL = 1, KDLON
	1841	ZR23(JL) = 0.
	1842	ZC1I(JL,KFLEV+1) = 0.
	1843	ZCLEAR(JL) = 1.
	1844	ZCLOUD(JL) = 0.
	1845	201 CONTINUE
	1846	C
	1847	JK = 1
	1848	JKL = KFLEV+1 - JK
	1849	JKLP1 = JKL + 1
	1850	DO 202 JL = 1, KDLON
	1851	ZFACOA = 1. - PPIZAZ(JL,JKL)PCGAZ(JL,JKL)PCGAZ(JL,JKL)
	1852	ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL)
	1853	S * PCG(JL,KNU,JKL)
	1854	ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
	1855	ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL)
	1856	ZR21(JL) = EXP(-ZCORAE )
	1857	ZR22(JL) = EXP(-ZCORCD )
	1858	ZSS1(JL) = PCLD(JL,JKL)(1.0-ZR21(JL)ZR22(JL))
	1859	S + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL))
	1860	ZCLEQ(JL,JKL) = ZSS1(JL)
	1861	C
	1862	IF (NOVLP.EQ.1) THEN
	1863	c* maximum-random
	1864	ZCLEAR(JL) = ZCLEAR(JL)
	1865	S *(1.0-MAX(ZSS1(JL),ZCLOUD(JL)))
	1866	S /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
	1867	ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL)
	1868	ZCLOUD(JL) = ZSS1(JL)
	1869	ELSE IF (NOVLP.EQ.2) THEN
	1870	C* maximum
	1871	ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
	1872	ZC1I(JL,JKL) = ZCLOUD(JL)
	1873	ELSE IF (NOVLP.EQ.3) THEN
	1874	c* random
	1875	ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL))
	1876	ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
	1877	ZC1I(JL,JKL) = ZCLOUD(JL)
	1878	END IF
	1879	202 CONTINUE
	1880	C
	1881	DO 205 JK = 2 , KFLEV
	1882	JKL = KFLEV+1 - JK
	1883	JKLP1 = JKL + 1
	1884	DO 204 JL = 1, KDLON
	1885	ZFACOA = 1. - PPIZAZ(JL,JKL)PCGAZ(JL,JKL)PCGAZ(JL,JKL)
	1886	ZFACOC = 1. - POMEGA(JL,KNU,JKL) * PCG(JL,KNU,JKL)
	1887	S * PCG(JL,KNU,JKL)
	1888	ZCORAE = ZFACOA * PTAUAZ(JL,JKL) * PSEC(JL)
	1889	ZCORCD = ZFACOC * PTAU(JL,KNU,JKL) * PSEC(JL)
	1890	ZR21(JL) = EXP(-ZCORAE )
	1891	ZR22(JL) = EXP(-ZCORCD )
	1892	ZSS1(JL) = PCLD(JL,JKL)(1.0-ZR21(JL)ZR22(JL))
	1893	S + (1.0-PCLD(JL,JKL))*(1.0-ZR21(JL))
	1894	ZCLEQ(JL,JKL) = ZSS1(JL)
	1895	c
	1896	IF (NOVLP.EQ.1) THEN
	1897	c* maximum-random
	1898	ZCLEAR(JL) = ZCLEAR(JL)
	1899	S *(1.0-MAX(ZSS1(JL),ZCLOUD(JL)))
	1900	S /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
	1901	ZC1I(JL,JKL) = 1.0 - ZCLEAR(JL)
	1902	ZCLOUD(JL) = ZSS1(JL)
	1903	ELSE IF (NOVLP.EQ.2) THEN
	1904	C* maximum
	1905	ZCLOUD(JL) = MAX( ZSS1(JL) , ZCLOUD(JL) )
	1906	ZC1I(JL,JKL) = ZCLOUD(JL)
	1907	ELSE IF (NOVLP.EQ.3) THEN
	1908	c* random
	1909	ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - ZSS1(JL))
	1910	ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
	1911	ZC1I(JL,JKL) = ZCLOUD(JL)
	1912	END IF
	1913	204 CONTINUE
	1914	205 CONTINUE
	1915	C
	1916	C ------------------------------------------------------------------
	1917	C
	1918	C* 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
	1919	C -----------------------------------------------
	1920	C
	1921	300 CONTINUE
	1922	C
	1923	DO 301 JL = 1, KDLON
	1924	PRAY1(JL,KFLEV+1) = 0.
	1925	PRAY2(JL,KFLEV+1) = 0.
	1926	PREFZ(JL,2,1) = PALBD(JL,KNU)
	1927	PREFZ(JL,1,1) = PALBD(JL,KNU)
	1928	PTRA1(JL,KFLEV+1) = 1.
	1929	PTRA2(JL,KFLEV+1) = 1.
	1930	301 CONTINUE
	1931	C
	1932	DO 346 JK = 2 , KFLEV+1
	1933	JKM1 = JK-1
	1934	DO 342 JL = 1, KDLON
	1935	ZRNEB(JL)= PCLD(JL,JKM1)
	1936	ZRE1(JL)=0.
	1937	ZTR1(JL)=0.
	1938	ZRE2(JL)=0.
	1939	ZTR2(JL)=0.
	1940	C
	1941	C
	1942	C ------------------------------------------------------------------
	1943	C
	1944	C* 3.1 EQUIVALENT ZENITH ANGLE
	1945	C -----------------------
	1946	C
	1947	310 CONTINUE
	1948	C
	1949	ZMUE = (1.-ZC1I(JL,JK)) * PSEC(JL)
	1950	S + ZC1I(JL,JK) * 1.66
	1951	PRMUE(JL,JK) = 1./ZMUE
	1952	C
	1953	C
	1954	C ------------------------------------------------------------------
	1955	C
	1956	C* 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
	1957	C ----------------------------------------------------
	1958	C
	1959	320 CONTINUE
	1960	C
	1961	ZGAP = PCGAZ(JL,JKM1)
	1962	ZBMU0 = 0.5 - 0.75 * ZGAP / ZMUE
	1963	ZWW = PPIZAZ(JL,JKM1)
	1964	ZTO = PTAUAZ(JL,JKM1)
	1965	ZDEN = 1. + (1. - ZWW + ZBMU0 * ZWW) * ZTO * ZMUE
	1966	S + (1-ZWW) * (1. - ZWW +2.ZBMU0ZWW)ZTOZTOZMUEZMUE
	1967	PRAY1(JL,JKM1) = ZBMU0 * ZWW * ZTO * ZMUE / ZDEN
	1968	PTRA1(JL,JKM1) = 1. / ZDEN
	1969	c PRINT ,' LOOP 342 * 3 ** JL=',JL,PRAY1(JL,JKM1),PTRA1(JL,JKM1)
	1970	C
	1971	ZMU1 = 0.5
	1972	ZBMU1 = 0.5 - 0.75 * ZGAP * ZMU1
	1973	ZDEN1= 1. + (1. - ZWW + ZBMU1 * ZWW) * ZTO / ZMU1
	1974	S + (1-ZWW) * (1. - ZWW +2.ZBMU1ZWW)ZTOZTO/ZMU1/ZMU1
	1975	PRAY2(JL,JKM1) = ZBMU1 * ZWW * ZTO / ZMU1 / ZDEN1
	1976	PTRA2(JL,JKM1) = 1. / ZDEN1
	1977	C
	1978	C
	1979	C ------------------------------------------------------------------
	1980	C
	1981	C* 3.3 EFFECT OF CLOUD LAYER
	1982	C ---------------------
	1983	C
	1984	330 CONTINUE
	1985	C
	1986	ZW(JL) = POMEGA(JL,KNU,JKM1)
	1987	ZTO1(JL) = PTAU(JL,KNU,JKM1)/ZW(JL)
	1988	S + PTAUAZ(JL,JKM1)/PPIZAZ(JL,JKM1)
	1989	ZR21(JL) = PTAU(JL,KNU,JKM1) + PTAUAZ(JL,JKM1)
	1990	ZR22(JL) = PTAU(JL,KNU,JKM1) / ZR21(JL)
	1991	ZGG(JL) = ZR22(JL) * PCG(JL,KNU,JKM1)
	1992	S + (1. - ZR22(JL)) * PCGAZ(JL,JKM1)
	1993	C Modif PhD - JJM 19/03/96 pour erreurs arrondis
	1994	C machine
	1995	C PHD PROTECTION ZW(JL) = ZR21(JL) / ZTO1(JL)
	1996	IF (ZW(JL).EQ.1. .AND. PPIZAZ(JL,JKM1).EQ.1.) THEN
	1997	ZW(JL)=1.
	1998	ELSE
	1999	ZW(JL) = ZR21(JL) / ZTO1(JL)
	2000	END IF
	2001	ZREF(JL) = PREFZ(JL,1,JKM1)
	2002	ZRMUZ(JL) = PRMUE(JL,JK)
	2003	342 CONTINUE
	2004	C
	2005	CALL SWDE(ZGG , ZREF , ZRMUZ , ZTO1 , ZW,
	2006	S ZRE1 , ZRE2 , ZTR1 , ZTR2)
	2007	C
	2008	DO 345 JL = 1, KDLON
	2009	C
	2010	PREFZ(JL,1,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1)
	2011	S + PREFZ(JL,1,JKM1) * PTRA1(JL,JKM1)
	2012	S * PTRA2(JL,JKM1)
	2013	S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
	2014	S + ZRNEB(JL) * ZRE2(JL)
	2015	C
	2016	ZTR(JL,1,JKM1) = ZRNEB(JL) * ZTR2(JL) + (PTRA1(JL,JKM1)
	2017	S / (1.-PRAY2(JL,JKM1)*PREFZ(JL,1,JKM1)))
	2018	S * (1.-ZRNEB(JL))
	2019	C
	2020	PREFZ(JL,2,JK) = (1.-ZRNEB(JL)) * (PRAY1(JL,JKM1)
	2021	S + PREFZ(JL,2,JKM1) * PTRA1(JL,JKM1)
	2022	S * PTRA2(JL,JKM1) )
	2023	S + ZRNEB(JL) * ZRE1(JL)
	2024	C
	2025	ZTR(JL,2,JKM1) = ZRNEB(JL) * ZTR1(JL)
	2026	S + PTRA1(JL,JKM1) * (1.-ZRNEB(JL))
	2027	C
	2028	345 CONTINUE
	2029	346 CONTINUE
	2030	DO 347 JL = 1, KDLON
	2031	ZMUE = (1.-ZC1I(JL,1))PSEC(JL)+ZC1I(JL,1)1.66
	2032	PRMUE(JL,1)=1./ZMUE
	2033	347 CONTINUE
	2034	C
	2035	C
	2036	C ------------------------------------------------------------------
	2037	C
	2038	C* 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
	2039	C -------------------------------------------------
	2040	C
	2041	350 CONTINUE
	2042	C
	2043	IF (KNU.EQ.1) THEN
	2044	JAJ = 2
	2045	DO 351 JL = 1, KDLON
	2046	PRJ(JL,JAJ,KFLEV+1) = 1.
	2047	PRK(JL,JAJ,KFLEV+1) = PREFZ(JL, 1,KFLEV+1)
	2048	351 CONTINUE
	2049	C
	2050	DO 353 JK = 1 , KFLEV
	2051	JKL = KFLEV+1 - JK
	2052	JKLP1 = JKL + 1
	2053	DO 352 JL = 1, KDLON
	2054	ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL, 1,JKL)
	2055	PRJ(JL,JAJ,JKL) = ZRE11
	2056	PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL, 1,JKL)
	2057	352 CONTINUE
	2058	353 CONTINUE
	2059	354 CONTINUE
	2060	C
	2061	ELSE
	2062	C
	2063	DO 358 JAJ = 1 , 2
	2064	DO 355 JL = 1, KDLON
	2065	PRJ(JL,JAJ,KFLEV+1) = 1.
	2066	PRK(JL,JAJ,KFLEV+1) = PREFZ(JL,JAJ,KFLEV+1)
	2067	355 CONTINUE
	2068	C
	2069	DO 357 JK = 1 , KFLEV
	2070	JKL = KFLEV+1 - JK
	2071	JKLP1 = JKL + 1
	2072	DO 356 JL = 1, KDLON
	2073	ZRE11= PRJ(JL,JAJ,JKLP1) * ZTR(JL,JAJ,JKL)
	2074	PRJ(JL,JAJ,JKL) = ZRE11
	2075	PRK(JL,JAJ,JKL) = ZRE11 * PREFZ(JL,JAJ,JKL)
	2076	356 CONTINUE
	2077	357 CONTINUE
	2078	358 CONTINUE
	2079	C
	2080	END IF
	2081	C
	2082	C ------------------------------------------------------------------
	2083	C
	2084	RETURN
	2085	END
	2086	SUBROUTINE SWDE (PGG,PREF,PRMUZ,PTO1,PW,
	2087	S PRE1,PRE2,PTR1,PTR2)
	2088	IMPLICIT none
	2089	#include "dimensions.h"
	2090	#include "dimphy.h"
	2091	#include "raddim.h"
	2092	C
	2093	C ------------------------------------------------------------------
	2094	C PURPOSE.
	2095	C --------
	2096	C COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
	2097	C LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
	2098	C
	2099	C METHOD.
	2100	C -------
	2101	C
	2102	C STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
	2103	C
	2104	C REFERENCE.
	2105	C ----------
	2106	C
	2107	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2108	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2109	C
	2110	C AUTHOR.
	2111	C -------
	2112	C JEAN-JACQUES MORCRETTE ECMWF
	2113	C
	2114	C MODIFICATIONS.
	2115	C --------------
	2116	C ORIGINAL : 88-12-15
	2117	C ------------------------------------------------------------------
	2118	C* ARGUMENTS:
	2119	C
	2120	REAL*8 PGG(KDLON) ! ASSYMETRY FACTOR
	2121	REAL*8 PREF(KDLON) ! REFLECTIVITY OF THE UNDERLYING LAYER
	2122	REAL*8 PRMUZ(KDLON) ! COSINE OF SOLAR ZENITH ANGLE
	2123	REAL*8 PTO1(KDLON) ! OPTICAL THICKNESS
	2124	REAL*8 PW(KDLON) ! SINGLE SCATTERING ALBEDO
	2125	REAL*8 PRE1(KDLON) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
	2126	REAL*8 PRE2(KDLON) ! LAYER REFLECTIVITY
	2127	REAL*8 PTR1(KDLON) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
	2128	REAL*8 PTR2(KDLON) ! LAYER TRANSMISSIVITY
	2129	C
	2130	C* LOCAL VARIABLES:
	2131	C
	2132	INTEGER jl
	2133	REAL*8 ZFF, ZGP, ZTOP, ZWCP, ZDT, ZX1, ZWM
	2134	REAL*8 ZRM2, ZRK, ZX2, ZRP, ZALPHA, ZBETA, ZARG
	2135	REAL*8 ZEXMU0, ZARG2, ZEXKP, ZEXKM, ZXP2P, ZXM2P, ZAP2B, ZAM2B
	2136	REAL*8 ZA11, ZA12, ZA13, ZA21, ZA22, ZA23
	2137	REAL*8 ZDENA, ZC1A, ZC2A, ZRI0A, ZRI1A
	2138	REAL*8 ZRI0B, ZRI1B
	2139	REAL*8 ZB21, ZB22, ZB23, ZDENB, ZC1B, ZC2B
	2140	REAL*8 ZRI0C, ZRI1C, ZRI0D, ZRI1D
	2141	C ------------------------------------------------------------------
	2142	C
	2143	C* 1. DELTA-EDDINGTON CALCULATIONS
	2144	C
	2145	100 CONTINUE
	2146	C
	2147	DO 131 JL = 1, KDLON
	2148	C
	2149	C* 1.1 SET UP THE DELTA-MODIFIED PARAMETERS
	2150	C
	2151	110 CONTINUE
	2152	C
	2153	ZFF = PGG(JL)*PGG(JL)
	2154	ZGP = PGG(JL)/(1.+PGG(JL))
	2155	ZTOP = (1.- PW(JL) * ZFF) * PTO1(JL)
	2156	ZWCP = (1-ZFF)* PW(JL) /(1.- PW(JL) * ZFF)
	2157	ZDT = 2./3.
	2158	ZX1 = 1.-ZWCP*ZGP
	2159	ZWM = 1.-ZWCP
	2160	ZRM2 = PRMUZ(JL) * PRMUZ(JL)
	2161	ZRK = SQRT(3.ZWMZX1)
	2162	ZX2 = 4.(1.-ZRKZRK*ZRM2)
	2163	ZRP=ZRK/ZX1
	2164	ZALPHA = 3.ZWCPZRM2(1.+ZGPZWM)/ZX2
	2165	ZBETA = 3.ZWCP PRMUZ(JL) (1.+3.ZGPZRM2ZWM)/ZX2
	2166	CMAF ZARG=MIN(ZTOP/PRMUZ(JL),200.)
	2167	ZARG=MIN(ZTOP/PRMUZ(JL),2.0d+2)
	2168	ZEXMU0=EXP(-ZARG)
	2169	CMAF ZARG2=MIN(ZRK*ZTOP,200.)
	2170	ZARG2=MIN(ZRK*ZTOP,2.0d+2)
	2171	ZEXKP=EXP(ZARG2)
	2172	ZEXKM = 1./ZEXKP
	2173	ZXP2P = 1.+ZDT*ZRP
	2174	ZXM2P = 1.-ZDT*ZRP
	2175	ZAP2B = ZALPHA+ZDT*ZBETA
	2176	ZAM2B = ZALPHA-ZDT*ZBETA
	2177	C
	2178	C* 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER
	2179	C
	2180	120 CONTINUE
	2181	C
	2182	ZA11 = ZXP2P
	2183	ZA12 = ZXM2P
	2184	ZA13 = ZAP2B
	2185	ZA22 = ZXP2P*ZEXKP
	2186	ZA21 = ZXM2P*ZEXKM
	2187	ZA23 = ZAM2B*ZEXMU0
	2188	ZDENA = ZA11 * ZA22 - ZA21 * ZA12
	2189	ZC1A = (ZA22ZA13-ZA12ZA23)/ZDENA
	2190	ZC2A = (ZA11ZA23-ZA21ZA13)/ZDENA
	2191	ZRI0A = ZC1A+ZC2A-ZALPHA
	2192	ZRI1A = ZRP*(ZC1A-ZC2A)-ZBETA
	2193	PRE1(JL) = (ZRI0A-ZDT*ZRI1A)/ PRMUZ(JL)
	2194	ZRI0B = ZC1AZEXKM+ZC2AZEXKP-ZALPHA*ZEXMU0
	2195	ZRI1B = ZRP(ZC1AZEXKM-ZC2AZEXKP)-ZBETAZEXMU0
	2196	PTR1(JL) = ZEXMU0+(ZRI0B+ZDT*ZRI1B)/ PRMUZ(JL)
	2197	C
	2198	C* 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER
	2199	C
	2200	130 CONTINUE
	2201	C
	2202	ZB21 = ZA21- PREF(JL) ZXP2PZEXKM
	2203	ZB22 = ZA22- PREF(JL) ZXM2PZEXKP
	2204	ZB23 = ZA23- PREF(JL) ZEXMU0(ZAP2B - PRMUZ(JL) )
	2205	ZDENB = ZA11 * ZB22 - ZB21 * ZA12
	2206	ZC1B = (ZB22ZA13-ZA12ZB23)/ZDENB
	2207	ZC2B = (ZA11ZB23-ZB21ZA13)/ZDENB
	2208	ZRI0C = ZC1B+ZC2B-ZALPHA
	2209	ZRI1C = ZRP*(ZC1B-ZC2B)-ZBETA
	2210	PRE2(JL) = (ZRI0C-ZDT*ZRI1C) / PRMUZ(JL)
	2211	ZRI0D = ZC1BZEXKM + ZC2BZEXKP - ZALPHA*ZEXMU0
	2212	ZRI1D = ZRP * (ZC1BZEXKM - ZC2BZEXKP) - ZBETA*ZEXMU0
	2213	PTR2(JL) = ZEXMU0 + (ZRI0D + ZDT*ZRI1D) / PRMUZ(JL)
	2214	C
	2215	131 CONTINUE
	2216	RETURN
	2217	END
	2218	SUBROUTINE SWTT (KNU,KA,PU,PTR)
	2219	IMPLICIT none
	2220	#include "dimensions.h"
	2221	#include "dimphy.h"
	2222	#include "raddim.h"
	2223	C
	2224	C-----------------------------------------------------------------------
	2225	C PURPOSE.
	2226	C --------
	2227	C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	2228	C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
	2229	C INTERVALS.
	2230	C
	2231	C METHOD.
	2232	C -------
	2233	C
	2234	C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
	2235	C AND HORNER'S ALGORITHM.
	2236	C
	2237	C REFERENCE.
	2238	C ----------
	2239	C
	2240	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2241	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2242	C
	2243	C AUTHOR.
	2244	C -------
	2245	C JEAN-JACQUES MORCRETTE ECMWF
	2246	C
	2247	C MODIFICATIONS.
	2248	C --------------
	2249	C ORIGINAL : 88-12-15
	2250	C-----------------------------------------------------------------------
	2251	C
	2252	C* ARGUMENTS
	2253	C
	2254	INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL
	2255	INTEGER KA ! INDEX OF THE ABSORBER
	2256	REAL*8 PU(KDLON) ! ABSORBER AMOUNT
	2257	C
	2258	REAL*8 PTR(KDLON) ! TRANSMISSION FUNCTION
	2259	C
	2260	C* LOCAL VARIABLES:
	2261	C
	2262	REAL*8 ZR1(KDLON), ZR2(KDLON)
	2263	INTEGER jl, i,j
	2264	C
	2265	C* Prescribed Data:
	2266	C
	2267	REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3)
	2268	SAVE APAD, BPAD, D
	2269	DATA ((APAD(1,I,J),I=1,3),J=1,7) /
	2270	S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
	2271	S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01,
	2272	S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00,
	2273	S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02,
	2274	S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02,
	2275	S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02,
	2276	S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 /
	2277	DATA ((APAD(2,I,J),I=1,3),J=1,7) /
	2278	S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
	2279	S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02,
	2280	S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00,
	2281	S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00,
	2282	S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00,
	2283	S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00,
	2284	S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /
	2285	C
	2286	DATA ((BPAD(1,I,J),I=1,3),J=1,7) /
	2287	S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
	2288	S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01,
	2289	S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00,
	2290	S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02,
	2291	S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02,
	2292	S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02,
	2293	S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 /
	2294	DATA ((BPAD(2,I,J),I=1,3),J=1,7) /
	2295	S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
	2296	S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02,
	2297	S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01,
	2298	S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00,
	2299	S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00,
	2300	S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00,
	2301	S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /
	2302	c
	2303	DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 /
	2304	DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 /
	2305	C
	2306	C-----------------------------------------------------------------------
	2307	C
	2308	C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
	2309	C
	2310	100 CONTINUE
	2311	C
	2312	DO 201 JL = 1, KDLON
	2313	ZR1(JL) = APAD(KNU,KA,1) + PU(JL) * (APAD(KNU,KA,2) + PU(JL)
	2314	S * ( APAD(KNU,KA,3) + PU(JL) * (APAD(KNU,KA,4) + PU(JL)
	2315	S * ( APAD(KNU,KA,5) + PU(JL) * (APAD(KNU,KA,6) + PU(JL)
	2316	S * ( APAD(KNU,KA,7) ))))))
	2317	C
	2318	ZR2(JL) = BPAD(KNU,KA,1) + PU(JL) * (BPAD(KNU,KA,2) + PU(JL)
	2319	S * ( BPAD(KNU,KA,3) + PU(JL) * (BPAD(KNU,KA,4) + PU(JL)
	2320	S * ( BPAD(KNU,KA,5) + PU(JL) * (BPAD(KNU,KA,6) + PU(JL)
	2321	S * ( BPAD(KNU,KA,7) ))))))
	2322	C
	2323	C
	2324	C* 2. ADD THE BACKGROUND TRANSMISSION
	2325	C
	2326	200 CONTINUE
	2327	C
	2328	C
	2329	PTR(JL) = (ZR1(JL) / ZR2(JL)) * (1. - D(KNU,KA)) + D(KNU,KA)
	2330	201 CONTINUE
	2331	C
	2332	RETURN
	2333	END
	2334	SUBROUTINE SWTT1(KNU,KABS,KIND, PU, PTR)
	2335	IMPLICIT none
	2336	#include "dimensions.h"
	2337	#include "dimphy.h"
	2338	#include "raddim.h"
	2339	C
	2340	C-----------------------------------------------------------------------
	2341	C PURPOSE.
	2342	C --------
	2343	C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	2344	C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
	2345	C INTERVALS.
	2346	C
	2347	C METHOD.
	2348	C -------
	2349	C
	2350	C TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
	2351	C AND HORNER'S ALGORITHM.
	2352	C
	2353	C REFERENCE.
	2354	C ----------
	2355	C
	2356	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2357	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2358	C
	2359	C AUTHOR.
	2360	C -------
	2361	C JEAN-JACQUES MORCRETTE ECMWF
	2362	C
	2363	C MODIFICATIONS.
	2364	C --------------
	2365	C ORIGINAL : 95-01-20
	2366	C-----------------------------------------------------------------------
	2367	C* ARGUMENTS:
	2368	C
	2369	INTEGER KNU ! INDEX OF THE SPECTRAL INTERVAL
	2370	INTEGER KABS ! NUMBER OF ABSORBERS
	2371	INTEGER KIND(KABS) ! INDICES OF THE ABSORBERS
	2372	REAL*8 PU(KDLON,KABS) ! ABSORBER AMOUNT
	2373	C
	2374	REAL*8 PTR(KDLON,KABS) ! TRANSMISSION FUNCTION
	2375	C
	2376	C* LOCAL VARIABLES:
	2377	C
	2378	REAL*8 ZR1(KDLON)
	2379	REAL*8 ZR2(KDLON)
	2380	REAL*8 ZU(KDLON)
	2381	INTEGER jl, ja, i, j, ia
	2382	C
	2383	C* Prescribed Data:
	2384	C
	2385	REAL*8 APAD(2,3,7), BPAD(2,3,7), D(2,3)
	2386	SAVE APAD, BPAD, D
	2387	DATA ((APAD(1,I,J),I=1,3),J=1,7) /
	2388	S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
	2389	S 0.723613782E+05, 0.000000000E-00, 0.129353723E-01,
	2390	S 0.596037057E+04, 0.000000000E-00, 0.800821928E+00,
	2391	S 0.000000000E-00, 0.000000000E-00, 0.242715973E+02,
	2392	S 0.000000000E-00, 0.000000000E-00, 0.878331486E+02,
	2393	S 0.000000000E-00, 0.000000000E-00, 0.191559725E+02,
	2394	S 0.000000000E-00, 0.000000000E-00, 0.000000000E+00 /
	2395	DATA ((APAD(2,I,J),I=1,3),J=1,7) /
	2396	S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
	2397	S 0.978576773E-04, 0.131849595E-03, 0.672595424E+02,
	2398	S 0.387714006E+00, 0.437772681E+00, 0.000000000E-00,
	2399	S 0.118461660E+03, 0.151345118E+03, 0.000000000E-00,
	2400	S 0.119079797E+04, 0.233628890E+04, 0.000000000E-00,
	2401	S 0.293353397E+03, 0.797219934E+03, 0.000000000E-00,
	2402	S 0.000000000E+00, 0.000000000E+00, 0.000000000E+00 /
	2403	C
	2404	DATA ((BPAD(1,I,J),I=1,3),J=1,7) /
	2405	S 0.912418292E+05, 0.000000000E-00, 0.925887084E-04,
	2406	S 0.724555318E+05, 0.000000000E-00, 0.131812683E-01,
	2407	S 0.602593328E+04, 0.000000000E-00, 0.812706117E+00,
	2408	S 0.100000000E+01, 0.000000000E-00, 0.249863591E+02,
	2409	S 0.000000000E-00, 0.000000000E-00, 0.931071925E+02,
	2410	S 0.000000000E-00, 0.000000000E-00, 0.252233437E+02,
	2411	S 0.000000000E-00, 0.000000000E-00, 0.100000000E+01 /
	2412	DATA ((BPAD(2,I,J),I=1,3),J=1,7) /
	2413	S 0.376655383E-08, 0.739646016E-08, 0.410177786E+03,
	2414	S 0.979023421E-04, 0.131861712E-03, 0.731185438E+02,
	2415	S 0.388611139E+00, 0.437949001E+00, 0.100000000E+01,
	2416	S 0.120291383E+03, 0.151692730E+03, 0.000000000E+00,
	2417	S 0.130531005E+04, 0.237071130E+04, 0.000000000E+00,
	2418	S 0.415049409E+03, 0.867914360E+03, 0.000000000E+00,
	2419	S 0.100000000E+01, 0.100000000E+01, 0.000000000E+00 /
	2420	c
	2421	DATA (D(1,I),I=1,3) / 0.00, 0.00, 0.00 /
	2422	DATA (D(2,I),I=1,3) / 0.000000000, 0.000000000, 0.800000000 /
	2423	C-----------------------------------------------------------------------
	2424	C
	2425	C* 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
	2426	C
	2427	100 CONTINUE
	2428	C
	2429	DO 202 JA = 1,KABS
	2430	IA=KIND(JA)
	2431	DO 201 JL = 1, KDLON
	2432	ZU(JL) = PU(JL,JA)
	2433	ZR1(JL) = APAD(KNU,IA,1) + ZU(JL) * (APAD(KNU,IA,2) + ZU(JL)
	2434	S * ( APAD(KNU,IA,3) + ZU(JL) * (APAD(KNU,IA,4) + ZU(JL)
	2435	S * ( APAD(KNU,IA,5) + ZU(JL) * (APAD(KNU,IA,6) + ZU(JL)
	2436	S * ( APAD(KNU,IA,7) ))))))
	2437	C
	2438	ZR2(JL) = BPAD(KNU,IA,1) + ZU(JL) * (BPAD(KNU,IA,2) + ZU(JL)
	2439	S * ( BPAD(KNU,IA,3) + ZU(JL) * (BPAD(KNU,IA,4) + ZU(JL)
	2440	S * ( BPAD(KNU,IA,5) + ZU(JL) * (BPAD(KNU,IA,6) + ZU(JL)
	2441	S * ( BPAD(KNU,IA,7) ))))))
	2442	C
	2443	C
	2444	C* 2. ADD THE BACKGROUND TRANSMISSION
	2445	C
	2446	200 CONTINUE
	2447	C
	2448	PTR(JL,JA) = (ZR1(JL)/ZR2(JL)) * (1.-D(KNU,IA)) + D(KNU,IA)
	2449	201 CONTINUE
	2450	202 CONTINUE
	2451	C
	2452	RETURN
	2453	END
	2454	SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
	2455	. PPMB, PDP,
	2456	. PPSOL,PDT0,PEMIS,
	2457	. PTL, PTAVE, PWV, POZON, PAER,
	2458	. PCLDLD,PCLDLU,
	2459	. PVIEW,
	2460	. PCOLR, PCOLR0,
[177]	2461	. PTOPLW,PSOLLW,PTOPLW0,PSOLLW0,
	2462	. psollwdown)
[2]	2463	IMPLICIT none
	2464	#include "dimensions.h"
	2465	#include "dimphy.h"
	2466	#include "raddim.h"
	2467	#include "raddimlw.h"
	2468	#include "YOMCST.h"
	2469	C
	2470	C-----------------------------------------------------------------------
	2471	C METHOD.
	2472	C -------
	2473	C
	2474	C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
	2475	C ABSORBERS.
	2476	C 2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
	2477	C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
	2478	C 3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
	2479	C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
	2480	C BOUNDARIES.
	2481	C 4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
	2482	C 5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES.
	2483	C
	2484	C
	2485	C REFERENCE.
	2486	C ----------
	2487	C
	2488	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2489	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2490	C
	2491	C AUTHOR.
	2492	C -------
	2493	C JEAN-JACQUES MORCRETTE ECMWF
	2494	C
	2495	C MODIFICATIONS.
	2496	C --------------
	2497	C ORIGINAL : 89-07-14
	2498	C-----------------------------------------------------------------------
	2499	REAL8 RCO2 ! CO2 CONCENTRATION (IPCC:353.E-06 44.011/28.97)
	2500	REAL8 RCH4 ! CH4 CONCENTRATION (IPCC: 1.72E-06 16.043/28.97)
	2501	REAL8 RN2O ! N2O CONCENTRATION (IPCC: 310.E-09 44.013/28.97)
	2502	REAL8 RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12 137.3686/28.97)
	2503	REAL8 RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12 120.9140/28.97)
	2504	REAL*8 PCLDLD(KDLON,KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER
	2505	REAL*8 PCLDLU(KDLON,KFLEV) ! UPWARD EFFECTIVE CLOUD COVER
	2506	REAL*8 PDP(KDLON,KFLEV) ! LAYER PRESSURE THICKNESS (Pa)
	2507	REAL*8 PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K)
	2508	REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
	2509	REAL*8 PPMB(KDLON,KFLEV+1) ! HALF LEVEL PRESSURE (mb)
	2510	REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (Pa)
	2511	REAL*8 POZON(KDLON,KFLEV) ! O3 CONCENTRATION (kg/kg)
	2512	REAL*8 PTL(KDLON,KFLEV+1) ! HALF LEVEL TEMPERATURE (K)
	2513	REAL*8 PAER(KDLON,KFLEV,5) ! OPTICAL THICKNESS OF THE AEROSOLS
	2514	REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
	2515	REAL*8 PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE
	2516	REAL*8 PWV(KDLON,KFLEV) ! SPECIFIC HUMIDITY (kg/kg)
	2517	C
	2518	REAL*8 PCOLR(KDLON,KFLEV) ! LONG-WAVE TENDENCY (K/day)
	2519	REAL*8 PCOLR0(KDLON,KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky
	2520	REAL*8 PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A.
	2521	REAL*8 PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE
	2522	REAL*8 PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
	2523	REAL*8 PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
[177]	2524	c Rajout LF
	2525	real*8 psollwdown(kdlon) ! LONGWAVE downwards flux at surface
[2]	2526	C
	2527	C-------------------------------------------------------------------------
	2528	REAL8 ZABCU(KDLON,NUA,3KFLEV+1)
	2529	REAL*8 ZOZ(KDLON,KFLEV)
	2530	c
	2531	REAL*8 ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up; 2:down)
	2532	REAL*8 ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
	2533	REAL*8 ZBINT(KDLON,KFLEV+1) ! Intermediate variable
	2534	REAL*8 ZBSUI(KDLON) ! Intermediate variable
	2535	REAL*8 ZCTS(KDLON,KFLEV) ! Intermediate variable
	2536	REAL*8 ZCNTRB(KDLON,KFLEV+1,KFLEV+1) ! Intermediate variable
	2537	SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB
	2538	c
	2539	INTEGER ilim, i, k, kpl1
	2540	C
	2541	INTEGER lw0pas ! Every lw0pas steps, clear-sky is done
	2542	PARAMETER (lw0pas=1)
	2543	INTEGER lwpas ! Every lwpas steps, cloudy-sky is done
	2544	PARAMETER (lwpas=1)
	2545	c
	2546	INTEGER itaplw0, itaplw
	2547	LOGICAL appel1er
	2548	SAVE appel1er, itaplw0, itaplw
	2549	DATA appel1er /.TRUE./
	2550	DATA itaplw0,itaplw /0,0/
	2551	C ------------------------------------------------------------------
	2552	IF (appel1er) THEN
	2553	PRINT*, "LW clear-sky calling frequency: ", lw0pas
	2554	PRINT*, "LW cloudy-sky calling frequency: ", lwpas
	2555	PRINT*, " In general, they should be 1"
	2556	appel1er=.FALSE.
	2557	ENDIF
	2558	C
	2559	IF (MOD(itaplw0,lw0pas).EQ.0) THEN
	2560	DO k = 1, KFLEV ! convertir ozone de kg/kg en pa/pa
	2561	DO i = 1, KDLON
	2562	ZOZ(i,k) = POZON(i,k)PDP(i,k) 28.9644/47.9942
	2563	ENDDO
	2564	ENDDO
	2565	CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12,
	2566	S PAER,PDP,PPMB,PPSOL,ZOZ,PTAVE,PVIEW,PWV,ZABCU)
	2567	CALL LWBV(ILIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,ZABCU,
	2568	S ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB)
	2569	itaplw0 = 0
	2570	ENDIF
	2571	itaplw0 = itaplw0 + 1
	2572	C
	2573	IF (MOD(itaplw,lwpas).EQ.0) THEN
	2574	CALL LWC(ILIM,PCLDLD,PCLDLU,PEMIS,
	2575	S ZFLUC,ZBINT,ZBSUI,ZCTS,ZCNTRB,
	2576	S ZFLUX)
	2577	itaplw = 0
	2578	ENDIF
	2579	itaplw = itaplw + 1
	2580	C
	2581	DO k = 1, KFLEV
	2582	kpl1 = k+1
	2583	DO i = 1, KDLON
	2584	PCOLR(i,k) = ZFLUX(i,1,kpl1)+ZFLUX(i,2,kpl1)
	2585	. - ZFLUX(i,1,k)- ZFLUX(i,2,k)
	2586	PCOLR(i,k) = PCOLR(i,k) * RDAY*RG/RCPD / PDP(i,k)
	2587	PCOLR0(i,k) = ZFLUC(i,1,kpl1)+ZFLUC(i,2,kpl1)
	2588	. - ZFLUC(i,1,k)- ZFLUC(i,2,k)
	2589	PCOLR0(i,k) = PCOLR0(i,k) * RDAY*RG/RCPD / PDP(i,k)
	2590	ENDDO
	2591	ENDDO
	2592	DO i = 1, KDLON
	2593	PSOLLW(i) = -ZFLUX(i,1,1)-ZFLUX(i,2,1)
	2594	PTOPLW(i) = ZFLUX(i,1,KFLEV+1) + ZFLUX(i,2,KFLEV+1)
	2595	c
	2596	PSOLLW0(i) = -ZFLUC(i,1,1)-ZFLUC(i,2,1)
	2597	PTOPLW0(i) = ZFLUC(i,1,KFLEV+1) + ZFLUC(i,2,KFLEV+1)
[177]	2598	psollwdown(i) = -ZFLUX(i,2,1)
[2]	2599	ENDDO
	2600	C ------------------------------------------------------------------
	2601	RETURN
	2602	END
	2603	SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12,
	2604	S PAER,PDP,PPMB,PPSOL,POZ,PTAVE,PVIEW,PWV,
	2605	S PABCU)
	2606	IMPLICIT none
	2607	#include "dimensions.h"
	2608	#include "dimphy.h"
	2609	#include "raddim.h"
	2610	#include "raddimlw.h"
	2611	#include "YOMCST.h"
	2612	#include "radepsi.h"
	2613	#include "radopt.h"
	2614	C
	2615	C PURPOSE.
	2616	C --------
	2617	C COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
	2618	C TEMPERATURE EFFECTS
	2619	C
	2620	C METHOD.
	2621	C -------
	2622	C
	2623	C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
	2624	C ABSORBERS.
	2625	C
	2626	C
	2627	C REFERENCE.
	2628	C ----------
	2629	C
	2630	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2631	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2632	C
	2633	C AUTHOR.
	2634	C -------
	2635	C JEAN-JACQUES MORCRETTE ECMWF
	2636	C
	2637	C MODIFICATIONS.
	2638	C --------------
	2639	C ORIGINAL : 89-07-14
	2640	C Voigt lines (loop 404 modified) - JJM & PhD - 01/96
	2641	C-----------------------------------------------------------------------
	2642	C* ARGUMENTS:
	2643	REAL*8 RCO2
	2644	REAL*8 RCH4, RN2O, RCFC11, RCFC12
	2645	REAL*8 PAER(KDLON,KFLEV,5)
	2646	REAL*8 PDP(KDLON,KFLEV)
	2647	REAL*8 PPMB(KDLON,KFLEV+1)
	2648	REAL*8 PPSOL(KDLON)
	2649	REAL*8 POZ(KDLON,KFLEV)
	2650	REAL*8 PTAVE(KDLON,KFLEV)
	2651	REAL*8 PVIEW(KDLON)
	2652	REAL*8 PWV(KDLON,KFLEV)
	2653	C
	2654	REAL8 PABCU(KDLON,NUA,3KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
	2655	C
	2656	C-----------------------------------------------------------------------
	2657	C* LOCAL VARIABLES:
	2658	REAL8 ZABLY(KDLON,NUA,3KFLEV+1)
	2659	REAL8 ZDUC(KDLON,3KFLEV+1)
	2660	REAL*8 ZPHIO(KDLON)
	2661	REAL*8 ZPSC2(KDLON)
	2662	REAL*8 ZPSC3(KDLON)
	2663	REAL*8 ZPSH1(KDLON)
	2664	REAL*8 ZPSH2(KDLON)
	2665	REAL*8 ZPSH3(KDLON)
	2666	REAL*8 ZPSH4(KDLON)
	2667	REAL*8 ZPSH5(KDLON)
	2668	REAL*8 ZPSH6(KDLON)
	2669	REAL*8 ZPSIO(KDLON)
	2670	REAL*8 ZTCON(KDLON)
	2671	REAL*8 ZPHM6(KDLON)
	2672	REAL*8 ZPSM6(KDLON)
	2673	REAL*8 ZPHN6(KDLON)
	2674	REAL*8 ZPSN6(KDLON)
	2675	REAL8 ZSSIG(KDLON,3KFLEV+1)
	2676	REAL*8 ZTAVI(KDLON)
	2677	REAL*8 ZUAER(KDLON,Ninter)
	2678	REAL*8 ZXOZ(KDLON)
	2679	REAL*8 ZXWV(KDLON)
	2680	C
	2681	INTEGER jl, jk, jkj, jkjr, jkjp, ig1
	2682	INTEGER jki, jkip1, ja, jj
	2683	INTEGER jkl, jkp1, jkk, jkjpn
	2684	INTEGER jae1, jae2, jae3, jae, jjpn
	2685	INTEGER ir, jc, jcp1
	2686	REAL*8 zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
	2687	REAL*8 zfppw, ztx, ztx2, zzably
	2688	REAL*8 zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
	2689	REAL*8 zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
	2690	REAL*8 zcac8, zcbc8
	2691	REAL*8 zalup, zdiff
	2692	c
	2693	REAL*8 PVGCO2, PVGH2O, PVGO3
	2694	C
	2695	REAL*8 R10E ! DECIMAL/NATURAL LOG.FACTOR
	2696	PARAMETER (R10E=0.4342945)
	2697	c
	2698	c Used Data Block:
	2699	c
	2700	REAL*8 TREF
	2701	SAVE TREF
	2702	REAL*8 RT1(2)
	2703	SAVE RT1
	2704	REAL*8 RAER(5,5)
	2705	SAVE RAER
	2706	REAL*8 AT(8,3), BT(8,3)
	2707	SAVE AT, BT
	2708	REAL*8 OCT(4)
	2709	SAVE OCT
	2710	DATA TREF /250.0/
	2711	DATA (RT1(IG1),IG1=1,2) / -0.577350269, +0.577350269 /
	2712	DATA RAER / .038520, .037196, .040532, .054934, .038520
	2713	1 , .12613 , .18313 , .10357 , .064106, .126130
	2714	2 , .012579, .013649, .018652, .025181, .012579
	2715	3 , .011890, .016142, .021105, .028908, .011890
	2716	4 , .013792, .026810, .052203, .066338, .013792 /
	2717	DATA (AT(1,IR),IR=1,3) /
	2718	S 0.298199E-02,-.394023E-03,0.319566E-04 /
	2719	DATA (BT(1,IR),IR=1,3) /
	2720	S-0.106432E-04,0.660324E-06,0.174356E-06 /
	2721	DATA (AT(2,IR),IR=1,3) /
	2722	S 0.143676E-01,0.366501E-02,-.160822E-02 /
	2723	DATA (BT(2,IR),IR=1,3) /
	2724	S-0.553979E-04,-.101701E-04,0.920868E-05 /
	2725	DATA (AT(3,IR),IR=1,3) /
	2726	S 0.197861E-01,0.315541E-02,-.174547E-02 /
	2727	DATA (BT(3,IR),IR=1,3) /
	2728	S-0.877012E-04,0.513302E-04,0.523138E-06 /
	2729	DATA (AT(4,IR),IR=1,3) /
	2730	S 0.289560E-01,-.208807E-02,-.121943E-02 /
	2731	DATA (BT(4,IR),IR=1,3) /
	2732	S-0.165960E-03,0.157704E-03,-.146427E-04 /
	2733	DATA (AT(5,IR),IR=1,3) /
	2734	S 0.103800E-01,0.436296E-02,-.161431E-02 /
	2735	DATA (BT(5,IR),IR=1,3) /
	2736	S -.276744E-04,-.327381E-04,0.127646E-04 /
	2737	DATA (AT(6,IR),IR=1,3) /
	2738	S 0.868859E-02,-.972752E-03,0.000000E-00 /
	2739	DATA (BT(6,IR),IR=1,3) /
	2740	S -.278412E-04,-.713940E-06,0.117469E-05 /
	2741	DATA (AT(7,IR),IR=1,3) /
	2742	S 0.250073E-03,0.455875E-03,0.109242E-03 /
	2743	DATA (BT(7,IR),IR=1,3) /
	2744	S 0.199846E-05,-.216313E-05,0.175991E-06 /
	2745	DATA (AT(8,IR),IR=1,3) /
	2746	S 0.307423E-01,0.110879E-02,-.322172E-03 /
	2747	DATA (BT(8,IR),IR=1,3) /
	2748	S-0.108482E-03,0.258096E-05,-.814575E-06 /
	2749	c
	2750	DATA OCT /-.326E-03, -.102E-05, .137E-02, -.535E-05/
	2751	C-----------------------------------------------------------------------
	2752	c
	2753	IF (LEVOIGT) THEN
	2754	PVGCO2= 60.
	2755	PVGH2O= 30.
	2756	PVGO3 =400.
	2757	ELSE
	2758	PVGCO2= 0.
	2759	PVGH2O= 0.
	2760	PVGO3 = 0.
	2761	ENDIF
	2762	C
	2763	C
	2764	C* 2. PRESSURE OVER GAUSS SUB-LEVELS
	2765	C ------------------------------
	2766	C
	2767	200 CONTINUE
	2768	C
	2769	DO 201 JL = 1, KDLON
	2770	ZSSIG(JL, 1 ) = PPMB(JL,1) * 100.
	2771	201 CONTINUE
	2772	C
	2773	DO 206 JK = 1 , KFLEV
	2774	JKJ=(JK-1)*NG1P1+1
	2775	JKJR = JKJ
	2776	JKJP = JKJ + NG1P1
	2777	DO 203 JL = 1, KDLON
	2778	ZSSIG(JL,JKJP)=PPMB(JL,JK+1)* 100.
	2779	203 CONTINUE
	2780	DO 205 IG1=1,NG1
	2781	JKJ=JKJ+1
	2782	DO 204 JL = 1, KDLON
	2783	ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5
	2784	S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
	2785	204 CONTINUE
	2786	205 CONTINUE
	2787	206 CONTINUE
	2788	C
	2789	C-----------------------------------------------------------------------
	2790	C
	2791	C
	2792	C* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
	2793	C --------------------------------------------------
	2794	C
	2795	400 CONTINUE
	2796	C
	2797	DO 402 JKI=1,3*KFLEV
	2798	JKIP1=JKI+1
	2799	DO 401 JL = 1, KDLON
	2800	ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5
	2801	ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))
	2802	S /(10.*RG)
	2803	401 CONTINUE
	2804	402 CONTINUE
	2805	C
	2806	DO 406 JK = 1 , KFLEV
	2807	JKP1=JK+1
	2808	JKL = KFLEV+1 - JK
	2809	DO 403 JL = 1, KDLON
	2810	ZXWV(JL) = MAX (PWV(JL,JK) , ZEPSCQ )
	2811	ZXOZ(JL) = MAX (POZ(JL,JK) / PDP(JL,JK) , ZEPSCO )
	2812	403 CONTINUE
	2813	JKJ=(JK-1)*NG1P1+1
	2814	JKJPN=JKJ+NG1
	2815	DO 405 JKK=JKJ,JKJPN
	2816	DO 404 JL = 1, KDLON
	2817	ZDPM = ZABLY(JL,3,JKK)
	2818	ZUPM = ZABLY(JL,5,JKK) * ZDPM / 101325.
	2819	ZUPMCO2 = ( ZABLY(JL,5,JKK) + PVGCO2 ) * ZDPM / 101325.
	2820	ZUPMH2O = ( ZABLY(JL,5,JKK) + PVGH2O ) * ZDPM / 101325.
	2821	ZUPMO3 = ( ZABLY(JL,5,JKK) + PVGO3 ) * ZDPM / 101325.
	2822	ZDUC(JL,JKK) = ZDPM
	2823	ZABLY(JL,12,JKK) = ZXOZ(JL) * ZDPM
	2824	ZABLY(JL,13,JKK) = ZXOZ(JL) * ZUPMO3
	2825	ZU6 = ZXWV(JL) * ZUPM
	2826	ZFPPW = 1.6078 * ZXWV(JL) / (1.+0.608*ZXWV(JL))
	2827	ZABLY(JL,6,JKK) = ZXWV(JL) * ZUPMH2O
	2828	ZABLY(JL,11,JKK) = ZU6 * ZFPPW
	2829	ZABLY(JL,10,JKK) = ZU6 * (1.-ZFPPW)
	2830	ZABLY(JL,9,JKK) = RCO2 * ZUPMCO2
	2831	ZABLY(JL,8,JKK) = RCO2 * ZDPM
	2832	404 CONTINUE
	2833	405 CONTINUE
	2834	406 CONTINUE
	2835	C
	2836	C-----------------------------------------------------------------------
	2837	C
	2838	C
	2839	C* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
	2840	C --------------------------------------------------
	2841	C
	2842	500 CONTINUE
	2843	C
	2844	DO 502 JA = 1, NUA
	2845	DO 501 JL = 1, KDLON
	2846	PABCU(JL,JA,3*KFLEV+1) = 0.
	2847	501 CONTINUE
	2848	502 CONTINUE
	2849	C
	2850	DO 529 JK = 1 , KFLEV
	2851	JJ=(JK-1)*NG1P1+1
	2852	JJPN=JJ+NG1
	2853	JKL=KFLEV+1-JK
	2854	C
	2855	C
	2856	C* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
	2857	C --------------------------------------------------
	2858	C
	2859	510 CONTINUE
	2860	C
	2861	JAE1=3*KFLEV+1-JJ
	2862	JAE2=3*KFLEV+1-(JJ+1)
	2863	JAE3=3*KFLEV+1-JJPN
	2864	DO 512 JAE=1,5
	2865	DO 511 JL = 1, KDLON
	2866	ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL,JKL,1)
	2867	S +RAER(JAE,2)PAER(JL,JKL,2)+RAER(JAE,3)PAER(JL,JKL,3)
	2868	S +RAER(JAE,4)PAER(JL,JKL,4)+RAER(JAE,5)PAER(JL,JKL,5))
	2869	S /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3))
	2870	511 CONTINUE
	2871	512 CONTINUE
	2872	C
	2873	C
	2874	C
	2875	C* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
	2876	C --------------------------------------------------
	2877	C
	2878	520 CONTINUE
	2879	C
	2880	DO 521 JL = 1, KDLON
	2881	ZTAVI(JL)=PTAVE(JL,JKL)
	2882	ZTCON(JL)=EXP(6.08*(296./ZTAVI(JL)-1.))
	2883	ZTX=ZTAVI(JL)-TREF
	2884	ZTX2=ZTX*ZTX
	2885	ZZABLY = ZABLY(JL,6,JAE1)+ZABLY(JL,6,JAE2)+ZABLY(JL,6,JAE3)
	2886	CMAF ZUP=MIN( MAX( 0.5R10ELOG( ZZABLY ) + 5., 0.), 6.0)
	2887	ZUP=MIN( MAX( 0.5R10ELOG( ZZABLY ) + 5., 0.d+0), 6.d+0)
	2888	ZCAH1=AT(1,1)+ZUP(AT(1,2)+ZUP(AT(1,3)))
	2889	ZCBH1=BT(1,1)+ZUP(BT(1,2)+ZUP(BT(1,3)))
	2890	ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )
	2891	ZCAH2=AT(2,1)+ZUP(AT(2,2)+ZUP(AT(2,3)))
	2892	ZCBH2=BT(2,1)+ZUP(BT(2,2)+ZUP(BT(2,3)))
	2893	ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )
	2894	ZCAH3=AT(3,1)+ZUP(AT(3,2)+ZUP(AT(3,3)))
	2895	ZCBH3=BT(3,1)+ZUP(BT(3,2)+ZUP(BT(3,3)))
	2896	ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )
	2897	ZCAH4=AT(4,1)+ZUP(AT(4,2)+ZUP(AT(4,3)))
	2898	ZCBH4=BT(4,1)+ZUP(BT(4,2)+ZUP(BT(4,3)))
	2899	ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )
	2900	ZCAH5=AT(5,1)+ZUP(AT(5,2)+ZUP(AT(5,3)))
	2901	ZCBH5=BT(5,1)+ZUP(BT(5,2)+ZUP(BT(5,3)))
	2902	ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )
	2903	ZCAH6=AT(6,1)+ZUP(AT(6,2)+ZUP(AT(6,3)))
	2904	ZCBH6=BT(6,1)+ZUP(BT(6,2)+ZUP(BT(6,3)))
	2905	ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )
	2906	ZPHM6(JL)=EXP(-5.81E-4 * ZTX - 1.13E-6 * ZTX2 )
	2907	ZPSM6(JL)=EXP(-5.57E-4 * ZTX - 3.30E-6 * ZTX2 )
	2908	ZPHN6(JL)=EXP(-3.46E-5 * ZTX + 2.05E-7 * ZTX2 )
	2909	ZPSN6(JL)=EXP( 3.70E-3 * ZTX - 2.30E-6 * ZTX2 )
	2910	521 CONTINUE
	2911	C
	2912	DO 522 JL = 1, KDLON
	2913	ZTAVI(JL)=PTAVE(JL,JKL)
	2914	ZTX=ZTAVI(JL)-TREF
	2915	ZTX2=ZTX*ZTX
	2916	ZZABLY = ZABLY(JL,9,JAE1)+ZABLY(JL,9,JAE2)+ZABLY(JL,9,JAE3)
	2917	ZALUP = R10E * LOG ( ZZABLY )
	2918	CMAF ZUP = MAX( 0.0 , 5.0 + 0.5 * ZALUP )
	2919	ZUP = MAX( 0.d+0 , 5.0 + 0.5 * ZALUP )
	2920	ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP
	2921	ZCAC8=AT(8,1)+ZUP(AT(8,2)+ZUP(AT(8,3)))
	2922	ZCBC8=BT(8,1)+ZUP(BT(8,2)+ZUP(BT(8,3)))
	2923	ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )
	2924	ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2)
	2925	ZPSIO(JL) = EXP( 2.* (OCT(3)ZTX+OCT(4)ZTX2))
	2926	522 CONTINUE
	2927	C
	2928	DO 524 JKK=JJ,JJPN
	2929	JC=3*KFLEV+1-JKK
	2930	JCP1=JC+1
	2931	DO 523 JL = 1, KDLON
	2932	ZDIFF = PVIEW(JL)
	2933	PABCU(JL,10,JC)=PABCU(JL,10,JCP1)
	2934	S +ZABLY(JL,10,JC) *ZDIFF
	2935	PABCU(JL,11,JC)=PABCU(JL,11,JCP1)
	2936	S +ZABLY(JL,11,JC)ZTCON(JL)ZDIFF
	2937	C
	2938	PABCU(JL,12,JC)=PABCU(JL,12,JCP1)
	2939	S +ZABLY(JL,12,JC)ZPHIO(JL)ZDIFF
	2940	PABCU(JL,13,JC)=PABCU(JL,13,JCP1)
	2941	S +ZABLY(JL,13,JC)ZPSIO(JL)ZDIFF
	2942	C
	2943	PABCU(JL,7,JC)=PABCU(JL,7,JCP1)
	2944	S +ZABLY(JL,9,JC)ZPSC2(JL)ZDIFF
	2945	PABCU(JL,8,JC)=PABCU(JL,8,JCP1)
	2946	S +ZABLY(JL,9,JC)ZPSC3(JL)ZDIFF
	2947	PABCU(JL,9,JC)=PABCU(JL,9,JCP1)
	2948	S +ZABLY(JL,9,JC)ZPSC3(JL)ZDIFF
	2949	C
	2950	PABCU(JL,1,JC)=PABCU(JL,1,JCP1)
	2951	S +ZABLY(JL,6,JC)ZPSH1(JL)ZDIFF
	2952	PABCU(JL,2,JC)=PABCU(JL,2,JCP1)
	2953	S +ZABLY(JL,6,JC)ZPSH2(JL)ZDIFF
	2954	PABCU(JL,3,JC)=PABCU(JL,3,JCP1)
	2955	S +ZABLY(JL,6,JC)ZPSH5(JL)ZDIFF
	2956	PABCU(JL,4,JC)=PABCU(JL,4,JCP1)
	2957	S +ZABLY(JL,6,JC)ZPSH3(JL)ZDIFF
	2958	PABCU(JL,5,JC)=PABCU(JL,5,JCP1)
	2959	S +ZABLY(JL,6,JC)ZPSH4(JL)ZDIFF
	2960	PABCU(JL,6,JC)=PABCU(JL,6,JCP1)
	2961	S +ZABLY(JL,6,JC)ZPSH6(JL)ZDIFF
	2962	C
	2963	PABCU(JL,14,JC)=PABCU(JL,14,JCP1)
	2964	S +ZUAER(JL,1) ZDUC(JL,JC)ZDIFF
	2965	PABCU(JL,15,JC)=PABCU(JL,15,JCP1)
	2966	S +ZUAER(JL,2) ZDUC(JL,JC)ZDIFF
	2967	PABCU(JL,16,JC)=PABCU(JL,16,JCP1)
	2968	S +ZUAER(JL,3) ZDUC(JL,JC)ZDIFF
	2969	PABCU(JL,17,JC)=PABCU(JL,17,JCP1)
	2970	S +ZUAER(JL,4) ZDUC(JL,JC)ZDIFF
	2971	PABCU(JL,18,JC)=PABCU(JL,18,JCP1)
	2972	S +ZUAER(JL,5) ZDUC(JL,JC)ZDIFF
	2973	C
	2974	PABCU(JL,19,JC)=PABCU(JL,19,JCP1)
	2975	S +ZABLY(JL,8,JC)RCH4/RCO2ZPHM6(JL)*ZDIFF
	2976	PABCU(JL,20,JC)=PABCU(JL,20,JCP1)
	2977	S +ZABLY(JL,9,JC)RCH4/RCO2ZPSM6(JL)*ZDIFF
	2978	PABCU(JL,21,JC)=PABCU(JL,21,JCP1)
	2979	S +ZABLY(JL,8,JC)RN2O/RCO2ZPHN6(JL)*ZDIFF
	2980	PABCU(JL,22,JC)=PABCU(JL,22,JCP1)
	2981	S +ZABLY(JL,9,JC)RN2O/RCO2ZPSN6(JL)*ZDIFF
	2982	C
	2983	PABCU(JL,23,JC)=PABCU(JL,23,JCP1)
	2984	S +ZABLY(JL,8,JC)RCFC11/RCO2 ZDIFF
	2985	PABCU(JL,24,JC)=PABCU(JL,24,JCP1)
	2986	S +ZABLY(JL,8,JC)RCFC12/RCO2 ZDIFF
	2987	523 CONTINUE
	2988	524 CONTINUE
	2989	C
	2990	529 CONTINUE
	2991	C
	2992	C
	2993	RETURN
	2994	END
	2995	SUBROUTINE LWBV(KLIM,PDP,PDT0,PEMIS,PPMB,PTL,PTAVE,PABCU,
	2996	S PFLUC,PBINT,PBSUI,PCTS,PCNTRB)
	2997	IMPLICIT none
	2998	#include "dimensions.h"
	2999	#include "dimphy.h"
	3000	#include "raddim.h"
	3001	#include "raddimlw.h"
	3002	#include "YOMCST.h"
	3003	C
	3004	C PURPOSE.
	3005	C --------
	3006	C TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
	3007	C VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
	3008	C SAVING
	3009	C
	3010	C METHOD.
	3011	C -------
	3012	C
	3013	C 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
	3014	C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
	3015	C 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
	3016	C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
	3017	C BOUNDARIES.
	3018	C 3. COMPUTES THE CLEAR-SKY COOLING RATES.
	3019	C
	3020	C REFERENCE.
	3021	C ----------
	3022	C
	3023	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	3024	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	3025	C
	3026	C AUTHOR.
	3027	C -------
	3028	C JEAN-JACQUES MORCRETTE ECMWF
	3029	C
	3030	C MODIFICATIONS.
	3031	C --------------
	3032	C ORIGINAL : 89-07-14
	3033	C MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
	3034	C MEMORY)
	3035	C-----------------------------------------------------------------------
	3036	C* ARGUMENTS:
	3037	INTEGER KLIM
	3038	C
	3039	REAL*8 PDP(KDLON,KFLEV)
	3040	REAL*8 PDT0(KDLON)
	3041	REAL*8 PEMIS(KDLON)
	3042	REAL*8 PPMB(KDLON,KFLEV+1)
	3043	REAL*8 PTL(KDLON,KFLEV+1)
	3044	REAL*8 PTAVE(KDLON,KFLEV)
	3045	C
	3046	REAL*8 PFLUC(KDLON,2,KFLEV+1)
	3047	C
	3048	REAL8 PABCU(KDLON,NUA,3KFLEV+1)
	3049	REAL*8 PBINT(KDLON,KFLEV+1)
	3050	REAL*8 PBSUI(KDLON)
	3051	REAL*8 PCTS(KDLON,KFLEV)
	3052	REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1)
	3053	C
	3054	C-------------------------------------------------------------------------
	3055	C
	3056	C* LOCAL VARIABLES:
	3057	REAL*8 ZB(KDLON,Ninter,KFLEV+1)
	3058	REAL*8 ZBSUR(KDLON,Ninter)
	3059	REAL*8 ZBTOP(KDLON,Ninter)
	3060	REAL8 ZDBSL(KDLON,Ninter,KFLEV2)
	3061	REAL*8 ZGA(KDLON,8,2,KFLEV)
	3062	REAL*8 ZGB(KDLON,8,2,KFLEV)
	3063	REAL*8 ZGASUR(KDLON,8,2)
	3064	REAL*8 ZGBSUR(KDLON,8,2)
	3065	REAL*8 ZGATOP(KDLON,8,2)
	3066	REAL*8 ZGBTOP(KDLON,8,2)
	3067	C
	3068	INTEGER nuaer, ntraer
	3069	C ------------------------------------------------------------------
	3070	C* COMPUTES PLANCK FUNCTIONS:
	3071	CALL LWB(PDT0,PTAVE,PTL,
	3072	S ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL,
	3073	S ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP)
	3074	C ------------------------------------------------------------------
	3075	C* PERFORMS THE VERTICAL INTEGRATION:
	3076	NUAER = NUA
	3077	NTRAER = NTRA
	3078	CALL LWV(NUAER,NTRAER, KLIM
	3079	R , PABCU,ZB,PBINT,PBSUI,ZBSUR,ZBTOP,ZDBSL,PEMIS,PPMB,PTAVE
	3080	R , ZGA,ZGB,ZGASUR,ZGBSUR,ZGATOP,ZGBTOP
	3081	S , PCNTRB,PCTS,PFLUC)
	3082	C ------------------------------------------------------------------
	3083	RETURN
	3084	END
	3085	SUBROUTINE LWC(KLIM,PCLDLD,PCLDLU,PEMIS,PFLUC,
	3086	R PBINT,PBSUIN,PCTS,PCNTRB,
	3087	S PFLUX)
	3088	IMPLICIT none
	3089	#include "dimensions.h"
	3090	#include "dimphy.h"
	3091	#include "raddim.h"
	3092	#include "radepsi.h"
	3093	#include "radopt.h"
	3094	C
	3095	C PURPOSE.
	3096	C --------
	3097	C INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
	3098	C RADIANCES
	3099	C
	3100	C EXPLICIT ARGUMENTS :
	3101	C --------------------
	3102	C ==== INPUTS ===
	3103	C PBINT : (KDLON,0:KFLEV) ; HALF LEVEL PLANCK FUNCTION
	3104	C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION
	3105	C PCLDLD : (KDLON,KFLEV) ; DOWNWARD EFFECTIVE CLOUD FRACTION
	3106	C PCLDLU : (KDLON,KFLEV) ; UPWARD EFFECTIVE CLOUD FRACTION
	3107	C PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE
	3108	C PCTS : (KDLON,KFLEV) ; CLEAR-SKY LAYER COOLING-TO-SPACE
	3109	C PEMIS : (KDLON) ; SURFACE EMISSIVITY
	3110	C PFLUC
	3111	C ==== OUTPUTS ===
	3112	C PFLUX(KDLON,2,KFLEV) ; RADIATIVE FLUXES :
	3113	C 1 ==> UPWARD FLUX TOTAL
	3114	C 2 ==> DOWNWARD FLUX TOTAL
	3115	C
	3116	C METHOD.
	3117	C -------
	3118	C
	3119	C 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
	3120	C 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
	3121	C 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
	3122	C CLOUDS
	3123	C
	3124	C REFERENCE.
	3125	C ----------
	3126	C
	3127	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	3128	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	3129	C
	3130	C AUTHOR.
	3131	C -------
	3132	C JEAN-JACQUES MORCRETTE ECMWF
	3133	C
	3134	C MODIFICATIONS.
	3135	C --------------
	3136	C ORIGINAL : 89-07-14
	3137	C Voigt lines (loop 231 to 233) - JJM & PhD - 01/96
	3138	C-----------------------------------------------------------------------
	3139	C* ARGUMENTS:
	3140	INTEGER klim
	3141	REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
	3142	REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION
	3143	REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
	3144	REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) !CLEAR-SKY ENERGY EXCHANGE
	3145	REAL*8 PCTS(KDLON,KFLEV) ! CLEAR-SKY LAYER COOLING-TO-SPACE
	3146	c
	3147	REAL*8 PCLDLD(KDLON,KFLEV)
	3148	REAL*8 PCLDLU(KDLON,KFLEV)
	3149	REAL*8 PEMIS(KDLON)
	3150	C
	3151	REAL*8 PFLUX(KDLON,2,KFLEV+1)
	3152	C-----------------------------------------------------------------------
	3153	C* LOCAL VARIABLES:
	3154	INTEGER IMX(KDLON), IMXP(KDLON)
	3155	C
	3156	REAL*8 ZCLEAR(KDLON),ZCLOUD(KDLON),ZDNF(KDLON,KFLEV+1,KFLEV+1)
	3157	S , ZFD(KDLON), ZFN10(KDLON), ZFU(KDLON)
	3158	S , ZUPF(KDLON,KFLEV+1,KFLEV+1)
	3159	REAL*8 ZCLM(KDLON,KFLEV+1,KFLEV+1)
	3160	C
	3161	INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
	3162	INTEGER jk1, jk2, jkc, jkcp1, jcloud
	3163	INTEGER imxm1, imxp1
	3164	REAL*8 zcfrac
	3165	C ------------------------------------------------------------------
	3166	C
	3167	C* 1. INITIALIZATION
	3168	C --------------
	3169	C
	3170	100 CONTINUE
	3171	C
	3172	IMAXC = 0
	3173	C
	3174	DO 101 JL = 1, KDLON
	3175	IMX(JL)=0
	3176	IMXP(JL)=0
	3177	ZCLOUD(JL) = 0.
	3178	101 CONTINUE
	3179	C
	3180	C* 1.1 SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
	3181	C -------------------------------------------
	3182	C
	3183	110 CONTINUE
	3184	C
	3185	DO 112 JK = 1 , KFLEV
	3186	DO 111 JL = 1, KDLON
	3187	IMX1=IMX(JL)
	3188	IMX2=JK
	3189	IF (PCLDLU(JL,JK).GT.ZEPSC) THEN
	3190	IMXP(JL)=IMX2
	3191	ELSE
	3192	IMXP(JL)=IMX1
	3193	END IF
	3194	IMAXC=MAX(IMXP(JL),IMAXC)
	3195	IMX(JL)=IMXP(JL)
	3196	111 CONTINUE
	3197	112 CONTINUE
	3198	CGM*******
	3199	IMAXC=KFLEV
	3200	CGM*******
	3201	C
	3202	DO 114 JK = 1 , KFLEV+1
	3203	DO 113 JL = 1, KDLON
	3204	PFLUX(JL,1,JK) = PFLUC(JL,1,JK)
	3205	PFLUX(JL,2,JK) = PFLUC(JL,2,JK)
	3206	113 CONTINUE
	3207	114 CONTINUE
	3208	C
	3209	C ------------------------------------------------------------------
	3210	C
	3211	C* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
	3212	C ---------------------------------------
	3213	C
	3214	IF (IMAXC.GT.0) THEN
	3215	C
	3216	IMXP1 = IMAXC + 1
	3217	IMXM1 = IMAXC - 1
	3218	C
	3219	C* 2.0 INITIALIZE TO CLEAR-SKY FLUXES
	3220	C ------------------------------
	3221	C
	3222	200 CONTINUE
	3223	C
	3224	DO 203 JK1=1,KFLEV+1
	3225	DO 202 JK2=1,KFLEV+1
	3226	DO 201 JL = 1, KDLON
	3227	ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1)
	3228	ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1)
	3229	201 CONTINUE
	3230	202 CONTINUE
	3231	203 CONTINUE
	3232	C
	3233	C* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
	3234	C ----------------------------------------------
	3235	C
	3236	210 CONTINUE
	3237	C
	3238	DO 213 JKC = 1 , IMAXC
	3239	JCLOUD=JKC
	3240	JKCP1=JCLOUD+1
	3241	C
	3242	C* 2.1.1 ABOVE THE CLOUD
	3243	C ---------------
	3244	C
	3245	2110 CONTINUE
	3246	C
	3247	DO 2115 JK=JKCP1,KFLEV+1
	3248	JKM1=JK-1
	3249	DO 2111 JL = 1, KDLON
	3250	ZFU(JL)=0.
	3251	2111 CONTINUE
	3252	IF (JK .GT. JKCP1) THEN
	3253	DO 2113 JKJ=JKCP1,JKM1
	3254	DO 2112 JL = 1, KDLON
	3255	ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ)
	3256	2112 CONTINUE
	3257	2113 CONTINUE
	3258	END IF
	3259	C
	3260	DO 2114 JL = 1, KDLON
	3261	ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL)
	3262	2114 CONTINUE
	3263	2115 CONTINUE
	3264	C
	3265	C* 2.1.2 BELOW THE CLOUD
	3266	C ---------------
	3267	C
	3268	2120 CONTINUE
	3269	C
	3270	DO 2125 JK=1,JCLOUD
	3271	JKP1=JK+1
	3272	DO 2121 JL = 1, KDLON
	3273	ZFD(JL)=0.
	3274	2121 CONTINUE
	3275	C
	3276	IF (JK .LT. JCLOUD) THEN
	3277	DO 2123 JKJ=JKP1,JCLOUD
	3278	DO 2122 JL = 1, KDLON
	3279	ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ)
	3280	2122 CONTINUE
	3281	2123 CONTINUE
	3282	END IF
	3283	DO 2124 JL = 1, KDLON
	3284	ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL)
	3285	2124 CONTINUE
	3286	2125 CONTINUE
	3287	C
	3288	213 CONTINUE
	3289	C
	3290	C
	3291	C* 2.2 CLOUD COVER MATRIX
	3292	C ------------------
	3293	C
	3294	C* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
	3295	C HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
	3296	C
	3297	220 CONTINUE
	3298	C
	3299	DO 223 JK1 = 1 , KFLEV+1
	3300	DO 222 JK2 = 1 , KFLEV+1
	3301	DO 221 JL = 1, KDLON
	3302	ZCLM(JL,JK1,JK2) = 0.
	3303	221 CONTINUE
	3304	222 CONTINUE
	3305	223 CONTINUE
	3306	C
	3307	C
	3308	C
	3309	C* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION
	3310	C ------------------------------------------
	3311	C
	3312	240 CONTINUE
	3313	C
	3314	DO 244 JK1 = 2 , KFLEV+1
	3315	DO 241 JL = 1, KDLON
	3316	ZCLEAR(JL)=1.
	3317	ZCLOUD(JL)=0.
	3318	241 CONTINUE
	3319	DO 243 JK = JK1 - 1 , 1 , -1
	3320	DO 242 JL = 1, KDLON
	3321	IF (NOVLP.EQ.1) THEN
	3322	c* maximum-random
	3323	ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))
	3324	* /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
	3325	ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
	3326	ZCLOUD(JL) = PCLDLU(JL,JK)
	3327	ELSE IF (NOVLP.EQ.2) THEN
	3328	c* maximum
	3329	ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK))
	3330	ZCLM(JL,JK1,JK) = ZCLOUD(JL)
	3331	ELSE IF (NOVLP.EQ.3) THEN
	3332	c* random
	3333	ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLU(JL,JK))
	3334	ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
	3335	ZCLM(JL,JK1,JK) = ZCLOUD(JL)
	3336	END IF
	3337	242 CONTINUE
	3338	243 CONTINUE
	3339	244 CONTINUE
	3340	C
	3341	C
	3342	C* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
	3343	C ------------------------------------------
	3344	C
	3345	250 CONTINUE
	3346	C
	3347	DO 254 JK1 = 1 , KFLEV
	3348	DO 251 JL = 1, KDLON
	3349	ZCLEAR(JL)=1.
	3350	ZCLOUD(JL)=0.
	3351	251 CONTINUE
	3352	DO 253 JK = JK1 , KFLEV
	3353	DO 252 JL = 1, KDLON
	3354	IF (NOVLP.EQ.1) THEN
	3355	c* maximum-random
	3356	ZCLEAR(JL)=ZCLEAR(JL)*(1.0-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))
	3357	* /(1.0-MIN(ZCLOUD(JL),1.-ZEPSEC))
	3358	ZCLM(JL,JK1,JK) = 1.0 - ZCLEAR(JL)
	3359	ZCLOUD(JL) = PCLDLD(JL,JK)
	3360	ELSE IF (NOVLP.EQ.2) THEN
	3361	c* maximum
	3362	ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK))
	3363	ZCLM(JL,JK1,JK) = ZCLOUD(JL)
	3364	ELSE IF (NOVLP.EQ.3) THEN
	3365	c* random
	3366	ZCLEAR(JL) = ZCLEAR(JL)*(1.0 - PCLDLD(JL,JK))
	3367	ZCLOUD(JL) = 1.0 - ZCLEAR(JL)
	3368	ZCLM(JL,JK1,JK) = ZCLOUD(JL)
	3369	END IF
	3370	252 CONTINUE
	3371	253 CONTINUE
	3372	254 CONTINUE
	3373	C
	3374	C
	3375	C
	3376	C* 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
	3377	C ----------------------------------------------
	3378	C
	3379	300 CONTINUE
	3380	C
	3381	C* 3.1 DOWNWARD FLUXES
	3382	C ---------------
	3383	C
	3384	310 CONTINUE
	3385	C
	3386	DO 311 JL = 1, KDLON
	3387	PFLUX(JL,2,KFLEV+1) = 0.
	3388	311 CONTINUE
	3389	C
	3390	DO 317 JK1 = KFLEV , 1 , -1
	3391	C
	3392	C* CONTRIBUTION FROM CLEAR-SKY FRACTION
	3393	C
	3394	DO 312 JL = 1, KDLON
	3395	ZFD (JL) = (1. - ZCLM(JL,JK1,KFLEV)) * ZDNF(JL,1,JK1)
	3396	312 CONTINUE
	3397	C
	3398	C* CONTRIBUTION FROM ADJACENT CLOUD
	3399	C
	3400	DO 313 JL = 1, KDLON
	3401	ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1)
	3402	313 CONTINUE
	3403	C
	3404	C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
	3405	C
	3406	DO 315 JK = KFLEV-1 , JK1 , -1
	3407	DO 314 JL = 1, KDLON
	3408	ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK)
	3409	ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1)
	3410	314 CONTINUE
	3411	315 CONTINUE
	3412	C
	3413	DO 316 JL = 1, KDLON
	3414	PFLUX(JL,2,JK1) = ZFD (JL)
	3415	316 CONTINUE
	3416	C
	3417	317 CONTINUE
	3418	C
	3419	C
	3420	C
	3421	C
	3422	C* 3.2 UPWARD FLUX AT THE SURFACE
	3423	C --------------------------
	3424	C
	3425	320 CONTINUE
	3426	C
	3427	DO 321 JL = 1, KDLON
	3428	PFLUX(JL,1,1) = PEMIS(JL)PBSUIN(JL)-(1.-PEMIS(JL))PFLUX(JL,2,1)
	3429	321 CONTINUE
	3430	C
	3431	C
	3432	C
	3433	C* 3.3 UPWARD FLUXES
	3434	C -------------
	3435	C
	3436	330 CONTINUE
	3437	C
	3438	DO 337 JK1 = 2 , KFLEV+1
	3439	C
	3440	C* CONTRIBUTION FROM CLEAR-SKY FRACTION
	3441	C
	3442	DO 332 JL = 1, KDLON
	3443	ZFU (JL) = (1. - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1)
	3444	332 CONTINUE
	3445	C
	3446	C* CONTRIBUTION FROM ADJACENT CLOUD
	3447	C
	3448	DO 333 JL = 1, KDLON
	3449	ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1)
	3450	333 CONTINUE
	3451	C
	3452	C* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
	3453	C
	3454	DO 335 JK = 2 , JK1-1
	3455	DO 334 JL = 1, KDLON
	3456	ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK)
	3457	ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1)
	3458	334 CONTINUE
	3459	335 CONTINUE
	3460	C
	3461	DO 336 JL = 1, KDLON
	3462	PFLUX(JL,1,JK1) = ZFU (JL)
	3463	336 CONTINUE
	3464	C
	3465	337 CONTINUE
	3466	C
	3467	C
	3468	END IF
	3469	C
	3470	C
	3471	C* 2.3 END OF CLOUD EFFECT COMPUTATIONS
	3472	C
	3473	230 CONTINUE
	3474	C
	3475	IF (.NOT.LEVOIGT) THEN
	3476	DO 231 JL = 1, KDLON
	3477	ZFN10(JL) = PFLUX(JL,1,KLIM) + PFLUX(JL,2,KLIM)
	3478	231 CONTINUE
	3479	DO 233 JK = KLIM+1 , KFLEV+1
	3480	DO 232 JL = 1, KDLON
	3481	ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1)
	3482	PFLUX(JL,1,JK) = ZFN10(JL)
	3483	PFLUX(JL,2,JK) = 0.0
	3484	232 CONTINUE
	3485	233 CONTINUE
	3486	ENDIF
	3487	C
	3488	RETURN
	3489	END
	3490	SUBROUTINE LWB(PDT0,PTAVE,PTL
	3491	S , PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL
	3492	S , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP)
	3493	IMPLICIT none
	3494	#include "dimensions.h"
	3495	#include "dimphy.h"
	3496	#include "raddim.h"
	3497	#include "raddimlw.h"
	3498	C
	3499	C-----------------------------------------------------------------------
	3500	C PURPOSE.
	3501	C --------
	3502	C COMPUTES PLANCK FUNCTIONS
	3503	C
	3504	C EXPLICIT ARGUMENTS :
	3505	C --------------------
	3506	C ==== INPUTS ===
	3507	C PDT0 : (KDLON) ; SURFACE TEMPERATURE DISCONTINUITY
	3508	C PTAVE : (KDLON,KFLEV) ; TEMPERATURE
	3509	C PTL : (KDLON,0:KFLEV) ; HALF LEVEL TEMPERATURE
	3510	C ==== OUTPUTS ===
	3511	C PB : (KDLON,Ninter,KFLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION
	3512	C PBINT : (KDLON,KFLEV+1) ; HALF LEVEL PLANCK FUNCTION
	3513	C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION
	3514	C PBSUR : (KDLON,Ninter) ; SURFACE SPECTRAL PLANCK FUNCTION
	3515	C PBTOP : (KDLON,Ninter) ; TOP SPECTRAL PLANCK FUNCTION
	3516	C PDBSL : (KDLON,Ninter,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT
	3517	C PGA : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
	3518	C PGB : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
	3519	C PGASUR, PGBSUR (KDLON,8,2) ; SURFACE PADE APPROXIMANTS
	3520	C PGATOP, PGBTOP (KDLON,8,2) ; T.O.A. PADE APPROXIMANTS
	3521	C
	3522	C IMPLICIT ARGUMENTS : NONE
	3523	C --------------------
	3524	C
	3525	C METHOD.
	3526	C -------
	3527	C
	3528	C 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS
	3529	C FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION
	3530	C
	3531	C REFERENCE.
	3532	C ----------
	3533	C
	3534	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	3535	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS "
	3536	C
	3537	C AUTHOR.
	3538	C -------
	3539	C JEAN-JACQUES MORCRETTE ECMWF
	3540	C
	3541	C MODIFICATIONS.
	3542	C --------------
	3543	C ORIGINAL : 89-07-14
	3544	C
	3545	C-----------------------------------------------------------------------
	3546	C
	3547	C ARGUMENTS:
	3548	C
	3549	REAL*8 PDT0(KDLON)
	3550	REAL*8 PTAVE(KDLON,KFLEV)
	3551	REAL*8 PTL(KDLON,KFLEV+1)
	3552	C
	3553	REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION
	3554	REAL*8 PBINT(KDLON,KFLEV+1) ! HALF LEVEL PLANCK FUNCTION
	3555	REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
	3556	REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
	3557	REAL*8 PBTOP(KDLON,Ninter) ! TOP SPECTRAL PLANCK FUNCTION
	3558	REAL8 PDBSL(KDLON,Ninter,KFLEV2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
	3559	REAL*8 PGA(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
	3560	REAL*8 PGB(KDLON,8,2,KFLEV) ! dB/dT-weighted LAYER PADE APPROXIMANTS
	3561	REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
	3562	REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
	3563	REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
	3564	REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
	3565	C
	3566	C-------------------------------------------------------------------------
	3567	C* LOCAL VARIABLES:
	3568	INTEGER INDB(KDLON),INDS(KDLON)
	3569	REAL*8 ZBLAY(KDLON,KFLEV),ZBLEV(KDLON,KFLEV+1)
	3570	REAL*8 ZRES(KDLON),ZRES2(KDLON),ZTI(KDLON),ZTI2(KDLON)
	3571	c
	3572	INTEGER jk, jl, ic, jnu, jf, jg
	3573	INTEGER jk1, jk2
	3574	INTEGER k, j, ixtox, indto, ixtx, indt
	3575	INTEGER indsu, indtp
	3576	REAL*8 zdsto1, zdstox, zdst1, zdstx
	3577	c
	3578	C* Quelques parametres:
	3579	REAL*8 TSTAND
	3580	PARAMETER (TSTAND=250.0)
	3581	REAL*8 TSTP
	3582	PARAMETER (TSTP=12.5)
	3583	INTEGER MXIXT
	3584	PARAMETER (MXIXT=10)
	3585	C
	3586	C* Used Data Block:
	3587	REAL*8 TINTP(11)
	3588	SAVE TINTP
	3589	REAL*8 GA(11,16,3), GB(11,16,3)
	3590	SAVE GA, GB
	3591	REAL*8 XP(6,6)
	3592	SAVE XP
	3593	c
	3594	DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250.,
	3595	S 262.5, 275., 287.5, 300., 312.5 /
	3596	C-----------------------------------------------------------------------
	3597	C-- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ----------------
	3598	C
	3599	C
	3600	C
	3601	C
	3602	C-- R.D. -- G = - 0.2 SLA
	3603	C
	3604	C
	3605	C----- INTERVAL = 1 ----- T = 187.5
	3606	C
	3607	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3608	DATA (GA( 1, 1,IC),IC=1,3) /
	3609	S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/
	3610	DATA (GB( 1, 1,IC),IC=1,3) /
	3611	S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/
	3612	DATA (GA( 1, 2,IC),IC=1,3) /
	3613	S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/
	3614	DATA (GB( 1, 2,IC),IC=1,3) /
	3615	S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/
	3616	C
	3617	C----- INTERVAL = 1 ----- T = 200.0
	3618	C
	3619	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3620	DATA (GA( 2, 1,IC),IC=1,3) /
	3621	S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/
	3622	DATA (GB( 2, 1,IC),IC=1,3) /
	3623	S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/
	3624	DATA (GA( 2, 2,IC),IC=1,3) /
	3625	S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/
	3626	DATA (GB( 2, 2,IC),IC=1,3) /
	3627	S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/
	3628	C
	3629	C----- INTERVAL = 1 ----- T = 212.5
	3630	C
	3631	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3632	DATA (GA( 3, 1,IC),IC=1,3) /
	3633	S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/
	3634	DATA (GB( 3, 1,IC),IC=1,3) /
	3635	S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/
	3636	DATA (GA( 3, 2,IC),IC=1,3) /
	3637	S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/
	3638	DATA (GB( 3, 2,IC),IC=1,3) /
	3639	S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/
	3640	C
	3641	C----- INTERVAL = 1 ----- T = 225.0
	3642	C
	3643	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3644	DATA (GA( 4, 1,IC),IC=1,3) /
	3645	S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/
	3646	DATA (GB( 4, 1,IC),IC=1,3) /
	3647	S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/
	3648	DATA (GA( 4, 2,IC),IC=1,3) /
	3649	S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/
	3650	DATA (GB( 4, 2,IC),IC=1,3) /
	3651	S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/
	3652	C
	3653	C----- INTERVAL = 1 ----- T = 237.5
	3654	C
	3655	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3656	DATA (GA( 5, 1,IC),IC=1,3) /
	3657	S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/
	3658	DATA (GB( 5, 1,IC),IC=1,3) /
	3659	S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/
	3660	DATA (GA( 5, 2,IC),IC=1,3) /
	3661	S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/
	3662	DATA (GB( 5, 2,IC),IC=1,3) /
	3663	S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/
	3664	C
	3665	C----- INTERVAL = 1 ----- T = 250.0
	3666	C
	3667	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3668	DATA (GA( 6, 1,IC),IC=1,3) /
	3669	S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/
	3670	DATA (GB( 6, 1,IC),IC=1,3) /
	3671	S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/
	3672	DATA (GA( 6, 2,IC),IC=1,3) /
	3673	S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/
	3674	DATA (GB( 6, 2,IC),IC=1,3) /
	3675	S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/
	3676	C
	3677	C----- INTERVAL = 1 ----- T = 262.5
	3678	C
	3679	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3680	DATA (GA( 7, 1,IC),IC=1,3) /
	3681	S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/
	3682	DATA (GB( 7, 1,IC),IC=1,3) /
	3683	S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/
	3684	DATA (GA( 7, 2,IC),IC=1,3) /
	3685	S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/
	3686	DATA (GB( 7, 2,IC),IC=1,3) /
	3687	S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/
	3688	C
	3689	C----- INTERVAL = 1 ----- T = 275.0
	3690	C
	3691	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3692	DATA (GA( 8, 1,IC),IC=1,3) /
	3693	S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/
	3694	DATA (GB( 8, 1,IC),IC=1,3) /
	3695	S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/
	3696	DATA (GA( 8, 2,IC),IC=1,3) /
	3697	S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/
	3698	DATA (GB( 8, 2,IC),IC=1,3) /
	3699	S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/
	3700	C
	3701	C----- INTERVAL = 1 ----- T = 287.5
	3702	C
	3703	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3704	DATA (GA( 9, 1,IC),IC=1,3) /
	3705	S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/
	3706	DATA (GB( 9, 1,IC),IC=1,3) /
	3707	S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/
	3708	DATA (GA( 9, 2,IC),IC=1,3) /
	3709	S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/
	3710	DATA (GB( 9, 2,IC),IC=1,3) /
	3711	S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/
	3712	C
	3713	C----- INTERVAL = 1 ----- T = 300.0
	3714	C
	3715	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3716	DATA (GA(10, 1,IC),IC=1,3) /
	3717	S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/
	3718	DATA (GB(10, 1,IC),IC=1,3) /
	3719	S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/
	3720	DATA (GA(10, 2,IC),IC=1,3) /
	3721	S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/
	3722	DATA (GB(10, 2,IC),IC=1,3) /
	3723	S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/
	3724	C
	3725	C----- INTERVAL = 1 ----- T = 312.5
	3726	C
	3727	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3728	DATA (GA(11, 1,IC),IC=1,3) /
	3729	S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/
	3730	DATA (GB(11, 1,IC),IC=1,3) /
	3731	S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/
	3732	DATA (GA(11, 2,IC),IC=1,3) /
	3733	S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/
	3734	DATA (GB(11, 2,IC),IC=1,3) /
	3735	S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/
	3736	C
	3737	C
	3738	C
	3739	C--- WATER VAPOR --- INTERVAL 2 -- 500-800 CM-1--- FROM ABS225 ---------
	3740	C
	3741	C
	3742	C
	3743	C
	3744	C--- R.D. --- G = 0.02 + 0.50 / ( 1 + 4.5 U )
	3745	C
	3746	C
	3747	C----- INTERVAL = 2 ----- T = 187.5
	3748	C
	3749	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3750	DATA (GA( 1, 3,IC),IC=1,3) /
	3751	S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/
	3752	DATA (GB( 1, 3,IC),IC=1,3) /
	3753	S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/
	3754	DATA (GA( 1, 4,IC),IC=1,3) /
	3755	S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/
	3756	DATA (GB( 1, 4,IC),IC=1,3) /
	3757	S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/
	3758	C
	3759	C----- INTERVAL = 2 ----- T = 200.0
	3760	C
	3761	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3762	DATA (GA( 2, 3,IC),IC=1,3) /
	3763	S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/
	3764	DATA (GB( 2, 3,IC),IC=1,3) /
	3765	S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/
	3766	DATA (GA( 2, 4,IC),IC=1,3) /
	3767	S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/
	3768	DATA (GB( 2, 4,IC),IC=1,3) /
	3769	S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/
	3770	C
	3771	C----- INTERVAL = 2 ----- T = 212.5
	3772	C
	3773	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3774	DATA (GA( 3, 3,IC),IC=1,3) /
	3775	S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/
	3776	DATA (GB( 3, 3,IC),IC=1,3) /
	3777	S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/
	3778	DATA (GA( 3, 4,IC),IC=1,3) /
	3779	S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/
	3780	DATA (GB( 3, 4,IC),IC=1,3) /
	3781	S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/
	3782	C
	3783	C----- INTERVAL = 2 ----- T = 225.0
	3784	C
	3785	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3786	DATA (GA( 4, 3,IC),IC=1,3) /
	3787	S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/
	3788	DATA (GB( 4, 3,IC),IC=1,3) /
	3789	S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/
	3790	DATA (GA( 4, 4,IC),IC=1,3) /
	3791	S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/
	3792	DATA (GB( 4, 4,IC),IC=1,3) /
	3793	S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/
	3794	C
	3795	C----- INTERVAL = 2 ----- T = 237.5
	3796	C
	3797	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3798	DATA (GA( 5, 3,IC),IC=1,3) /
	3799	S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/
	3800	DATA (GB( 5, 3,IC),IC=1,3) /
	3801	S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/
	3802	DATA (GA( 5, 4,IC),IC=1,3) /
	3803	S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/
	3804	DATA (GB( 5, 4,IC),IC=1,3) /
	3805	S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/
	3806	C
	3807	C----- INTERVAL = 2 ----- T = 250.0
	3808	C
	3809	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3810	DATA (GA( 6, 3,IC),IC=1,3) /
	3811	S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/
	3812	DATA (GB( 6, 3,IC),IC=1,3) /
	3813	S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/
	3814	DATA (GA( 6, 4,IC),IC=1,3) /
	3815	S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/
	3816	DATA (GB( 6, 4,IC),IC=1,3) /
	3817	S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/
	3818	C
	3819	C----- INTERVAL = 2 ----- T = 262.5
	3820	C
	3821	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3822	DATA (GA( 7, 3,IC),IC=1,3) /
	3823	S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/
	3824	DATA (GB( 7, 3,IC),IC=1,3) /
	3825	S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/
	3826	DATA (GA( 7, 4,IC),IC=1,3) /
	3827	S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/
	3828	DATA (GB( 7, 4,IC),IC=1,3) /
	3829	S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/
	3830	C
	3831	C----- INTERVAL = 2 ----- T = 275.0
	3832	C
	3833	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3834	DATA (GA( 8, 3,IC),IC=1,3) /
	3835	S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/
	3836	DATA (GB( 8, 3,IC),IC=1,3) /
	3837	S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/
	3838	DATA (GA( 8, 4,IC),IC=1,3) /
	3839	S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/
	3840	DATA (GB( 8, 4,IC),IC=1,3) /
	3841	S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/
	3842	C
	3843	C----- INTERVAL = 2 ----- T = 287.5
	3844	C
	3845	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3846	DATA (GA( 9, 3,IC),IC=1,3) /
	3847	S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/
	3848	DATA (GB( 9, 3,IC),IC=1,3) /
	3849	S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/
	3850	DATA (GA( 9, 4,IC),IC=1,3) /
	3851	S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/
	3852	DATA (GB( 9, 4,IC),IC=1,3) /
	3853	S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/
	3854	C
	3855	C----- INTERVAL = 2 ----- T = 300.0
	3856	C
	3857	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3858	DATA (GA(10, 3,IC),IC=1,3) /
	3859	S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/
	3860	DATA (GB(10, 3,IC),IC=1,3) /
	3861	S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/
	3862	DATA (GA(10, 4,IC),IC=1,3) /
	3863	S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/
	3864	DATA (GB(10, 4,IC),IC=1,3) /
	3865	S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/
	3866	C
	3867	C----- INTERVAL = 2 ----- T = 312.5
	3868	C
	3869	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3870	DATA (GA(11, 3,IC),IC=1,3) /
	3871	S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/
	3872	DATA (GB(11, 3,IC),IC=1,3) /
	3873	S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/
	3874	DATA (GA(11, 4,IC),IC=1,3) /
	3875	S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/
	3876	DATA (GB(11, 4,IC),IC=1,3) /
	3877	S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/
	3878	C
	3879	C
	3880	C
	3881	C
	3882	C
	3883	C
	3884	C- WATER VAPOR - INT. 3 -- 800-970 + 1110-1250 CM-1 -- FIT FROM 215 IS -
	3885	C
	3886	C
	3887	C-- WATER VAPOR LINES IN THE WINDOW REGION (800-1250 CM-1)
	3888	C
	3889	C
	3890	C
	3891	C--- G = 3.875E-03 ---------------
	3892	C
	3893	C----- INTERVAL = 3 ----- T = 187.5
	3894	C
	3895	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3896	DATA (GA( 1, 7,IC),IC=1,3) /
	3897	S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/
	3898	DATA (GB( 1, 7,IC),IC=1,3) /
	3899	S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/
	3900	DATA (GA( 1, 8,IC),IC=1,3) /
	3901	S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/
	3902	DATA (GB( 1, 8,IC),IC=1,3) /
	3903	S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/
	3904	C
	3905	C----- INTERVAL = 3 ----- T = 200.0
	3906	C
	3907	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3908	DATA (GA( 2, 7,IC),IC=1,3) /
	3909	S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/
	3910	DATA (GB( 2, 7,IC),IC=1,3) /
	3911	S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/
	3912	DATA (GA( 2, 8,IC),IC=1,3) /
	3913	S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/
	3914	DATA (GB( 2, 8,IC),IC=1,3) /
	3915	S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/
	3916	C
	3917	C----- INTERVAL = 3 ----- T = 212.5
	3918	C
	3919	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3920	DATA (GA( 3, 7,IC),IC=1,3) /
	3921	S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/
	3922	DATA (GB( 3, 7,IC),IC=1,3) /
	3923	S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/
	3924	DATA (GA( 3, 8,IC),IC=1,3) /
	3925	S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/
	3926	DATA (GB( 3, 8,IC),IC=1,3) /
	3927	S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/
	3928	C
	3929	C----- INTERVAL = 3 ----- T = 225.0
	3930	C
	3931	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3932	DATA (GA( 4, 7,IC),IC=1,3) /
	3933	S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/
	3934	DATA (GB( 4, 7,IC),IC=1,3) /
	3935	S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/
	3936	DATA (GA( 4, 8,IC),IC=1,3) /
	3937	S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/
	3938	DATA (GB( 4, 8,IC),IC=1,3) /
	3939	S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/
	3940	C
	3941	C----- INTERVAL = 3 ----- T = 237.5
	3942	C
	3943	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3944	DATA (GA( 5, 7,IC),IC=1,3) /
	3945	S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/
	3946	DATA (GB( 5, 7,IC),IC=1,3) /
	3947	S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/
	3948	DATA (GA( 5, 8,IC),IC=1,3) /
	3949	S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/
	3950	DATA (GB( 5, 8,IC),IC=1,3) /
	3951	S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/
	3952	C
	3953	C----- INTERVAL = 3 ----- T = 250.0
	3954	C
	3955	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3956	DATA (GA( 6, 7,IC),IC=1,3) /
	3957	S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/
	3958	DATA (GB( 6, 7,IC),IC=1,3) /
	3959	S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/
	3960	DATA (GA( 6, 8,IC),IC=1,3) /
	3961	S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/
	3962	DATA (GB( 6, 8,IC),IC=1,3) /
	3963	S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/
	3964	C
	3965	C----- INTERVAL = 3 ----- T = 262.5
	3966	C
	3967	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3968	DATA (GA( 7, 7,IC),IC=1,3) /
	3969	S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/
	3970	DATA (GB( 7, 7,IC),IC=1,3) /
	3971	S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/
	3972	DATA (GA( 7, 8,IC),IC=1,3) /
	3973	S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/
	3974	DATA (GB( 7, 8,IC),IC=1,3) /
	3975	S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/
	3976	C
	3977	C----- INTERVAL = 3 ----- T = 275.0
	3978	C
	3979	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3980	DATA (GA( 8, 7,IC),IC=1,3) /
	3981	S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/
	3982	DATA (GB( 8, 7,IC),IC=1,3) /
	3983	S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/
	3984	DATA (GA( 8, 8,IC),IC=1,3) /
	3985	S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/
	3986	DATA (GB( 8, 8,IC),IC=1,3) /
	3987	S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/
	3988	C
	3989	C----- INTERVAL = 3 ----- T = 287.5
	3990	C
	3991	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3992	DATA (GA( 9, 7,IC),IC=1,3) /
	3993	S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/
	3994	DATA (GB( 9, 7,IC),IC=1,3) /
	3995	S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/
	3996	DATA (GA( 9, 8,IC),IC=1,3) /
	3997	S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/
	3998	DATA (GB( 9, 8,IC),IC=1,3) /
	3999	S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/
	4000	C
	4001	C----- INTERVAL = 3 ----- T = 300.0
	4002	C
	4003	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4004	DATA (GA(10, 7,IC),IC=1,3) /
	4005	S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/
	4006	DATA (GB(10, 7,IC),IC=1,3) /
	4007	S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/
	4008	DATA (GA(10, 8,IC),IC=1,3) /
	4009	S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/
	4010	DATA (GB(10, 8,IC),IC=1,3) /
	4011	S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/
	4012	C
	4013	C----- INTERVAL = 3 ----- T = 312.5
	4014	C
	4015	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4016	DATA (GA(11, 7,IC),IC=1,3) /
	4017	S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/
	4018	DATA (GB(11, 7,IC),IC=1,3) /
	4019	S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/
	4020	DATA (GA(11, 8,IC),IC=1,3) /
	4021	S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/
	4022	DATA (GB(11, 8,IC),IC=1,3) /
	4023	S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/
	4024	C
	4025	C
	4026	C-- WATER VAPOR -- 970-1110 CM-1 ----------------------------------------
	4027	C
	4028	C-- G = 3.6E-03
	4029	C
	4030	C----- INTERVAL = 4 ----- T = 187.5
	4031	C
	4032	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4033	DATA (GA( 1, 9,IC),IC=1,3) /
	4034	S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/
	4035	DATA (GB( 1, 9,IC),IC=1,3) /
	4036	S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/
	4037	DATA (GA( 1,10,IC),IC=1,3) /
	4038	S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/
	4039	DATA (GB( 1,10,IC),IC=1,3) /
	4040	S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/
	4041	C
	4042	C----- INTERVAL = 4 ----- T = 200.0
	4043	C
	4044	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4045	DATA (GA( 2, 9,IC),IC=1,3) /
	4046	S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/
	4047	DATA (GB( 2, 9,IC),IC=1,3) /
	4048	S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/
	4049	DATA (GA( 2,10,IC),IC=1,3) /
	4050	S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/
	4051	DATA (GB( 2,10,IC),IC=1,3) /
	4052	S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/
	4053	C
	4054	C----- INTERVAL = 4 ----- T = 212.5
	4055	C
	4056	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4057	DATA (GA( 3, 9,IC),IC=1,3) /
	4058	S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/
	4059	DATA (GB( 3, 9,IC),IC=1,3) /
	4060	S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/
	4061	DATA (GA( 3,10,IC),IC=1,3) /
	4062	S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/
	4063	DATA (GB( 3,10,IC),IC=1,3) /
	4064	S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/
	4065	C
	4066	C----- INTERVAL = 4 ----- T = 225.0
	4067	C
	4068	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4069	DATA (GA( 4, 9,IC),IC=1,3) /
	4070	S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/
	4071	DATA (GB( 4, 9,IC),IC=1,3) /
	4072	S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/
	4073	DATA (GA( 4,10,IC),IC=1,3) /
	4074	S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/
	4075	DATA (GB( 4,10,IC),IC=1,3) /
	4076	S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/
	4077	C
	4078	C----- INTERVAL = 4 ----- T = 237.5
	4079	C
	4080	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4081	DATA (GA( 5, 9,IC),IC=1,3) /
	4082	S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/
	4083	DATA (GB( 5, 9,IC),IC=1,3) /
	4084	S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/
	4085	DATA (GA( 5,10,IC),IC=1,3) /
	4086	S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/
	4087	DATA (GB( 5,10,IC),IC=1,3) /
	4088	S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/
	4089	C
	4090	C----- INTERVAL = 4 ----- T = 250.0
	4091	C
	4092	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4093	DATA (GA( 6, 9,IC),IC=1,3) /
	4094	S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/
	4095	DATA (GB( 6, 9,IC),IC=1,3) /
	4096	S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/
	4097	DATA (GA( 6,10,IC),IC=1,3) /
	4098	S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/
	4099	DATA (GB( 6,10,IC),IC=1,3) /
	4100	S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/
	4101	C
	4102	C----- INTERVAL = 4 ----- T = 262.5
	4103	C
	4104	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4105	DATA (GA( 7, 9,IC),IC=1,3) /
	4106	S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/
	4107	DATA (GB( 7, 9,IC),IC=1,3) /
	4108	S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/
	4109	DATA (GA( 7,10,IC),IC=1,3) /
	4110	S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/
	4111	DATA (GB( 7,10,IC),IC=1,3) /
	4112	S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/
	4113	C
	4114	C----- INTERVAL = 4 ----- T = 275.0
	4115	C
	4116	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4117	DATA (GA( 8, 9,IC),IC=1,3) /
	4118	S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/
	4119	DATA (GB( 8, 9,IC),IC=1,3) /
	4120	S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/
	4121	DATA (GA( 8,10,IC),IC=1,3) /
	4122	S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/
	4123	DATA (GB( 8,10,IC),IC=1,3) /
	4124	S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/
	4125	C
	4126	C----- INTERVAL = 4 ----- T = 287.5
	4127	C
	4128	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4129	DATA (GA( 9, 9,IC),IC=1,3) /
	4130	S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/
	4131	DATA (GB( 9, 9,IC),IC=1,3) /
	4132	S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/
	4133	DATA (GA( 9,10,IC),IC=1,3) /
	4134	S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/
	4135	DATA (GB( 9,10,IC),IC=1,3) /
	4136	S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/
	4137	C
	4138	C----- INTERVAL = 4 ----- T = 300.0
	4139	C
	4140	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4141	DATA (GA(10, 9,IC),IC=1,3) /
	4142	S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/
	4143	DATA (GB(10, 9,IC),IC=1,3) /
	4144	S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/
	4145	DATA (GA(10,10,IC),IC=1,3) /
	4146	S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/
	4147	DATA (GB(10,10,IC),IC=1,3) /
	4148	S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/
	4149	C
	4150	C----- INTERVAL = 4 ----- T = 312.5
	4151	C
	4152	C-- INDICES FOR PADE APPROXIMATION 1 28 37 45
	4153	DATA (GA(11, 9,IC),IC=1,3) /
	4154	S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/
	4155	DATA (GB(11, 9,IC),IC=1,3) /
	4156	S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/
	4157	DATA (GA(11,10,IC),IC=1,3) /
	4158	S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/
	4159	DATA (GB(11,10,IC),IC=1,3) /
	4160	S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/
	4161	C
	4162	C
	4163	C
	4164	C-- H2O -- WEAKER PARTS OF THE STRONG BANDS -- FROM ABS225 ----
	4165	C
	4166	C-- WATER VAPOR --- 350 - 500 CM-1
	4167	C
	4168	C-- G = - 0.2*SLA, 0.0 +0.5/(1+0.5U)
	4169	C
	4170	C----- INTERVAL = 5 ----- T = 187.5
	4171	C
	4172	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4173	DATA (GA( 1, 5,IC),IC=1,3) /
	4174	S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/
	4175	DATA (GB( 1, 5,IC),IC=1,3) /
	4176	S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/
	4177	DATA (GA( 1, 6,IC),IC=1,3) /
	4178	S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/
	4179	DATA (GB( 1, 6,IC),IC=1,3) /
	4180	S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/
	4181	C
	4182	C----- INTERVAL = 5 ----- T = 200.0
	4183	C
	4184	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4185	DATA (GA( 2, 5,IC),IC=1,3) /
	4186	S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/
	4187	DATA (GB( 2, 5,IC),IC=1,3) /
	4188	S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/
	4189	DATA (GA( 2, 6,IC),IC=1,3) /
	4190	S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/
	4191	DATA (GB( 2, 6,IC),IC=1,3) /
	4192	S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/
	4193	C
	4194	C----- INTERVAL = 5 ----- T = 212.5
	4195	C
	4196	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4197	DATA (GA( 3, 5,IC),IC=1,3) /
	4198	S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/
	4199	DATA (GB( 3, 5,IC),IC=1,3) /
	4200	S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/
	4201	DATA (GA( 3, 6,IC),IC=1,3) /
	4202	S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/
	4203	DATA (GB( 3, 6,IC),IC=1,3) /
	4204	S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/
	4205	C
	4206	C----- INTERVAL = 5 ----- T = 225.0
	4207	C
	4208	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4209	DATA (GA( 4, 5,IC),IC=1,3) /
	4210	S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/
	4211	DATA (GB( 4, 5,IC),IC=1,3) /
	4212	S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/
	4213	DATA (GA( 4, 6,IC),IC=1,3) /
	4214	S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/
	4215	DATA (GB( 4, 6,IC),IC=1,3) /
	4216	S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/
	4217	C
	4218	C----- INTERVAL = 5 ----- T = 237.5
	4219	C
	4220	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4221	DATA (GA( 5, 5,IC),IC=1,3) /
	4222	S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/
	4223	DATA (GB( 5, 5,IC),IC=1,3) /
	4224	S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/
	4225	DATA (GA( 5, 6,IC),IC=1,3) /
	4226	S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/
	4227	DATA (GB( 5, 6,IC),IC=1,3) /
	4228	S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/
	4229	C
	4230	C----- INTERVAL = 5 ----- T = 250.0
	4231	C
	4232	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4233	DATA (GA( 6, 5,IC),IC=1,3) /
	4234	S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/
	4235	DATA (GB( 6, 5,IC),IC=1,3) /
	4236	S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/
	4237	DATA (GA( 6, 6,IC),IC=1,3) /
	4238	S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/
	4239	DATA (GB( 6, 6,IC),IC=1,3) /
	4240	S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/
	4241	C
	4242	C----- INTERVAL = 5 ----- T = 262.5
	4243	C
	4244	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4245	DATA (GA( 7, 5,IC),IC=1,3) /
	4246	S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/
	4247	DATA (GB( 7, 5,IC),IC=1,3) /
	4248	S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/
	4249	DATA (GA( 7, 6,IC),IC=1,3) /
	4250	S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/
	4251	DATA (GB( 7, 6,IC),IC=1,3) /
	4252	S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/
	4253	C
	4254	C----- INTERVAL = 5 ----- T = 275.0
	4255	C
	4256	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4257	DATA (GA( 8, 5,IC),IC=1,3) /
	4258	S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/
	4259	DATA (GB( 8, 5,IC),IC=1,3) /
	4260	S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/
	4261	DATA (GA( 8, 6,IC),IC=1,3) /
	4262	S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/
	4263	DATA (GB( 8, 6,IC),IC=1,3) /
	4264	S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/
	4265	C
	4266	C----- INTERVAL = 5 ----- T = 287.5
	4267	C
	4268	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4269	DATA (GA( 9, 5,IC),IC=1,3) /
	4270	S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/
	4271	DATA (GB( 9, 5,IC),IC=1,3) /
	4272	S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/
	4273	DATA (GA( 9, 6,IC),IC=1,3) /
	4274	S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/
	4275	DATA (GB( 9, 6,IC),IC=1,3) /
	4276	S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/
	4277	C
	4278	C----- INTERVAL = 5 ----- T = 300.0
	4279	C
	4280	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4281	DATA (GA(10, 5,IC),IC=1,3) /
	4282	S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/
	4283	DATA (GB(10, 5,IC),IC=1,3) /
	4284	S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/
	4285	DATA (GA(10, 6,IC),IC=1,3) /
	4286	S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/
	4287	DATA (GB(10, 6,IC),IC=1,3) /
	4288	S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/
	4289	C
	4290	C----- INTERVAL = 5 ----- T = 312.5
	4291	C
	4292	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4293	DATA (GA(11, 5,IC),IC=1,3) /
	4294	S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/
	4295	DATA (GB(11, 5,IC),IC=1,3) /
	4296	S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/
	4297	DATA (GA(11, 6,IC),IC=1,3) /
	4298	S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/
	4299	DATA (GB(11, 6,IC),IC=1,3) /
	4300	S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/
	4301	C
	4302	C
	4303	C
	4304	C
	4305	C- WATER VAPOR - WINGS OF VIBRATION-ROTATION BAND - 1250-1450+1880-2820 -
	4306	C--- G = 0.0
	4307	C
	4308	C
	4309	C----- INTERVAL = 6 ----- T = 187.5
	4310	C
	4311	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4312	DATA (GA( 1,11,IC),IC=1,3) /
	4313	S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/
	4314	DATA (GB( 1,11,IC),IC=1,3) /
	4315	S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/
	4316	DATA (GA( 1,12,IC),IC=1,3) /
	4317	S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/
	4318	DATA (GB( 1,12,IC),IC=1,3) /
	4319	S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/
	4320	C
	4321	C----- INTERVAL = 6 ----- T = 200.0
	4322	C
	4323	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4324	DATA (GA( 2,11,IC),IC=1,3) /
	4325	S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/
	4326	DATA (GB( 2,11,IC),IC=1,3) /
	4327	S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/
	4328	DATA (GA( 2,12,IC),IC=1,3) /
	4329	S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/
	4330	DATA (GB( 2,12,IC),IC=1,3) /
	4331	S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/
	4332	C
	4333	C----- INTERVAL = 6 ----- T = 212.5
	4334	C
	4335	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4336	DATA (GA( 3,11,IC),IC=1,3) /
	4337	S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/
	4338	DATA (GB( 3,11,IC),IC=1,3) /
	4339	S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/
	4340	DATA (GA( 3,12,IC),IC=1,3) /
	4341	S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/
	4342	DATA (GB( 3,12,IC),IC=1,3) /
	4343	S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/
	4344	C
	4345	C----- INTERVAL = 6 ----- T = 225.0
	4346	C
	4347	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4348	DATA (GA( 4,11,IC),IC=1,3) /
	4349	S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/
	4350	DATA (GB( 4,11,IC),IC=1,3) /
	4351	S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/
	4352	DATA (GA( 4,12,IC),IC=1,3) /
	4353	S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/
	4354	DATA (GB( 4,12,IC),IC=1,3) /
	4355	S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/
	4356	C
	4357	C----- INTERVAL = 6 ----- T = 237.5
	4358	C
	4359	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4360	DATA (GA( 5,11,IC),IC=1,3) /
	4361	S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/
	4362	DATA (GB( 5,11,IC),IC=1,3) /
	4363	S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/
	4364	DATA (GA( 5,12,IC),IC=1,3) /
	4365	S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/
	4366	DATA (GB( 5,12,IC),IC=1,3) /
	4367	S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/
	4368	C
	4369	C----- INTERVAL = 6 ----- T = 250.0
	4370	C
	4371	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4372	DATA (GA( 6,11,IC),IC=1,3) /
	4373	S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/
	4374	DATA (GB( 6,11,IC),IC=1,3) /
	4375	S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/
	4376	DATA (GA( 6,12,IC),IC=1,3) /
	4377	S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/
	4378	DATA (GB( 6,12,IC),IC=1,3) /
	4379	S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/
	4380	C
	4381	C----- INTERVAL = 6 ----- T = 262.5
	4382	C
	4383	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4384	DATA (GA( 7,11,IC),IC=1,3) /
	4385	S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/
	4386	DATA (GB( 7,11,IC),IC=1,3) /
	4387	S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/
	4388	DATA (GA( 7,12,IC),IC=1,3) /
	4389	S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/
	4390	DATA (GB( 7,12,IC),IC=1,3) /
	4391	S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/
	4392	C
	4393	C----- INTERVAL = 6 ----- T = 275.0
	4394	C
	4395	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4396	DATA (GA( 8,11,IC),IC=1,3) /
	4397	S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/
	4398	DATA (GB( 8,11,IC),IC=1,3) /
	4399	S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/
	4400	DATA (GA( 8,12,IC),IC=1,3) /
	4401	S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/
	4402	DATA (GB( 8,12,IC),IC=1,3) /
	4403	S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/
	4404	C
	4405	C----- INTERVAL = 6 ----- T = 287.5
	4406	C
	4407	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4408	DATA (GA( 9,11,IC),IC=1,3) /
	4409	S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/
	4410	DATA (GB( 9,11,IC),IC=1,3) /
	4411	S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/
	4412	DATA (GA( 9,12,IC),IC=1,3) /
	4413	S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/
	4414	DATA (GB( 9,12,IC),IC=1,3) /
	4415	S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/
	4416	C
	4417	C----- INTERVAL = 6 ----- T = 300.0
	4418	C
	4419	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4420	DATA (GA(10,11,IC),IC=1,3) /
	4421	S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/
	4422	DATA (GB(10,11,IC),IC=1,3) /
	4423	S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/
	4424	DATA (GA(10,12,IC),IC=1,3) /
	4425	S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/
	4426	DATA (GB(10,12,IC),IC=1,3) /
	4427	S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/
	4428	C
	4429	C----- INTERVAL = 6 ----- T = 312.5
	4430	C
	4431	C-- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4432	DATA (GA(11,11,IC),IC=1,3) /
	4433	S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/
	4434	DATA (GB(11,11,IC),IC=1,3) /
	4435	S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/
	4436	DATA (GA(11,12,IC),IC=1,3) /
	4437	S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/
	4438	DATA (GB(11,12,IC),IC=1,3) /
	4439	S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/
	4440	C
	4441	C
	4442	C
	4443	C
	4444	C
	4445	C-- END WATER VAPOR
	4446	C
	4447	C
	4448	C-- CO2 -- INT.2 -- 500-800 CM-1 --- FROM ABS225 ----------------------
	4449	C
	4450	C
	4451	C
	4452	C-- FIU = 0.8 + MAX(0.35,(7-IU)*0.9) , X/T, 9
	4453	C
	4454	C----- INTERVAL = 2 ----- T = 187.5
	4455	C
	4456	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4457	DATA (GA( 1,13,IC),IC=1,3) /
	4458	S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/
	4459	DATA (GB( 1,13,IC),IC=1,3) /
	4460	S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/
	4461	DATA (GA( 1,14,IC),IC=1,3) /
	4462	S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/
	4463	DATA (GB( 1,14,IC),IC=1,3) /
	4464	S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/
	4465	C
	4466	C----- INTERVAL = 2 ----- T = 200.0
	4467	C
	4468	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4469	DATA (GA( 2,13,IC),IC=1,3) /
	4470	S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/
	4471	DATA (GB( 2,13,IC),IC=1,3) /
	4472	S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/
	4473	DATA (GA( 2,14,IC),IC=1,3) /
	4474	S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/
	4475	DATA (GB( 2,14,IC),IC=1,3) /
	4476	S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/
	4477	C
	4478	C----- INTERVAL = 2 ----- T = 212.5
	4479	C
	4480	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4481	DATA (GA( 3,13,IC),IC=1,3) /
	4482	S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/
	4483	DATA (GB( 3,13,IC),IC=1,3) /
	4484	S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/
	4485	DATA (GA( 3,14,IC),IC=1,3) /
	4486	S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/
	4487	DATA (GB( 3,14,IC),IC=1,3) /
	4488	S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/
	4489	C
	4490	C----- INTERVAL = 2 ----- T = 225.0
	4491	C
	4492	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4493	DATA (GA( 4,13,IC),IC=1,3) /
	4494	S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/
	4495	DATA (GB( 4,13,IC),IC=1,3) /
	4496	S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/
	4497	DATA (GA( 4,14,IC),IC=1,3) /
	4498	S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/
	4499	DATA (GB( 4,14,IC),IC=1,3) /
	4500	S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/
	4501	C
	4502	C----- INTERVAL = 2 ----- T = 237.5
	4503	C
	4504	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4505	DATA (GA( 5,13,IC),IC=1,3) /
	4506	S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/
	4507	DATA (GB( 5,13,IC),IC=1,3) /
	4508	S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/
	4509	DATA (GA( 5,14,IC),IC=1,3) /
	4510	S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/
	4511	DATA (GB( 5,14,IC),IC=1,3) /
	4512	S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/
	4513	C
	4514	C----- INTERVAL = 2 ----- T = 250.0
	4515	C
	4516	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4517	DATA (GA( 6,13,IC),IC=1,3) /
	4518	S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/
	4519	DATA (GB( 6,13,IC),IC=1,3) /
	4520	S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/
	4521	DATA (GA( 6,14,IC),IC=1,3) /
	4522	S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/
	4523	DATA (GB( 6,14,IC),IC=1,3) /
	4524	S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/
	4525	C
	4526	C----- INTERVAL = 2 ----- T = 262.5
	4527	C
	4528	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4529	DATA (GA( 7,13,IC),IC=1,3) /
	4530	S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/
	4531	DATA (GB( 7,13,IC),IC=1,3) /
	4532	S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/
	4533	DATA (GA( 7,14,IC),IC=1,3) /
	4534	S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/
	4535	DATA (GB( 7,14,IC),IC=1,3) /
	4536	S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/
	4537	C
	4538	C----- INTERVAL = 2 ----- T = 275.0
	4539	C
	4540	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4541	DATA (GA( 8,13,IC),IC=1,3) /
	4542	S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/
	4543	DATA (GB( 8,13,IC),IC=1,3) /
	4544	S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/
	4545	DATA (GA( 8,14,IC),IC=1,3) /
	4546	S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/
	4547	DATA (GB( 8,14,IC),IC=1,3) /
	4548	S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/
	4549	C
	4550	C----- INTERVAL = 2 ----- T = 287.5
	4551	C
	4552	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4553	DATA (GA( 9,13,IC),IC=1,3) /
	4554	S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/
	4555	DATA (GB( 9,13,IC),IC=1,3) /
	4556	S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/
	4557	DATA (GA( 9,14,IC),IC=1,3) /
	4558	S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/
	4559	DATA (GB( 9,14,IC),IC=1,3) /
	4560	S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/
	4561	C
	4562	C----- INTERVAL = 2 ----- T = 300.0
	4563	C
	4564	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4565	DATA (GA(10,13,IC),IC=1,3) /
	4566	S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/
	4567	DATA (GB(10,13,IC),IC=1,3) /
	4568	S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/
	4569	DATA (GA(10,14,IC),IC=1,3) /
	4570	S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/
	4571	DATA (GB(10,14,IC),IC=1,3) /
	4572	S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/
	4573	C
	4574	C----- INTERVAL = 2 ----- T = 312.5
	4575	C
	4576	C-- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4577	DATA (GA(11,13,IC),IC=1,3) /
	4578	S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/
	4579	DATA (GB(11,13,IC),IC=1,3) /
	4580	S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/
	4581	DATA (GA(11,14,IC),IC=1,3) /
	4582	S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/
	4583	DATA (GB(11,14,IC),IC=1,3) /
	4584	S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/
	4585	C
	4586	C
	4587	C
	4588	C
	4589	C
	4590	C
	4591	C
	4592	C
	4593	C
	4594	C
	4595	C-- CARBON DIOXIDE LINES IN THE WINDOW REGION (800-1250 CM-1)
	4596	C
	4597	C
	4598	C-- G = 0.0
	4599	C
	4600	C
	4601	C----- INTERVAL = 4 ----- T = 187.5
	4602	C
	4603	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4604	DATA (GA( 1,15,IC),IC=1,3) /
	4605	S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/
	4606	DATA (GB( 1,15,IC),IC=1,3) /
	4607	S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/
	4608	DATA (GA( 1,16,IC),IC=1,3) /
	4609	S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/
	4610	DATA (GB( 1,16,IC),IC=1,3) /
	4611	S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/
	4612	C
	4613	C----- INTERVAL = 4 ----- T = 200.0
	4614	C
	4615	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4616	DATA (GA( 2,15,IC),IC=1,3) /
	4617	S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/
	4618	DATA (GB( 2,15,IC),IC=1,3) /
	4619	S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/
	4620	DATA (GA( 2,16,IC),IC=1,3) /
	4621	S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/
	4622	DATA (GB( 2,16,IC),IC=1,3) /
	4623	S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/
	4624	C
	4625	C----- INTERVAL = 4 ----- T = 212.5
	4626	C
	4627	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4628	DATA (GA( 3,15,IC),IC=1,3) /
	4629	S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/
	4630	DATA (GB( 3,15,IC),IC=1,3) /
	4631	S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/
	4632	DATA (GA( 3,16,IC),IC=1,3) /
	4633	S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/
	4634	DATA (GB( 3,16,IC),IC=1,3) /
	4635	S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/
	4636	C
	4637	C----- INTERVAL = 4 ----- T = 225.0
	4638	C
	4639	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4640	DATA (GA( 4,15,IC),IC=1,3) /
	4641	S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/
	4642	DATA (GB( 4,15,IC),IC=1,3) /
	4643	S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/
	4644	DATA (GA( 4,16,IC),IC=1,3) /
	4645	S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/
	4646	DATA (GB( 4,16,IC),IC=1,3) /
	4647	S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/
	4648	C
	4649	C----- INTERVAL = 4 ----- T = 237.5
	4650	C
	4651	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4652	DATA (GA( 5,15,IC),IC=1,3) /
	4653	S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/
	4654	DATA (GB( 5,15,IC),IC=1,3) /
	4655	S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/
	4656	DATA (GA( 5,16,IC),IC=1,3) /
	4657	S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/
	4658	DATA (GB( 5,16,IC),IC=1,3) /
	4659	S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/
	4660	C
	4661	C----- INTERVAL = 4 ----- T = 250.0
	4662	C
	4663	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4664	DATA (GA( 6,15,IC),IC=1,3) /
	4665	S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/
	4666	DATA (GB( 6,15,IC),IC=1,3) /
	4667	S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/
	4668	DATA (GA( 6,16,IC),IC=1,3) /
	4669	S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/
	4670	DATA (GB( 6,16,IC),IC=1,3) /
	4671	S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/
	4672	C
	4673	C----- INTERVAL = 4 ----- T = 262.5
	4674	C
	4675	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4676	DATA (GA( 7,15,IC),IC=1,3) /
	4677	S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/
	4678	DATA (GB( 7,15,IC),IC=1,3) /
	4679	S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/
	4680	DATA (GA( 7,16,IC),IC=1,3) /
	4681	S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/
	4682	DATA (GB( 7,16,IC),IC=1,3) /
	4683	S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/
	4684	C
	4685	C----- INTERVAL = 4 ----- T = 275.0
	4686	C
	4687	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4688	DATA (GA( 8,15,IC),IC=1,3) /
	4689	S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/
	4690	DATA (GB( 8,15,IC),IC=1,3) /
	4691	S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/
	4692	DATA (GA( 8,16,IC),IC=1,3) /
	4693	S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/
	4694	DATA (GB( 8,16,IC),IC=1,3) /
	4695	S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/
	4696	C
	4697	C----- INTERVAL = 4 ----- T = 287.5
	4698	C
	4699	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4700	DATA (GA( 9,15,IC),IC=1,3) /
	4701	S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/
	4702	DATA (GB( 9,15,IC),IC=1,3) /
	4703	S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/
	4704	DATA (GA( 9,16,IC),IC=1,3) /
	4705	S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/
	4706	DATA (GB( 9,16,IC),IC=1,3) /
	4707	S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/
	4708	C
	4709	C----- INTERVAL = 4 ----- T = 300.0
	4710	C
	4711	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4712	DATA (GA(10,15,IC),IC=1,3) /
	4713	S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/
	4714	DATA (GB(10,15,IC),IC=1,3) /
	4715	S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/
	4716	DATA (GA(10,16,IC),IC=1,3) /
	4717	S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/
	4718	DATA (GB(10,16,IC),IC=1,3) /
	4719	S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/
	4720	C
	4721	C----- INTERVAL = 4 ----- T = 312.5
	4722	C
	4723	C-- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4724	DATA (GA(11,15,IC),IC=1,3) /
	4725	S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/
	4726	DATA (GB(11,15,IC),IC=1,3) /
	4727	S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/
	4728	DATA (GA(11,16,IC),IC=1,3) /
	4729	S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/
	4730	DATA (GB(11,16,IC),IC=1,3) /
	4731	S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/
	4732
	4733	C ------------------------------------------------------------------
	4734	DATA (( XP( J,K),J=1,6), K=1,6) /
	4735	S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03,
	4736	S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03,
	4737	S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03,
	4738	S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02,
	4739	S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03,
	4740	S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02,
	4741	S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03,
	4742	S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02,
	4743	S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02,
	4744	S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01,
	4745	S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03,
	4746	S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 /
	4747	C
	4748	C
	4749	C* 1.0 PLANCK FUNCTIONS AND GRADIENTS
	4750	C ------------------------------
	4751	C
	4752	100 CONTINUE
	4753	C
	4754	DO 102 JK = 1 , KFLEV+1
	4755	DO 101 JL = 1, KDLON
	4756	PBINT(JL,JK) = 0.
	4757	101 CONTINUE
	4758	102 CONTINUE
	4759	DO 103 JL = 1, KDLON
	4760	PBSUIN(JL) = 0.
	4761	103 CONTINUE
	4762	C
	4763	DO 141 JNU=1,Ninter
	4764	C
	4765	C
	4766	C* 1.1 LEVELS FROM SURFACE TO KFLEV
	4767	C ----------------------------
	4768	C
	4769	110 CONTINUE
	4770	C
	4771	DO 112 JK = 1 , KFLEV
	4772	DO 111 JL = 1, KDLON
	4773	ZTI(JL)=(PTL(JL,JK)-TSTAND)/TSTAND
	4774	ZRES(JL) = XP(1,JNU)+ZTI(JL)(XP(2,JNU)+ZTI(JL)(XP(3,JNU)
	4775	S +ZTI(JL)(XP(4,JNU)+ZTI(JL)(XP(5,JNU)+ZTI(JL)*(XP(6,JNU)
	4776	S )))))
	4777	PBINT(JL,JK)=PBINT(JL,JK)+ZRES(JL)
	4778	PB(JL,JNU,JK)= ZRES(JL)
	4779	ZBLEV(JL,JK) = ZRES(JL)
	4780	ZTI2(JL)=(PTAVE(JL,JK)-TSTAND)/TSTAND
	4781	ZRES2(JL)=XP(1,JNU)+ZTI2(JL)(XP(2,JNU)+ZTI2(JL)(XP(3,JNU)
	4782	S +ZTI2(JL)(XP(4,JNU)+ZTI2(JL)(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU)
	4783	S )))))
	4784	ZBLAY(JL,JK) = ZRES2(JL)
	4785	111 CONTINUE
	4786	112 CONTINUE
	4787	C
	4788	C
	4789	C* 1.2 TOP OF THE ATMOSPHERE AND SURFACE
	4790	C ---------------------------------
	4791	C
	4792	120 CONTINUE
	4793	C
	4794	DO 121 JL = 1, KDLON
	4795	ZTI(JL)=(PTL(JL,KFLEV+1)-TSTAND)/TSTAND
	4796	ZTI2(JL) = (PTL(JL,1) + PDT0(JL) - TSTAND) / TSTAND
	4797	ZRES(JL) = XP(1,JNU)+ZTI(JL)(XP(2,JNU)+ZTI(JL)(XP(3,JNU)
	4798	S +ZTI(JL)(XP(4,JNU)+ZTI(JL)(XP(5,JNU)+ZTI(JL)*(XP(6,JNU)
	4799	S )))))
	4800	ZRES2(JL) = XP(1,JNU)+ZTI2(JL)(XP(2,JNU)+ZTI2(JL)(XP(3,JNU)
	4801	S +ZTI2(JL)(XP(4,JNU)+ZTI2(JL)(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU)
	4802	S )))))
	4803	PBINT(JL,KFLEV+1) = PBINT(JL,KFLEV+1)+ZRES(JL)
	4804	PB(JL,JNU,KFLEV+1)= ZRES(JL)
	4805	ZBLEV(JL,KFLEV+1) = ZRES(JL)
	4806	PBTOP(JL,JNU) = ZRES(JL)
	4807	PBSUR(JL,JNU) = ZRES2(JL)
	4808	PBSUIN(JL) = PBSUIN(JL) + ZRES2(JL)
	4809	121 CONTINUE
	4810	C
	4811	C
	4812	C* 1.3 GRADIENTS IN SUB-LAYERS
	4813	C -----------------------
	4814	C
	4815	130 CONTINUE
	4816	C
	4817	DO 132 JK = 1 , KFLEV
	4818	JK2 = 2 * JK
	4819	JK1 = JK2 - 1
	4820	DO 131 JL = 1, KDLON
	4821	PDBSL(JL,JNU,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK)
	4822	PDBSL(JL,JNU,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK)
	4823	131 CONTINUE
	4824	132 CONTINUE
	4825	C
	4826	141 CONTINUE
	4827	C
	4828	C* 2.0 CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS
	4829	C ---------------------------------------------
	4830	C
	4831	200 CONTINUE
	4832	C
	4833	C
	4834	210 CONTINUE
	4835	C
	4836	DO 211 JL=1, KDLON
	4837	ZDSTO1 = (PTL(JL,KFLEV+1)-TINTP(1)) / TSTP
	4838	IXTOX = MAX( 1, MIN( MXIXT, INT( ZDSTO1 + 1. ) ) )
	4839	ZDSTOX = (PTL(JL,KFLEV+1)-TINTP(IXTOX))/TSTP
	4840	IF (ZDSTOX.LT.0.5) THEN
	4841	INDTO=IXTOX
	4842	ELSE
	4843	INDTO=IXTOX+1
	4844	END IF
	4845	INDB(JL)=INDTO
	4846	ZDST1 = (PTL(JL,1)-TINTP(1)) / TSTP
	4847	IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) )
	4848	ZDSTX = (PTL(JL,1)-TINTP(IXTX))/TSTP
	4849	IF (ZDSTX.LT.0.5) THEN
	4850	INDT=IXTX
	4851	ELSE
	4852	INDT=IXTX+1
	4853	END IF
	4854	INDS(JL)=INDT
	4855	211 CONTINUE
	4856	C
	4857	DO 214 JF=1,2
	4858	DO 213 JG=1, 8
	4859	DO 212 JL=1, KDLON
	4860	INDSU=INDS(JL)
	4861	PGASUR(JL,JG,JF)=GA(INDSU,2*JG-1,JF)
	4862	PGBSUR(JL,JG,JF)=GB(INDSU,2*JG-1,JF)
	4863	INDTP=INDB(JL)
	4864	PGATOP(JL,JG,JF)=GA(INDTP,2*JG-1,JF)
	4865	PGBTOP(JL,JG,JF)=GB(INDTP,2*JG-1,JF)
	4866	212 CONTINUE
	4867	213 CONTINUE
	4868	214 CONTINUE
	4869	C
	4870	220 CONTINUE
	4871	C
	4872	DO 225 JK=1,KFLEV
	4873	DO 221 JL=1, KDLON
	4874	ZDST1 = (PTAVE(JL,JK)-TINTP(1)) / TSTP
	4875	IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1. ) ) )
	4876	ZDSTX = (PTAVE(JL,JK)-TINTP(IXTX))/TSTP
	4877	IF (ZDSTX.LT.0.5) THEN
	4878	INDT=IXTX
	4879	ELSE
	4880	INDT=IXTX+1
	4881	END IF
	4882	INDB(JL)=INDT
	4883	221 CONTINUE
	4884	C
	4885	DO 224 JF=1,2
	4886	DO 223 JG=1, 8
	4887	DO 222 JL=1, KDLON
	4888	INDT=INDB(JL)
	4889	PGA(JL,JG,JF,JK)=GA(INDT,2*JG,JF)
	4890	PGB(JL,JG,JF,JK)=GB(INDT,2*JG,JF)
	4891	222 CONTINUE
	4892	223 CONTINUE
	4893	224 CONTINUE
	4894	225 CONTINUE
	4895	C
	4896	C ------------------------------------------------------------------
	4897	C
	4898	RETURN
	4899	END
	4900	SUBROUTINE LWV(KUAER,KTRAER, KLIM
	4901	R , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE
	4902	R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
	4903	S , PCNTRB,PCTS,PFLUC)
	4904	IMPLICIT none
	4905	#include "dimensions.h"
	4906	#include "dimphy.h"
	4907	#include "raddim.h"
	4908	#include "raddimlw.h"
	4909	#include "YOMCST.h"
	4910	C
	4911	C-----------------------------------------------------------------------
	4912	C PURPOSE.
	4913	C --------
	4914	C CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
	4915	C FLUXES OR RADIANCES
	4916	C
	4917	C METHOD.
	4918	C -------
	4919	C
	4920	C 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
	4921	C CONTRIBUTIONS BY - THE NEARBY LAYERS
	4922	C - THE DISTANT LAYERS
	4923	C - THE BOUNDARY TERMS
	4924	C 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
	4925	C
	4926	C REFERENCE.
	4927	C ----------
	4928	C
	4929	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	4930	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	4931	C
	4932	C AUTHOR.
	4933	C -------
	4934	C JEAN-JACQUES MORCRETTE ECMWF
	4935	C
	4936	C MODIFICATIONS.
	4937	C --------------
	4938	C ORIGINAL : 89-07-14
	4939	C-----------------------------------------------------------------------
	4940	C
	4941	C* ARGUMENTS:
	4942	INTEGER KUAER,KTRAER, KLIM
	4943	C
	4944	REAL8 PABCU(KDLON,NUA,3KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
	4945	REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
	4946	REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
	4947	REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
	4948	REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
	4949	REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
	4950	REAL8 PDBSL(KDLON,Ninter,KFLEV2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
	4951	REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
	4952	REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
	4953	REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE
	4954	REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	4955	REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	4956	REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
	4957	REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
	4958	REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
	4959	REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
	4960	C
	4961	REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
	4962	REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
	4963	REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
	4964	C-----------------------------------------------------------------------
	4965	C LOCAL VARIABLES:
	4966	REAL*8 ZADJD(KDLON,KFLEV+1)
	4967	REAL*8 ZADJU(KDLON,KFLEV+1)
	4968	REAL*8 ZDBDT(KDLON,Ninter,KFLEV)
	4969	REAL*8 ZDISD(KDLON,KFLEV+1)
	4970	REAL*8 ZDISU(KDLON,KFLEV+1)
	4971	C
	4972	INTEGER jk, jl
	4973	C-----------------------------------------------------------------------
	4974	C
	4975	DO 112 JK=1,KFLEV+1
	4976	DO 111 JL=1, KDLON
	4977	ZADJD(JL,JK)=0.
	4978	ZADJU(JL,JK)=0.
	4979	ZDISD(JL,JK)=0.
	4980	ZDISU(JL,JK)=0.
	4981	111 CONTINUE
	4982	112 CONTINUE
	4983	C
	4984	DO 114 JK=1,KFLEV
	4985	DO 113 JL=1, KDLON
	4986	PCTS(JL,JK)=0.
	4987	113 CONTINUE
	4988	114 CONTINUE
	4989	C
	4990	C* CONTRIBUTION FROM ADJACENT LAYERS
	4991	C
	4992	CALL LWVN(KUAER,KTRAER
	4993	R , PABCU,PDBSL,PGA,PGB
	4994	S , ZADJD,ZADJU,PCNTRB,ZDBDT)
	4995	C* CONTRIBUTION FROM DISTANT LAYERS
	4996	C
	4997	CALL LWVD(KUAER,KTRAER
	4998	R , PABCU,ZDBDT,PGA,PGB
	4999	S , PCNTRB,ZDISD,ZDISU)
	5000	C
	5001	C* EXCHANGE WITH THE BOUNDARIES
	5002	C
	5003	CALL LWVB(KUAER,KTRAER, KLIM
	5004	R , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP
	5005	R , ZDISD,ZDISU,PEMIS,PPMB
	5006	R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
	5007	S , PCTS,PFLUC)
	5008	C
	5009	C
	5010	RETURN
	5011	END
	5012	SUBROUTINE LWVB(KUAER,KTRAER, KLIM
	5013	R , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP
	5014	R , PDISD,PDISU,PEMIS,PPMB
	5015	R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
	5016	S , PCTS,PFLUC)
	5017	IMPLICIT none
	5018	#include "dimensions.h"
	5019	#include "dimphy.h"
	5020	#include "raddim.h"
	5021	#include "raddimlw.h"
	5022	#include "radopt.h"
	5023	C
	5024	C-----------------------------------------------------------------------
	5025	C PURPOSE.
	5026	C --------
	5027	C INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
	5028	C INTEGRATION
	5029	C
	5030	C METHOD.
	5031	C -------
	5032	C
	5033	C 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
	5034	C ATMOSPHERE
	5035	C 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
	5036	C TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
	5037	C 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
	5038	C
	5039	C REFERENCE.
	5040	C ----------
	5041	C
	5042	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5043	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5044	C
	5045	C AUTHOR.
	5046	C -------
	5047	C JEAN-JACQUES MORCRETTE ECMWF
	5048	C
	5049	C MODIFICATIONS.
	5050	C --------------
	5051	C ORIGINAL : 89-07-14
	5052	C Voigt lines (loop 2413 to 2427) - JJM & PhD - 01/96
	5053	C-----------------------------------------------------------------------
	5054	C
	5055	C* 0.1 ARGUMENTS
	5056	C ---------
	5057	C
	5058	INTEGER KUAER,KTRAER, KLIM
	5059	C
	5060	REAL8 PABCU(KDLON,NUA,3KFLEV+1) ! ABSORBER AMOUNTS
	5061	REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
	5062	REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION BY ADJACENT LAYERS
	5063	REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
	5064	REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
	5065	REAL*8 PBSUR(KDLON,Ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
	5066	REAL*8 PBSUI(KDLON) ! SURFACE PLANCK FUNCTION
	5067	REAL*8 PBTOP(KDLON,Ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
	5068	REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
	5069	REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
	5070	REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
	5071	REAL*8 PPMB(KDLON,KFLEV+1) ! PRESSURE MB
	5072	REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	5073	REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	5074	REAL*8 PGASUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
	5075	REAL*8 PGBSUR(KDLON,8,2) ! SURFACE PADE APPROXIMANTS
	5076	REAL*8 PGATOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
	5077	REAL*8 PGBTOP(KDLON,8,2) ! T.O.A. PADE APPROXIMANTS
	5078	C
	5079	REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
	5080	REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
	5081	C
	5082	C* LOCAL VARIABLES:
	5083	C
	5084	REAL*8 ZBGND(KDLON)
	5085	REAL*8 ZFD(KDLON)
	5086	REAL*8 ZFN10(KDLON)
	5087	REAL*8 ZFU(KDLON)
	5088	REAL*8 ZTT(KDLON,NTRA)
	5089	REAL*8 ZTT1(KDLON,NTRA)
	5090	REAL*8 ZTT2(KDLON,NTRA)
	5091	REAL*8 ZUU(KDLON,NUA)
	5092	REAL*8 ZCNSOL(KDLON)
	5093	REAL*8 ZCNTOP(KDLON)
	5094	C
	5095	INTEGER jk, jl, ja
	5096	INTEGER jstra, jstru
	5097	INTEGER ind1, ind2, ind3, ind4, in, jlim
	5098	REAL*8 zctstr
	5099	C-----------------------------------------------------------------------
	5100	C
	5101	C* 1. INITIALIZATION
	5102	C --------------
	5103	C
	5104	100 CONTINUE
	5105	C
	5106	C
	5107	C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS
	5108	C ---------------------------------
	5109	C
	5110	120 CONTINUE
	5111	C
	5112	DO 122 JA=1,NTRA
	5113	DO 121 JL=1, KDLON
	5114	ZTT (JL,JA)=1.0
	5115	ZTT1(JL,JA)=1.0
	5116	ZTT2(JL,JA)=1.0
	5117	121 CONTINUE
	5118	122 CONTINUE
	5119	C
	5120	DO 124 JA=1,NUA
	5121	DO 123 JL=1, KDLON
	5122	ZUU(JL,JA)=1.0
	5123	123 CONTINUE
	5124	124 CONTINUE
	5125	C
	5126	C ------------------------------------------------------------------
	5127	C
	5128	C* 2. VERTICAL INTEGRATION
	5129	C --------------------
	5130	C
	5131	200 CONTINUE
	5132	C
	5133	IND1=0
	5134	IND3=0
	5135	IND4=1
	5136	IND2=1
	5137	C
	5138	C
	5139	C* 2.3 EXCHANGE WITH TOP OF THE ATMOSPHERE
	5140	C -----------------------------------
	5141	C
	5142	230 CONTINUE
	5143	C
	5144	DO 235 JK = 1 , KFLEV
	5145	IN=(JK-1)*NG1P1+1
	5146	C
	5147	DO 232 JA=1,KUAER
	5148	DO 231 JL=1, KDLON
	5149	ZUU(JL,JA)=PABCU(JL,JA,IN)
	5150	231 CONTINUE
	5151	232 CONTINUE
	5152	C
	5153	C
	5154	CALL LWTT(PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT)
	5155	C
	5156	DO 234 JL = 1, KDLON
	5157	ZCNTOP(JL)=PBTOP(JL,1)ZTT(JL,1) ZTT(JL,10)
	5158	2 +PBTOP(JL,2)ZTT(JL,2)ZTT(JL,7)*ZTT(JL,11)
	5159	3 +PBTOP(JL,3)ZTT(JL,4)ZTT(JL,8)*ZTT(JL,12)
	5160	4 +PBTOP(JL,4)ZTT(JL,5)ZTT(JL,9)*ZTT(JL,13)
	5161	5 +PBTOP(JL,5)ZTT(JL,3) ZTT(JL,14)
	5162	6 +PBTOP(JL,6)ZTT(JL,6) ZTT(JL,15)
	5163	ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
	5164	PFLUC(JL,2,JK)=ZFD(JL)
	5165	234 CONTINUE
	5166	C
	5167	235 CONTINUE
	5168	C
	5169	JK = KFLEV+1
	5170	IN=(JK-1)*NG1P1+1
	5171	C
	5172	DO 236 JL = 1, KDLON
	5173	ZCNTOP(JL)= PBTOP(JL,1)
	5174	1 + PBTOP(JL,2)
	5175	2 + PBTOP(JL,3)
	5176	3 + PBTOP(JL,4)
	5177	4 + PBTOP(JL,5)
	5178	5 + PBTOP(JL,6)
	5179	ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
	5180	PFLUC(JL,2,JK)=ZFD(JL)
	5181	236 CONTINUE
	5182	C
	5183	C* 2.4 COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
	5184	C ---------------------------------------
	5185	C
	5186	240 CONTINUE
	5187	C
	5188	C
	5189	C* 2.4.1 INITIALIZATION
	5190	C --------------
	5191	C
	5192	2410 CONTINUE
	5193	C
	5194	JLIM = KFLEV
	5195	C
	5196	IF (.NOT.LEVOIGT) THEN
	5197	DO 2412 JK = KFLEV,1,-1
	5198	IF(PPMB(1,JK).LT.10.0) THEN
	5199	JLIM=JK
	5200	ENDIF
	5201	2412 CONTINUE
	5202	ENDIF
	5203	KLIM=JLIM
	5204	C
	5205	IF (.NOT.LEVOIGT) THEN
	5206	DO 2414 JA=1,KTRAER
	5207	DO 2413 JL=1, KDLON
	5208	ZTT1(JL,JA)=1.0
	5209	2413 CONTINUE
	5210	2414 CONTINUE
	5211	C
	5212	C* 2.4.2 LOOP OVER LAYERS ABOVE 10 HPA
	5213	C -----------------------------
	5214	C
	5215	2420 CONTINUE
	5216	C
	5217	DO 2427 JSTRA = KFLEV,JLIM,-1
	5218	JSTRU=(JSTRA-1)*NG1P1+1
	5219	C
	5220	DO 2423 JA=1,KUAER
	5221	DO 2422 JL=1, KDLON
	5222	ZUU(JL,JA)=PABCU(JL,JA,JSTRU)
	5223	2422 CONTINUE
	5224	2423 CONTINUE
	5225	C
	5226	C
	5227	CALL LWTT(PGA(1,1,1,JSTRA), PGB(1,1,1,JSTRA), ZUU, ZTT)
	5228	C
	5229	DO 2424 JL = 1, KDLON
	5230	ZCTSTR =
	5231	1 (PB(JL,1,JSTRA)+PB(JL,1,JSTRA+1))
	5232	1 (ZTT1(JL,1) ZTT1(JL,10)
	5233	1 - ZTT (JL,1) *ZTT (JL,10))
	5234	2 +(PB(JL,2,JSTRA)+PB(JL,2,JSTRA+1))
	5235	2 (ZTT1(JL,2)ZTT1(JL,7)*ZTT1(JL,11)
	5236	2 - ZTT (JL,2)ZTT (JL,7)ZTT (JL,11))
	5237	3 +(PB(JL,3,JSTRA)+PB(JL,3,JSTRA+1))
	5238	3 (ZTT1(JL,4)ZTT1(JL,8)*ZTT1(JL,12)
	5239	3 - ZTT (JL,4)ZTT (JL,8)ZTT (JL,12))
	5240	4 +(PB(JL,4,JSTRA)+PB(JL,4,JSTRA+1))
	5241	4 (ZTT1(JL,5)ZTT1(JL,9)*ZTT1(JL,13)
	5242	4 - ZTT (JL,5)ZTT (JL,9)ZTT (JL,13))
	5243	5 +(PB(JL,5,JSTRA)+PB(JL,5,JSTRA+1))
	5244	5 (ZTT1(JL,3) ZTT1(JL,14)
	5245	5 - ZTT (JL,3) *ZTT (JL,14))
	5246	6 +(PB(JL,6,JSTRA)+PB(JL,6,JSTRA+1))
	5247	6 (ZTT1(JL,6) ZTT1(JL,15)
	5248	6 - ZTT (JL,6) *ZTT (JL,15))
	5249	PCTS(JL,JSTRA)=ZCTSTR*0.5
	5250	2424 CONTINUE
	5251	DO 2426 JA=1,KTRAER
	5252	DO 2425 JL=1, KDLON
	5253	ZTT1(JL,JA)=ZTT(JL,JA)
	5254	2425 CONTINUE
	5255	2426 CONTINUE
	5256	2427 CONTINUE
	5257	ENDIF
	5258	C Mise a zero de securite pour PCTS en cas de LEVOIGT
	5259	IF(LEVOIGT)THEN
	5260	DO 2429 JSTRA = 1,KFLEV
	5261	DO 2428 JL = 1, KDLON
	5262	PCTS(JL,JSTRA)=0.
	5263	2428 CONTINUE
	5264	2429 CONTINUE
	5265	ENDIF
	5266	C
	5267	C
	5268	C* 2.5 EXCHANGE WITH LOWER LIMIT
	5269	C -------------------------
	5270	C
	5271	250 CONTINUE
	5272	C
	5273	DO 251 JL = 1, KDLON
	5274	ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL))
	5275	S *PFLUC(JL,2,1)-PBINT(JL,1)
	5276	251 CONTINUE
	5277	C
	5278	JK = 1
	5279	IN=(JK-1)*NG1P1+1
	5280	C
	5281	DO 252 JL = 1, KDLON
	5282	ZCNSOL(JL)=PBSUR(JL,1)
	5283	1 +PBSUR(JL,2)
	5284	2 +PBSUR(JL,3)
	5285	3 +PBSUR(JL,4)
	5286	4 +PBSUR(JL,5)
	5287	5 +PBSUR(JL,6)
	5288	ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
	5289	ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
	5290	PFLUC(JL,1,JK)=ZFU(JL)
	5291	252 CONTINUE
	5292	C
	5293	DO 257 JK = 2 , KFLEV+1
	5294	IN=(JK-1)*NG1P1+1
	5295	C
	5296	C
	5297	DO 255 JA=1,KUAER
	5298	DO 254 JL=1, KDLON
	5299	ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)
	5300	254 CONTINUE
	5301	255 CONTINUE
	5302	C
	5303	C
	5304	CALL LWTT(PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT)
	5305	C
	5306	DO 256 JL = 1, KDLON
	5307	ZCNSOL(JL)=PBSUR(JL,1)ZTT(JL,1) ZTT(JL,10)
	5308	2 +PBSUR(JL,2)ZTT(JL,2)ZTT(JL,7)*ZTT(JL,11)
	5309	3 +PBSUR(JL,3)ZTT(JL,4)ZTT(JL,8)*ZTT(JL,12)
	5310	4 +PBSUR(JL,4)ZTT(JL,5)ZTT(JL,9)*ZTT(JL,13)
	5311	5 +PBSUR(JL,5)ZTT(JL,3) ZTT(JL,14)
	5312	6 +PBSUR(JL,6)ZTT(JL,6) ZTT(JL,15)
	5313	ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
	5314	ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
	5315	PFLUC(JL,1,JK)=ZFU(JL)
	5316	256 CONTINUE
	5317	C
	5318	C
	5319	257 CONTINUE
	5320	C
	5321	C
	5322	C
	5323	C* 2.7 CLEAR-SKY FLUXES
	5324	C ----------------
	5325	C
	5326	270 CONTINUE
	5327	C
	5328	IF (.NOT.LEVOIGT) THEN
	5329	DO 271 JL = 1, KDLON
	5330	ZFN10(JL) = PFLUC(JL,1,JLIM) + PFLUC(JL,2,JLIM)
	5331	271 CONTINUE
	5332	DO 273 JK = JLIM+1,KFLEV+1
	5333	DO 272 JL = 1, KDLON
	5334	ZFN10(JL) = ZFN10(JL) + PCTS(JL,JK-1)
	5335	PFLUC(JL,1,JK) = ZFN10(JL)
	5336	PFLUC(JL,2,JK) = 0.
	5337	272 CONTINUE
	5338	273 CONTINUE
	5339	ENDIF
	5340	C
	5341	C ------------------------------------------------------------------
	5342	C
	5343	RETURN
	5344	END
	5345	SUBROUTINE LWVD(KUAER,KTRAER
	5346	S , PABCU,PDBDT
	5347	R , PGA,PGB
	5348	S , PCNTRB,PDISD,PDISU)
	5349	IMPLICIT none
	5350	#include "dimensions.h"
	5351	#include "dimphy.h"
	5352	#include "raddim.h"
	5353	#include "raddimlw.h"
	5354	C
	5355	C-----------------------------------------------------------------------
	5356	C PURPOSE.
	5357	C --------
	5358	C CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS
	5359	C
	5360	C METHOD.
	5361	C -------
	5362	C
	5363	C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
	5364	C CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE
	5365	C
	5366	C REFERENCE.
	5367	C ----------
	5368	C
	5369	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5370	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5371	C
	5372	C AUTHOR.
	5373	C -------
	5374	C JEAN-JACQUES MORCRETTE ECMWF
	5375	C
	5376	C MODIFICATIONS.
	5377	C --------------
	5378	C ORIGINAL : 89-07-14
	5379	C-----------------------------------------------------------------------
	5380	C* ARGUMENTS:
	5381	C
	5382	INTEGER KUAER,KTRAER
	5383	C
	5384	REAL8 PABCU(KDLON,NUA,3KFLEV+1) ! ABSORBER AMOUNTS
	5385	REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT
	5386	REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	5387	REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	5388	C
	5389	REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! ENERGY EXCHANGE MATRIX
	5390	REAL*8 PDISD(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
	5391	REAL*8 PDISU(KDLON,KFLEV+1) ! CONTRIBUTION BY DISTANT LAYERS
	5392	C
	5393	C* LOCAL VARIABLES:
	5394	C
	5395	REAL*8 ZGLAYD(KDLON)
	5396	REAL*8 ZGLAYU(KDLON)
	5397	REAL*8 ZTT(KDLON,NTRA)
	5398	REAL*8 ZTT1(KDLON,NTRA)
	5399	REAL*8 ZTT2(KDLON,NTRA)
	5400	C
	5401	INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2
	5402	INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2
	5403	INTEGER ind1, ind2, ind3, ind4, itt
	5404	REAL*8 zww, zdzxdg, zdzxmg
	5405	C
	5406	C* 1. INITIALIZATION
	5407	C --------------
	5408	C
	5409	100 CONTINUE
	5410	C
	5411	C* 1.1 INITIALIZE LAYER CONTRIBUTIONS
	5412	C ------------------------------
	5413	C
	5414	110 CONTINUE
	5415	C
	5416	DO 112 JK = 1, KFLEV+1
	5417	DO 111 JL = 1, KDLON
	5418	PDISD(JL,JK) = 0.
	5419	PDISU(JL,JK) = 0.
	5420	111 CONTINUE
	5421	112 CONTINUE
	5422	C
	5423	C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS
	5424	C ---------------------------------
	5425	C
	5426	120 CONTINUE
	5427	C
	5428	C
	5429	DO 122 JA = 1, NTRA
	5430	DO 121 JL = 1, KDLON
	5431	ZTT (JL,JA) = 1.0
	5432	ZTT1(JL,JA) = 1.0
	5433	ZTT2(JL,JA) = 1.0
	5434	121 CONTINUE
	5435	122 CONTINUE
	5436	C
	5437	C ------------------------------------------------------------------
	5438	C
	5439	C* 2. VERTICAL INTEGRATION
	5440	C --------------------
	5441	C
	5442	200 CONTINUE
	5443	C
	5444	IND1=0
	5445	IND3=0
	5446	IND4=1
	5447	IND2=1
	5448	C
	5449	C
	5450	C* 2.2 CONTRIBUTION FROM DISTANT LAYERS
	5451	C ---------------------------------
	5452	C
	5453	220 CONTINUE
	5454	C
	5455	C
	5456	C* 2.2.1 DISTANT AND ABOVE LAYERS
	5457	C ------------------------
	5458	C
	5459	2210 CONTINUE
	5460	C
	5461	C
	5462	C
	5463	C* 2.2.2 FIRST UPPER LEVEL
	5464	C -----------------
	5465	C
	5466	2220 CONTINUE
	5467	C
	5468	DO 225 JK = 1 , KFLEV-1
	5469	IKP1=JK+1
	5470	IKN=(JK-1)*NG1P1+1
	5471	IKD1= JK *NG1P1+1
	5472	C
	5473	CALL LWTTM(PGA(1,1,1,JK), PGB(1,1,1,JK)
	5474	2 , PABCU(1,1,IKN),PABCU(1,1,IKD1),ZTT1)
	5475	C
	5476	C
	5477	C
	5478	C* 2.2.3 HIGHER UP
	5479	C ---------
	5480	C
	5481	2230 CONTINUE
	5482	C
	5483	ITT=1
	5484	DO 224 JKJ=IKP1,KFLEV
	5485	IF(ITT.EQ.1) THEN
	5486	ITT=2
	5487	ELSE
	5488	ITT=1
	5489	ENDIF
	5490	IKJP1=JKJ+1
	5491	IKD2= JKJ *NG1P1+1
	5492	C
	5493	IF(ITT.EQ.1) THEN
	5494	CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ)
	5495	2 , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT1)
	5496	ELSE
	5497	CALL LWTTM(PGA(1,1,1,JKJ),PGB(1,1,1,JKJ)
	5498	2 , PABCU(1,1,IKN),PABCU(1,1,IKD2),ZTT2)
	5499	ENDIF
	5500	C
	5501	DO 2235 JA = 1, KTRAER
	5502	DO 2234 JL = 1, KDLON
	5503	ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5
	5504	2234 CONTINUE
	5505	2235 CONTINUE
	5506	C
	5507	DO 2236 JL = 1, KDLON
	5508	ZWW=PDBDT(JL,1,JKJ)ZTT(JL,1) ZTT(JL,10)
	5509	S +PDBDT(JL,2,JKJ)ZTT(JL,2)ZTT(JL,7)*ZTT(JL,11)
	5510	S +PDBDT(JL,3,JKJ)ZTT(JL,4)ZTT(JL,8)*ZTT(JL,12)
	5511	S +PDBDT(JL,4,JKJ)ZTT(JL,5)ZTT(JL,9)*ZTT(JL,13)
	5512	S +PDBDT(JL,5,JKJ)ZTT(JL,3) ZTT(JL,14)
	5513	S +PDBDT(JL,6,JKJ)ZTT(JL,6) ZTT(JL,15)
	5514	ZGLAYD(JL)=ZWW
	5515	ZDZXDG=ZGLAYD(JL)
	5516	PDISD(JL,JK)=PDISD(JL,JK)+ZDZXDG
	5517	PCNTRB(JL,JK,IKJP1)=ZDZXDG
	5518	2236 CONTINUE
	5519	C
	5520	C
	5521	224 CONTINUE
	5522	225 CONTINUE
	5523	C
	5524	C
	5525	C* 2.2.4 DISTANT AND BELOW LAYERS
	5526	C ------------------------
	5527	C
	5528	2240 CONTINUE
	5529	C
	5530	C
	5531	C
	5532	C* 2.2.5 FIRST LOWER LEVEL
	5533	C -----------------
	5534	C
	5535	2250 CONTINUE
	5536	C
	5537	DO 228 JK=3,KFLEV+1
	5538	IKN=(JK-1)*NG1P1+1
	5539	IKM1=JK-1
	5540	IKJ=JK-2
	5541	IKU1= IKJ *NG1P1+1
	5542	C
	5543	C
	5544	CALL LWTTM(PGA(1,1,1,IKJ),PGB(1,1,1,IKJ)
	5545	2 , PABCU(1,1,IKU1),PABCU(1,1,IKN),ZTT1)
	5546	C
	5547	C
	5548	C
	5549	C* 2.2.6 DOWN BELOW
	5550	C ----------
	5551	C
	5552	2260 CONTINUE
	5553	C
	5554	ITT=1
	5555	DO 227 JLK=1,IKJ
	5556	IF(ITT.EQ.1) THEN
	5557	ITT=2
	5558	ELSE
	5559	ITT=1
	5560	ENDIF
	5561	IJKL=IKM1-JLK
	5562	IKU2=(IJKL-1)*NG1P1+1
	5563	C
	5564	C
	5565	IF(ITT.EQ.1) THEN
	5566	CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL)
	5567	2 , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT1)
	5568	ELSE
	5569	CALL LWTTM(PGA(1,1,1,IJKL),PGB(1,1,1,IJKL)
	5570	2 , PABCU(1,1,IKU2),PABCU(1,1,IKN),ZTT2)
	5571	ENDIF
	5572	C
	5573	DO 2265 JA = 1, KTRAER
	5574	DO 2264 JL = 1, KDLON
	5575	ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5
	5576	2264 CONTINUE
	5577	2265 CONTINUE
	5578	C
	5579	DO 2266 JL = 1, KDLON
	5580	ZWW=PDBDT(JL,1,IJKL)ZTT(JL,1) ZTT(JL,10)
	5581	S +PDBDT(JL,2,IJKL)ZTT(JL,2)ZTT(JL,7)*ZTT(JL,11)
	5582	S +PDBDT(JL,3,IJKL)ZTT(JL,4)ZTT(JL,8)*ZTT(JL,12)
	5583	S +PDBDT(JL,4,IJKL)ZTT(JL,5)ZTT(JL,9)*ZTT(JL,13)
	5584	S +PDBDT(JL,5,IJKL)ZTT(JL,3) ZTT(JL,14)
	5585	S +PDBDT(JL,6,IJKL)ZTT(JL,6) ZTT(JL,15)
	5586	ZGLAYU(JL)=ZWW
	5587	ZDZXMG=ZGLAYU(JL)
	5588	PDISU(JL,JK)=PDISU(JL,JK)+ZDZXMG
	5589	PCNTRB(JL,JK,IJKL)=ZDZXMG
	5590	2266 CONTINUE
	5591	C
	5592	C
	5593	227 CONTINUE
	5594	228 CONTINUE
	5595	C
	5596	RETURN
	5597	END
	5598	SUBROUTINE LWVN(KUAER,KTRAER
	5599	R , PABCU,PDBSL,PGA,PGB
	5600	S , PADJD,PADJU,PCNTRB,PDBDT)
	5601	IMPLICIT none
	5602	#include "dimensions.h"
	5603	#include "dimphy.h"
	5604	#include "raddim.h"
	5605	#include "raddimlw.h"
	5606	C
	5607	C-----------------------------------------------------------------------
	5608	C PURPOSE.
	5609	C --------
	5610	C CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
	5611	C TO GIVE LONGWAVE FLUXES OR RADIANCES
	5612	C
	5613	C METHOD.
	5614	C -------
	5615	C
	5616	C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
	5617	C CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
	5618	C
	5619	C REFERENCE.
	5620	C ----------
	5621	C
	5622	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5623	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5624	C
	5625	C AUTHOR.
	5626	C -------
	5627	C JEAN-JACQUES MORCRETTE ECMWF
	5628	C
	5629	C MODIFICATIONS.
	5630	C --------------
	5631	C ORIGINAL : 89-07-14
	5632	C-----------------------------------------------------------------------
	5633	C
	5634	C* ARGUMENTS:
	5635	C
	5636	INTEGER KUAER,KTRAER
	5637	C
	5638	REAL8 PABCU(KDLON,NUA,3KFLEV+1) ! ABSORBER AMOUNTS
	5639	REAL8 PDBSL(KDLON,Ninter,KFLEV2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
	5640	REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	5641	REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
	5642	C
	5643	REAL*8 PADJD(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
	5644	REAL*8 PADJU(KDLON,KFLEV+1) ! CONTRIBUTION OF ADJACENT LAYERS
	5645	REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
	5646	REAL*8 PDBDT(KDLON,Ninter,KFLEV) ! LAYER PLANCK FUNCTION GRADIENT
	5647	C
	5648	C* LOCAL ARRAYS:
	5649	C
	5650	REAL*8 ZGLAYD(KDLON)
	5651	REAL*8 ZGLAYU(KDLON)
	5652	REAL*8 ZTT(KDLON,NTRA)
	5653	REAL*8 ZTT1(KDLON,NTRA)
	5654	REAL*8 ZTT2(KDLON,NTRA)
	5655	REAL*8 ZUU(KDLON,NUA)
	5656	C
	5657	INTEGER jk, jl, ja, im12, ind, inu, ixu, jg
	5658	INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu
	5659	REAL*8 zwtr
	5660	c
	5661	C* Data Block:
	5662	c
	5663	REAL*8 WG1(2)
	5664	SAVE WG1
	5665	DATA (WG1(jk),jk=1,2) /1.0, 1.0/
	5666	C-----------------------------------------------------------------------
	5667	C
	5668	C* 1. INITIALIZATION
	5669	C --------------
	5670	C
	5671	100 CONTINUE
	5672	C
	5673	C* 1.1 INITIALIZE LAYER CONTRIBUTIONS
	5674	C ------------------------------
	5675	C
	5676	110 CONTINUE
	5677	C
	5678	DO 112 JK = 1 , KFLEV+1
	5679	DO 111 JL = 1, KDLON
	5680	PADJD(JL,JK) = 0.
	5681	PADJU(JL,JK) = 0.
	5682	111 CONTINUE
	5683	112 CONTINUE
	5684	C
	5685	C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS
	5686	C ---------------------------------
	5687	C
	5688	120 CONTINUE
	5689	C
	5690	DO 122 JA = 1 , NTRA
	5691	DO 121 JL = 1, KDLON
	5692	ZTT (JL,JA) = 1.0
	5693	ZTT1(JL,JA) = 1.0
	5694	ZTT2(JL,JA) = 1.0
	5695	121 CONTINUE
	5696	122 CONTINUE
	5697	C
	5698	DO 124 JA = 1 , NUA
	5699	DO 123 JL = 1, KDLON
	5700	ZUU(JL,JA) = 0.
	5701	123 CONTINUE
	5702	124 CONTINUE
	5703	C
	5704	C ------------------------------------------------------------------
	5705	C
	5706	C* 2. VERTICAL INTEGRATION
	5707	C --------------------
	5708	C
	5709	200 CONTINUE
	5710	C
	5711	C
	5712	C* 2.1 CONTRIBUTION FROM ADJACENT LAYERS
	5713	C ---------------------------------
	5714	C
	5715	210 CONTINUE
	5716	C
	5717	DO 215 JK = 1 , KFLEV
	5718	C
	5719	C* 2.1.1 DOWNWARD LAYERS
	5720	C ---------------
	5721	C
	5722	2110 CONTINUE
	5723	C
	5724	IM12 = 2 * (JK - 1)
	5725	IND = (JK - 1) * NG1P1 + 1
	5726	IXD = IND
	5727	INU = JK * NG1P1 + 1
	5728	IXU = IND
	5729	C
	5730	DO 2111 JL = 1, KDLON
	5731	ZGLAYD(JL) = 0.
	5732	ZGLAYU(JL) = 0.
	5733	2111 CONTINUE
	5734	C
	5735	DO 213 JG = 1 , NG1
	5736	IBS = IM12 + JG
	5737	IDD = IXD + JG
	5738	DO 2113 JA = 1 , KUAER
	5739	DO 2112 JL = 1, KDLON
	5740	ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD)
	5741	2112 CONTINUE
	5742	2113 CONTINUE
	5743	C
	5744	C
	5745	CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT)
	5746	C
	5747	DO 2114 JL = 1, KDLON
	5748	ZWTR=PDBSL(JL,1,IBS)ZTT(JL,1) ZTT(JL,10)
	5749	S +PDBSL(JL,2,IBS)ZTT(JL,2)ZTT(JL,7)*ZTT(JL,11)
	5750	S +PDBSL(JL,3,IBS)ZTT(JL,4)ZTT(JL,8)*ZTT(JL,12)
	5751	S +PDBSL(JL,4,IBS)ZTT(JL,5)ZTT(JL,9)*ZTT(JL,13)
	5752	S +PDBSL(JL,5,IBS)ZTT(JL,3) ZTT(JL,14)
	5753	S +PDBSL(JL,6,IBS)ZTT(JL,6) ZTT(JL,15)
	5754	ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG1(JG)
	5755	2114 CONTINUE
	5756	C
	5757	C* 2.1.2 DOWNWARD LAYERS
	5758	C ---------------
	5759	C
	5760	2120 CONTINUE
	5761	C
	5762	IMU = IXU + JG
	5763	DO 2122 JA = 1 , KUAER
	5764	DO 2121 JL = 1, KDLON
	5765	ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU)
	5766	2121 CONTINUE
	5767	2122 CONTINUE
	5768	C
	5769	C
	5770	CALL LWTT(PGA(1,1,1,JK), PGB(1,1,1,JK), ZUU, ZTT)
	5771	C
	5772	DO 2123 JL = 1, KDLON
	5773	ZWTR=PDBSL(JL,1,IBS)ZTT(JL,1) ZTT(JL,10)
	5774	S +PDBSL(JL,2,IBS)ZTT(JL,2)ZTT(JL,7)*ZTT(JL,11)
	5775	S +PDBSL(JL,3,IBS)ZTT(JL,4)ZTT(JL,8)*ZTT(JL,12)
	5776	S +PDBSL(JL,4,IBS)ZTT(JL,5)ZTT(JL,9)*ZTT(JL,13)
	5777	S +PDBSL(JL,5,IBS)ZTT(JL,3) ZTT(JL,14)
	5778	S +PDBSL(JL,6,IBS)ZTT(JL,6) ZTT(JL,15)
	5779	ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG1(JG)
	5780	2123 CONTINUE
	5781	C
	5782	213 CONTINUE
	5783	C
	5784	DO 214 JL = 1, KDLON
	5785	PADJD(JL,JK) = ZGLAYD(JL)
	5786	PCNTRB(JL,JK,JK+1) = ZGLAYD(JL)
	5787	PADJU(JL,JK+1) = ZGLAYU(JL)
	5788	PCNTRB(JL,JK+1,JK) = ZGLAYU(JL)
	5789	PCNTRB(JL,JK ,JK) = 0.0
	5790	214 CONTINUE
	5791	C
	5792	215 CONTINUE
	5793	C
	5794	DO 218 JK = 1 , KFLEV
	5795	JK2 = 2 * JK
	5796	JK1 = JK2 - 1
	5797	DO 217 JNU = 1 , Ninter
	5798	DO 216 JL = 1, KDLON
	5799	PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2)
	5800	216 CONTINUE
	5801	217 CONTINUE
	5802	218 CONTINUE
	5803	C
	5804	RETURN
	5805	C
	5806	END
	5807	SUBROUTINE LWTT(PGA,PGB,PUU, PTT)
	5808	IMPLICIT none
	5809	#include "dimensions.h"
	5810	#include "dimphy.h"
	5811	#include "raddim.h"
	5812	#include "raddimlw.h"
	5813	C
	5814	C-----------------------------------------------------------------------
	5815	C PURPOSE.
	5816	C --------
	5817	C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	5818	C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
	5819	C INTERVALS.
	5820	C
	5821	C METHOD.
	5822	C -------
	5823	C
	5824	C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
	5825	C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
	5826	C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
	5827	C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
	5828	C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
	5829	C
	5830	C REFERENCE.
	5831	C ----------
	5832	C
	5833	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5834	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5835	C
	5836	C AUTHOR.
	5837	C -------
	5838	C JEAN-JACQUES MORCRETTE ECMWF
	5839	C
	5840	C MODIFICATIONS.
	5841	C --------------
	5842	C ORIGINAL : 88-12-15
	5843	C
	5844	C-----------------------------------------------------------------------
	5845	REAL*8 O1H, O2H
	5846	PARAMETER (O1H=2230.)
	5847	PARAMETER (O2H=100.)
	5848	REAL*8 RPIALF0
	5849	PARAMETER (RPIALF0=2.0)
	5850	C
	5851	C* ARGUMENTS:
	5852	C
	5853	REAL*8 PUU(KDLON,NUA)
	5854	REAL*8 PTT(KDLON,NTRA)
	5855	REAL*8 PGA(KDLON,8,2)
	5856	REAL*8 PGB(KDLON,8,2)
	5857	C
	5858	C* LOCAL VARIABLES:
	5859	C
	5860	REAL*8 zz, zxd, zxn
	5861	REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
	5862	REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
	5863	REAL*8 zx, zy, zsq1, zsq2, zvxy, zuxy
	5864	REAL*8 zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
	5865	REAL*8 zsqn21, zodn21, zsqh42, zodh42
	5866	REAL*8 zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
	5867	REAL*8 zuu11, zuu12, za11, za12
	5868	INTEGER jl, ja
	5869	C ------------------------------------------------------------------
	5870	C
	5871	C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
	5872	C -----------------------------------------------
	5873	C
	5874	100 CONTINUE
	5875	C
	5876	C
	5877	DO 130 JA = 1 , 8
	5878	DO 120 JL = 1, KDLON
	5879	ZZ =SQRT(PUU(JL,JA))
	5880	c ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
	5881	c ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
	5882	c PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
	5883	ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ )
	5884	ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) )
	5885	PTT(JL,JA)=ZXN /ZXD
	5886	120 CONTINUE
	5887	130 CONTINUE
	5888	C
	5889	C ------------------------------------------------------------------
	5890	C
	5891	C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
	5892	C ---------------------------------------------------
	5893	C
	5894	200 CONTINUE
	5895	C
	5896	DO 201 JL = 1, KDLON
	5897	PTT(JL, 9) = PTT(JL, 8)
	5898	C
	5899	C- CONTINUUM ABSORPTION: E- AND P-TYPE
	5900	C
	5901	ZPU = 0.002 * PUU(JL,10)
	5902	ZPU10 = 112. * ZPU
	5903	ZPU11 = 6.25 * ZPU
	5904	ZPU12 = 5.00 * ZPU
	5905	ZPU13 = 80.0 * ZPU
	5906	ZEU = PUU(JL,11)
	5907	ZEU10 = 12. * ZEU
	5908	ZEU11 = 6.25 * ZEU
	5909	ZEU12 = 5.00 * ZEU
	5910	ZEU13 = 80.0 * ZEU
	5911	C
	5912	C- OZONE ABSORPTION
	5913	C
	5914	ZX = PUU(JL,12)
	5915	ZY = PUU(JL,13)
	5916	ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
	5917	ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
	5918	ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
	5919	ZVXY = RPIALF0 * ZY / (2. * ZX)
	5920	ZAERCN = PUU(JL,17) + ZEU12 + ZPU12
	5921	ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
	5922	ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
	5923	C
	5924	C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
	5925	C
	5926	C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
	5927	C
	5928	c NEXOTIC=1
	5929	c IF (NEXOTIC.EQ.1) THEN
	5930	ZXCH4 = PUU(JL,19)
	5931	ZYCH4 = PUU(JL,20)
	5932	ZUXY = 4. * ZXCH4ZXCH4/(0.103ZYCH4)
	5933	ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
	5934	ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
	5935	ZODH41 = ZVXY * ZSQH41
	5936	C
	5937	C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
	5938	C
	5939	ZXN2O = PUU(JL,21)
	5940	ZYN2O = PUU(JL,22)
	5941	ZUXY = 4. * ZXN2OZXN2O/(0.416ZYN2O)
	5942	ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
	5943	ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
	5944	ZODN21 = ZVXY * ZSQN21
	5945	C
	5946	C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
	5947	C
	5948	ZUXY = 4. * ZXCH4ZXCH4/(0.113ZYCH4)
	5949	ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
	5950	ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
	5951	ZODH42 = ZVXY * ZSQH42
	5952	C
	5953	C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
	5954	C
	5955	ZUXY = 4. * ZXN2OZXN2O/(0.197ZYN2O)
	5956	ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
	5957	ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
	5958	ZODN22 = ZVXY * ZSQN22
	5959	C
	5960	C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
	5961	C
	5962	ZA11 = 2. * PUU(JL,23) * 4.404E+05
	5963	ZTTF11 = 1. - ZA11 * 0.003225
	5964	C
	5965	C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
	5966	C
	5967	ZA12 = 2. * PUU(JL,24) * 6.7435E+05
	5968	ZTTF12 = 1. - ZA12 * 0.003225
	5969	C
	5970	ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10
	5971	ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21
	5972	PTT(JL,10) = EXP( - PUU(JL,14) )
	5973	PTT(JL,11) = EXP( ZUU11 )
	5974	PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
	5975	PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
	5976	PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
	5977	PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 )
	5978	201 CONTINUE
	5979	C
	5980	RETURN
	5981	END
	5982	SUBROUTINE LWTTM(PGA,PGB,PUU1,PUU2, PTT)
	5983	IMPLICIT none
	5984	#include "dimensions.h"
	5985	#include "dimphy.h"
	5986	#include "raddim.h"
	5987	#include "raddimlw.h"
	5988	C
	5989	C ------------------------------------------------------------------
	5990	C PURPOSE.
	5991	C --------
	5992	C THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	5993	C ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
	5994	C INTERVALS.
	5995	C
	5996	C METHOD.
	5997	C -------
	5998	C
	5999	C 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
	6000	C COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
	6001	C 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
	6002	C 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
	6003	C A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
	6004	C
	6005	C REFERENCE.
	6006	C ----------
	6007	C
	6008	C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	6009	C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	6010	C
	6011	C AUTHOR.
	6012	C -------
	6013	C JEAN-JACQUES MORCRETTE ECMWF
	6014	C
	6015	C MODIFICATIONS.
	6016	C --------------
	6017	C ORIGINAL : 88-12-15
	6018	C
	6019	C-----------------------------------------------------------------------
	6020	REAL*8 O1H, O2H
	6021	PARAMETER (O1H=2230.)
	6022	PARAMETER (O2H=100.)
	6023	REAL*8 RPIALF0
	6024	PARAMETER (RPIALF0=2.0)
	6025	C
	6026	C* ARGUMENTS:
	6027	C
	6028	REAL*8 PGA(KDLON,8,2) ! PADE APPROXIMANTS
	6029	REAL*8 PGB(KDLON,8,2) ! PADE APPROXIMANTS
	6030	REAL*8 PUU1(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
	6031	REAL*8 PUU2(KDLON,NUA) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
	6032	REAL*8 PTT(KDLON,NTRA) ! TRANSMISSION FUNCTIONS
	6033	C
	6034	C* LOCAL VARIABLES:
	6035	C
	6036	INTEGER ja, jl
	6037	REAL*8 zz, zxd, zxn
	6038	REAL*8 zpu, zpu10, zpu11, zpu12, zpu13
	6039	REAL*8 zeu, zeu10, zeu11, zeu12, zeu13
	6040	REAL*8 zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
	6041	REAL*8 zxch4, zych4, zsqh41, zodh41
	6042	REAL*8 zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
	6043	REAL*8 zsqn22, zodn22, za11, zttf11, za12, zttf12
	6044	REAL*8 zuu11, zuu12
	6045	C ------------------------------------------------------------------
	6046	C
	6047	C* 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
	6048	C -----------------------------------------------
	6049	C
	6050	100 CONTINUE
	6051	C
	6052	C
	6053	DO 130 JA = 1 , 8
	6054	DO 120 JL = 1, KDLON
	6055	ZZ =SQRT(PUU1(JL,JA) - PUU2(JL,JA))
	6056	ZXD =PGB( JL,JA,1) + ZZ *(PGB( JL,JA,2) + ZZ )
	6057	ZXN =PGA( JL,JA,1) + ZZ *(PGA( JL,JA,2) )
	6058	PTT(JL,JA)=ZXN /ZXD
	6059	120 CONTINUE
	6060	130 CONTINUE
	6061	C
	6062	C ------------------------------------------------------------------
	6063	C
	6064	C* 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
	6065	C ---------------------------------------------------
	6066	C
	6067	200 CONTINUE
	6068	C
	6069	DO 201 JL = 1, KDLON
	6070	PTT(JL, 9) = PTT(JL, 8)
	6071	C
	6072	C- CONTINUUM ABSORPTION: E- AND P-TYPE
	6073	C
	6074	ZPU = 0.002 * (PUU1(JL,10) - PUU2(JL,10))
	6075	ZPU10 = 112. * ZPU
	6076	ZPU11 = 6.25 * ZPU
	6077	ZPU12 = 5.00 * ZPU
	6078	ZPU13 = 80.0 * ZPU
	6079	ZEU = (PUU1(JL,11) - PUU2(JL,11))
	6080	ZEU10 = 12. * ZEU
	6081	ZEU11 = 6.25 * ZEU
	6082	ZEU12 = 5.00 * ZEU
	6083	ZEU13 = 80.0 * ZEU
	6084	C
	6085	C- OZONE ABSORPTION
	6086	C
	6087	ZX = (PUU1(JL,12) - PUU2(JL,12))
	6088	ZY = (PUU1(JL,13) - PUU2(JL,13))
	6089	ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
	6090	ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
	6091	ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
	6092	ZVXY = RPIALF0 * ZY / (2. * ZX)
	6093	ZAERCN = (PUU1(JL,17) -PUU2(JL,17)) + ZEU12 + ZPU12
	6094	ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
	6095	ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
	6096	C
	6097	C-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
	6098	C
	6099	C* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
	6100	C
	6101	ZXCH4 = (PUU1(JL,19) - PUU2(JL,19))
	6102	ZYCH4 = (PUU1(JL,20) - PUU2(JL,20))
	6103	ZUXY = 4. * ZXCH4ZXCH4/(0.103ZYCH4)
	6104	ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
	6105	ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
	6106	ZODH41 = ZVXY * ZSQH41
	6107	C
	6108	C* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
	6109	C
	6110	ZXN2O = (PUU1(JL,21) - PUU2(JL,21))
	6111	ZYN2O = (PUU1(JL,22) - PUU2(JL,22))
	6112	ZUXY = 4. * ZXN2OZXN2O/(0.416ZYN2O)
	6113	ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
	6114	ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
	6115	ZODN21 = ZVXY * ZSQN21
	6116	C
	6117	C* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
	6118	C
	6119	ZUXY = 4. * ZXCH4ZXCH4/(0.113ZYCH4)
	6120	ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
	6121	ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
	6122	ZODH42 = ZVXY * ZSQH42
	6123	C
	6124	C* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
	6125	C
	6126	ZUXY = 4. * ZXN2OZXN2O/(0.197ZYN2O)
	6127	ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
	6128	ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
	6129	ZODN22 = ZVXY * ZSQN22
	6130	C
	6131	C* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
	6132	C
	6133	ZA11 = (PUU1(JL,23) - PUU2(JL,23)) * 4.404E+05
	6134	ZTTF11 = 1. - ZA11 * 0.003225
	6135	C
	6136	C* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
	6137	C
	6138	ZA12 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05
	6139	ZTTF12 = 1. - ZA12 * 0.003225
	6140	C
	6141	ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10
	6142	ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 -
	6143	S ZODH41 - ZODN21
	6144	PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(JL,14)) )
	6145	PTT(JL,11) = EXP( ZUU11 )
	6146	PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
	6147	PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
	6148	PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
	6149	PTT(JL,15) = EXP ( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 )
	6150	201 CONTINUE
	6151	C
	6152	RETURN
	6153	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format