Context Navigation

radlwsw.F @ 257

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

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

Download in other formats:

Original Format