Context Navigation

radiation_AR4.F @ 1224

Last change on this file since 1224 was 1220, checked in by lguez, 16 years ago

-- Replaced "integer*4" declarations by "integer", "real*8" by

"real(kind=8)" and "real*4" by "real". Note that these are the only
modifications in the files "radiation_AR4.F" and "sw_aeroAR4.F90".

-- Corrected the kind of arguments to "max" and "min".

-- Replaced "nH" edit descriptors, which is a deleted feature in

Fortran 95, by character strings.

-- "regr_lat_time_climoz" now allows the pressure coordinate in the

input file to be in descending order.

-- Replaced call to not standard function "float" by call to intrinsic

function "real".

-- Included file "radepsi.h" in "physiq" was not used. Removed it.

The following set of modifications is related to the management of time.

-- In "gcm", "leapfrog" and "sortvarc0", "day_ini" was defined as 1

plus number of days between the reference date "(annee_ref,
day_ref)" and the first day of the current simulation. Changed
definition: "(annee_ref, day_ini)" is the first day of the current
simulation. There is an accompanying modification for "day_end".

-- Corrected bug in call to "ioconf_startdate" in "gcm".

-- Added call to "ioconf_calendar" in "create_etat0_limit".

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

File size: 189.5 KB

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

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

Download in other formats:

Original Format