Context Navigation

radlwsw.F @ 2166

Last change on this file since 2166 was 556, checked in by lmdzadmin, 20 years ago
Initialisations diverses necessaires au portage Prism AC LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 198.5 KB

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

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

Download in other formats:

Original Format