Context Navigation

radlwsw.F @ 977

Last change on this file since 977 was 888, checked in by Laurent Fairhead, 17 years ago
Modifications sur l'albedo JG LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 200.1 KB

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

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

Download in other formats:

Original Format