Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

radiation_AR4.f90 @ 5449

Last change on this file since 5449 was 5185, checked in by abarral, 4 months ago
Replace REPROBUS CPP KEY by logical using handmade wonky wrapper
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 175.9 KB

Rev	Line
[1992]	1	! IM ctes ds clesphys.h SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC,
	2	SUBROUTINE sw_lmdar4(psct, prmu0, pfrac, ppmb, pdp, ppsol, palbd, palbp, &
[5144]	3	ptave, pwv, pqs, pozon, paer, pcldsw, ptau, pomega, pcg, pheat, pheat0, &
	4	palbpla, ptopsw, psolsw, ptopsw0, psolsw0, zfsup, zfsdn, zfsup0, zfsdn0, &
	5	tauae, pizae, cgae, ptaua, pomegaa, ptopswad, psolswad, ptopswai, &
	6	psolswai, ok_ade, ok_aie)
[1992]	7	USE dimphy
[5112]	8	USE lmdz_print_control, ONLY: lunout
[5137]	9	USE lmdz_clesphys
[5144]	10	USE lmdz_yomcst
[5160]	11	USE lmdz_phys_constants, ONLY: dobson_u
[5137]	12
[1992]	13	IMPLICIT NONE
[998]	14
[1992]	15	! ------------------------------------------------------------------
[1279]	16
[1992]	17	! PURPOSE.
	18	! --------
[1565]	19
[1992]	20	! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
	21	! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
[1565]	22
[1992]	23	! METHOD.
	24	! -------
[998]	25
[1992]	26	! 1. COMPUTES ABSORBER AMOUNTS (SWU)
	27	! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
	28	! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
	29
	30	! REFERENCE.
	31	! ----------
	32
	33	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	34	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	35
	36	! AUTHOR.
	37	! -------
	38	! JEAN-JACQUES MORCRETTE ECMWF
	39
	40	! MODIFICATIONS.
	41	! --------------
	42	! ORIGINAL : 89-07-14
	43	! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
	44	! 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
	45	! ------------------------------------------------------------------
	46
	47	! * ARGUMENTS:
	48
[5144]	49	REAL (KIND = 8) psct ! constante solaire (valeur conseillee: 1370)
[1992]	50	! IM ctes ds clesphys.h REAL(KIND=8) RCO2 ! concentration CO2 (IPCC:
	51	! 353.E-06*44.011/28.97)
	52
[5144]	53	REAL (KIND = 8) ppsol(kdlon) ! SURFACE PRESSURE (PA)
	54	REAL (KIND = 8) pdp(kdlon, kflev) ! LAYER THICKNESS (PA)
	55	REAL (KIND = 8) ppmb(kdlon, kflev + 1) ! HALF-LEVEL PRESSURE (MB)
[1992]	56
[5144]	57	REAL (KIND = 8) prmu0(kdlon) ! COSINE OF ZENITHAL ANGLE
	58	REAL (KIND = 8) pfrac(kdlon) ! fraction de la journee
[1992]	59
[5144]	60	REAL (KIND = 8) ptave(kdlon, kflev) ! LAYER TEMPERATURE (K)
	61	REAL (KIND = 8) pwv(kdlon, kflev) ! SPECIFIC HUMIDITY (KG/KG)
	62	REAL (KIND = 8) pqs(kdlon, kflev) ! SATURATED WATER VAPOUR (KG/KG)
	63	REAL (KIND = 8) pozon(kdlon, kflev) ! OZONE CONCENTRATION (KG/KG)
	64	REAL (KIND = 8) paer(kdlon, kflev, 5) ! AEROSOLS' OPTICAL THICKNESS
[1992]	65
[5144]	66	REAL (KIND = 8) palbd(kdlon, 2) ! albedo du sol (lumiere diffuse)
	67	REAL (KIND = 8) palbp(kdlon, 2) ! albedo du sol (lumiere parallele)
[1992]	68
[5144]	69	REAL (KIND = 8) pcldsw(kdlon, kflev) ! CLOUD FRACTION
	70	REAL (KIND = 8) ptau(kdlon, 2, kflev) ! CLOUD OPTICAL THICKNESS
	71	REAL (KIND = 8) pcg(kdlon, 2, kflev) ! ASYMETRY FACTOR
	72	REAL (KIND = 8) pomega(kdlon, 2, kflev) ! SINGLE SCATTERING ALBEDO
[1992]	73
[5144]	74	REAL (KIND = 8) pheat(kdlon, kflev) ! SHORTWAVE HEATING (K/DAY)
	75	REAL (KIND = 8) pheat0(kdlon, kflev) ! SHORTWAVE HEATING (K/DAY) clear-sky
	76	REAL (KIND = 8) palbpla(kdlon) ! PLANETARY ALBEDO
	77	REAL (KIND = 8) ptopsw(kdlon) ! SHORTWAVE FLUX AT T.O.A.
	78	REAL (KIND = 8) psolsw(kdlon) ! SHORTWAVE FLUX AT SURFACE
	79	REAL (KIND = 8) ptopsw0(kdlon) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
	80	REAL (KIND = 8) psolsw0(kdlon) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
[1992]	81
	82	! * LOCAL VARIABLES:
[5144]	83	REAL (KIND = 8) zoz(kdlon, kflev)
[1992]	84	! column-density of ozone in layer, in kilo-Dobsons
	85
[5144]	86	REAL (KIND = 8) zaki(kdlon, 2)
	87	REAL (KIND = 8) zcld(kdlon, kflev)
	88	REAL (KIND = 8) zclear(kdlon)
	89	REAL (KIND = 8) zdsig(kdlon, kflev)
	90	REAL (KIND = 8) zfact(kdlon)
	91	REAL (KIND = 8) zfd(kdlon, kflev + 1)
	92	REAL (KIND = 8) zfdown(kdlon, kflev + 1)
	93	REAL (KIND = 8) zfu(kdlon, kflev + 1)
	94	REAL (KIND = 8) zfup(kdlon, kflev + 1)
	95	REAL (KIND = 8) zrmu(kdlon)
	96	REAL (KIND = 8) zsec(kdlon)
	97	REAL (KIND = 8) zud(kdlon, 5, kflev + 1)
	98	REAL (KIND = 8) zcldsw0(kdlon, kflev)
[1992]	99
[5144]	100	REAL (KIND = 8) zfsup(kdlon, kflev + 1)
	101	REAL (KIND = 8) zfsdn(kdlon, kflev + 1)
	102	REAL (KIND = 8) zfsup0(kdlon, kflev + 1)
	103	REAL (KIND = 8) zfsdn0(kdlon, kflev + 1)
[1992]	104
	105	INTEGER inu, jl, jk, i, k, kpl1
	106
	107	INTEGER swpas ! Every swpas steps, sw is calculated
[5144]	108	PARAMETER (swpas = 1)
[1992]	109
	110	INTEGER itapsw
	111	LOGICAL appel1er
	112	DATA itapsw/0/
	113	DATA appel1er/.TRUE./
	114	SAVE itapsw, appel1er
	115	!$OMP THREADPRIVATE(appel1er)
	116	!$OMP THREADPRIVATE(itapsw)
	117	! jq-Introduced for aerosol forcings
[5144]	118	REAL (KIND = 8) flag_aer
[1992]	119	LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
[5144]	120	REAL (KIND = 8) tauae(kdlon, kflev, 2) ! aerosol optical properties
	121	REAL (KIND = 8) pizae(kdlon, kflev, 2) ! (see aeropt.F)
	122	REAL (KIND = 8) cgae(kdlon, kflev, 2) ! -"-
	123	REAL (KIND = 8) ptaua(kdlon, 2, kflev) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
	124	REAL (KIND = 8) pomegaa(kdlon, 2, kflev) ! SINGLE SCATTERING ALBEDO
	125	REAL (KIND = 8) ptopswad(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
	126	REAL (KIND = 8) psolswad(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
	127	REAL (KIND = 8) ptopswai(kdlon) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
	128	REAL (KIND = 8) psolswai(kdlon) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
[1992]	129	! jq - Fluxes including aerosol effects
[5144]	130	REAL (KIND = 8), ALLOCATABLE, SAVE :: zfsupad(:, :)
[1992]	131	!$OMP THREADPRIVATE(ZFSUPAD)
[5144]	132	REAL (KIND = 8), ALLOCATABLE, SAVE :: zfsdnad(:, :)
[1992]	133	!$OMP THREADPRIVATE(ZFSDNAD)
[5144]	134	REAL (KIND = 8), ALLOCATABLE, SAVE :: zfsupai(:, :)
[1992]	135	!$OMP THREADPRIVATE(ZFSUPAI)
[5144]	136	REAL (KIND = 8), ALLOCATABLE, SAVE :: zfsdnai(:, :)
[1992]	137	!$OMP THREADPRIVATE(ZFSDNAI)
	138	LOGICAL initialized
	139	! ym SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes
	140	! rv
	141	SAVE flag_aer
	142	!$OMP THREADPRIVATE(flag_aer)
	143	DATA initialized/.FALSE./
	144	SAVE initialized
	145	!$OMP THREADPRIVATE(initialized)
	146	! jq-end
	147	REAL tmp_
	148
	149	IF (.NOT. initialized) THEN
	150	flag_aer = 0.
	151	initialized = .TRUE.
[5144]	152	ALLOCATE (zfsupad(kdlon, kflev + 1))
	153	ALLOCATE (zfsdnad(kdlon, kflev + 1))
	154	ALLOCATE (zfsupai(kdlon, kflev + 1))
	155	ALLOCATE (zfsdnai(kdlon, kflev + 1))
[1992]	156
	157	zfsupad(:, :) = 0.
	158	zfsdnad(:, :) = 0.
	159	zfsupai(:, :) = 0.
	160	zfsdnai(:, :) = 0.
	161	END IF
	162
	163	IF (appel1er) THEN
	164	WRITE (lunout, *) 'SW calling frequency : ', swpas
	165	WRITE (lunout, *) ' In general, it should be 1'
	166	appel1er = .FALSE.
	167	END IF
	168	! ------------------------------------------------------------------
[5144]	169	IF (mod(itapsw, swpas)==0) THEN
[1992]	170
[5144]	171	tmp_ = 1. / (dobson_u * 1E3 * rg)
[1992]	172	! cdir collapse
	173	DO jk = 1, kflev
	174	DO jl = 1, kdlon
	175	zcldsw0(jl, jk) = 0.0
[5144]	176	zoz(jl, jk) = pozon(jl, jk) * tmp_ * pdp(jl, jk)
[1992]	177	END DO
	178	END DO
	179
	180
	181	! clear-sky:
	182	! IM ctes ds clesphys.h CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,
	183	CALL swu_lmdar4(psct, zcldsw0, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
[5144]	184	zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
[1992]	185	inu = 1
	186	CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
[5144]	187	pcg, zcld, zclear, zcldsw0, zdsig, pomega, zoz, zrmu, zsec, ptau, zud, &
	188	zfd, zfu)
[1992]	189	inu = 2
	190	CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
[5144]	191	palbp, pcg, zcld, zclear, zcldsw0, zdsig, pomega, zoz, zrmu, zsec, &
	192	ptau, zud, pwv, pqs, zfdown, zfup)
[1992]	193	DO jk = 1, kflev + 1
	194	DO jl = 1, kdlon
[5144]	195	zfsup0(jl, jk) = (zfup(jl, jk) + zfu(jl, jk)) * zfact(jl)
	196	zfsdn0(jl, jk) = (zfdown(jl, jk) + zfd(jl, jk)) * zfact(jl)
[1992]	197	END DO
	198	END DO
	199
	200	flag_aer = 0.0
	201	CALL swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
[5144]	202	zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
[1992]	203	inu = 1
	204	CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
[5144]	205	pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, ptau, zud, &
	206	zfd, zfu)
[1992]	207	inu = 2
	208	CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
[5144]	209	palbp, pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, ptau, &
	210	zud, pwv, pqs, zfdown, zfup)
[1992]	211
	212	! cloudy-sky:
	213
	214	DO jk = 1, kflev + 1
	215	DO jl = 1, kdlon
[5144]	216	zfsup(jl, jk) = (zfup(jl, jk) + zfu(jl, jk)) * zfact(jl)
	217	zfsdn(jl, jk) = (zfdown(jl, jk) + zfd(jl, jk)) * zfact(jl)
[1992]	218	END DO
	219	END DO
	220
	221	IF (ok_ade) THEN
	222
	223	! cloudy-sky + aerosol dir OB
	224	flag_aer = 1.0
	225	CALL swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
[5144]	226	zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
[1992]	227	inu = 1
	228	CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
[5144]	229	pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, ptau, zud, &
	230	zfd, zfu)
[1992]	231	inu = 2
	232	CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
[5144]	233	palbp, pcg, zcld, zclear, pcldsw, zdsig, pomega, zoz, zrmu, zsec, &
	234	ptau, zud, pwv, pqs, zfdown, zfup)
[1992]	235	DO jk = 1, kflev + 1
	236	DO jl = 1, kdlon
	237	zfsupad(jl, jk) = zfsup(jl, jk)
	238	zfsdnad(jl, jk) = zfsdn(jl, jk)
[5144]	239	zfsup(jl, jk) = (zfup(jl, jk) + zfu(jl, jk)) * zfact(jl)
	240	zfsdn(jl, jk) = (zfdown(jl, jk) + zfd(jl, jk)) * zfact(jl)
[1992]	241	END DO
	242	END DO
	243
	244	END IF ! ok_ade
	245
	246	IF (ok_aie) THEN
	247
	248	! jq cloudy-sky + aerosol direct + aerosol indirect
	249	flag_aer = 1.0
	250	CALL swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
[5144]	251	zaki, zcld, zclear, zdsig, zfact, zrmu, zsec, zud)
[1992]	252	inu = 1
	253	CALL sw1s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
[5144]	254	pcg, zcld, zclear, pcldsw, zdsig, pomegaa, zoz, zrmu, zsec, ptaua, &
	255	zud, zfd, zfu)
[1992]	256	inu = 2
	257	CALL sw2s_lmdar4(inu, paer, flag_aer, tauae, pizae, cgae, zaki, palbd, &
[5144]	258	palbp, pcg, zcld, zclear, pcldsw, zdsig, pomegaa, zoz, zrmu, zsec, &
	259	ptaua, zud, pwv, pqs, zfdown, zfup)
[1992]	260	DO jk = 1, kflev + 1
	261	DO jl = 1, kdlon
	262	zfsupai(jl, jk) = zfsup(jl, jk)
	263	zfsdnai(jl, jk) = zfsdn(jl, jk)
[5144]	264	zfsup(jl, jk) = (zfup(jl, jk) + zfu(jl, jk)) * zfact(jl)
	265	zfsdn(jl, jk) = (zfdown(jl, jk) + zfd(jl, jk)) * zfact(jl)
[1992]	266	END DO
	267	END DO
	268	END IF ! ok_aie
	269	! jq -end
	270
	271	itapsw = 0
	272	END IF
	273	itapsw = itapsw + 1
	274
	275	DO k = 1, kflev
	276	kpl1 = k + 1
	277	DO i = 1, kdlon
[5144]	278	pheat(i, k) = -(zfsup(i, kpl1) - zfsup(i, k)) - (zfsdn(i, k) - zfsdn(i, kpl1))
	279	pheat(i, k) = pheat(i, k) * rday * rg / rcpd / pdp(i, k)
	280	pheat0(i, k) = -(zfsup0(i, kpl1) - zfsup0(i, k)) - &
	281	(zfsdn0(i, k) - zfsdn0(i, kpl1))
	282	pheat0(i, k) = pheat0(i, k) * rday * rg / rcpd / pdp(i, k)
[1992]	283	END DO
	284	END DO
	285	DO i = 1, kdlon
[5144]	286	palbpla(i) = zfsup(i, kflev + 1) / (zfsdn(i, kflev + 1) + 1.0E-20)
[1992]	287
	288	psolsw(i) = zfsdn(i, 1) - zfsup(i, 1)
[5144]	289	ptopsw(i) = zfsdn(i, kflev + 1) - zfsup(i, kflev + 1)
[1992]	290
	291	psolsw0(i) = zfsdn0(i, 1) - zfsup0(i, 1)
[5144]	292	ptopsw0(i) = zfsdn0(i, kflev + 1) - zfsup0(i, kflev + 1)
[1992]	293	! -OB
	294	psolswad(i) = zfsdnad(i, 1) - zfsupad(i, 1)
[5144]	295	ptopswad(i) = zfsdnad(i, kflev + 1) - zfsupad(i, kflev + 1)
[1992]	296
	297	psolswai(i) = zfsdnai(i, 1) - zfsupai(i, 1)
[5144]	298	ptopswai(i) = zfsdnai(i, kflev + 1) - zfsupai(i, kflev + 1)
[1992]	299	! -fin
	300	END DO
	301
	302	END SUBROUTINE sw_lmdar4
	303
	304	! IM ctes ds clesphys.h SUBROUTINE SWU
	305	! (PSCT,RCO2,PCLDSW,PPMB,PPSOL,PRMU0,PFRAC,
	306	SUBROUTINE swu_lmdar4(psct, pcldsw, ppmb, ppsol, prmu0, pfrac, ptave, pwv, &
[5144]	307	paki, pcld, pclear, pdsig, pfact, prmu, psec, pud)
[1992]	308	USE dimphy
	309	USE radiation_ar4_param, ONLY: zpdh2o, zpdumg, zprh2o, zprumg, rtdh2o, &
[5144]	310	rtdumg, rth2o, rtumg
[5137]	311	USE lmdz_clesphys, ONLY: RCO2
[5144]	312	USE lmdz_yomcst
[5137]	313
[1992]	314	IMPLICIT NONE
	315	include "radepsi.h"
	316	include "radopt.h"
	317
	318	! * ARGUMENTS:
	319
[5144]	320	REAL (KIND = 8) psct
[5137]	321
[5144]	322	REAL (KIND = 8) pcldsw(kdlon, kflev)
	323	REAL (KIND = 8) ppmb(kdlon, kflev + 1)
	324	REAL (KIND = 8) ppsol(kdlon)
	325	REAL (KIND = 8) prmu0(kdlon)
	326	REAL (KIND = 8) pfrac(kdlon)
	327	REAL (KIND = 8) ptave(kdlon, kflev)
	328	REAL (KIND = 8) pwv(kdlon, kflev)
[1992]	329
[5144]	330	REAL (KIND = 8) paki(kdlon, 2)
	331	REAL (KIND = 8) pcld(kdlon, kflev)
	332	REAL (KIND = 8) pclear(kdlon)
	333	REAL (KIND = 8) pdsig(kdlon, kflev)
	334	REAL (KIND = 8) pfact(kdlon)
	335	REAL (KIND = 8) prmu(kdlon)
	336	REAL (KIND = 8) psec(kdlon)
	337	REAL (KIND = 8) pud(kdlon, 5, kflev + 1)
[1992]	338
	339	! * LOCAL VARIABLES:
	340
	341	INTEGER iind(2)
[5144]	342	REAL (KIND = 8) zc1j(kdlon, kflev + 1)
	343	REAL (KIND = 8) zclear(kdlon)
	344	REAL (KIND = 8) zcloud(kdlon)
	345	REAL (KIND = 8) zn175(kdlon)
	346	REAL (KIND = 8) zn190(kdlon)
	347	REAL (KIND = 8) zo175(kdlon)
	348	REAL (KIND = 8) zo190(kdlon)
	349	REAL (KIND = 8) zsign(kdlon)
	350	REAL (KIND = 8) zr(kdlon, 2)
	351	REAL (KIND = 8) zsigo(kdlon)
	352	REAL (KIND = 8) zud(kdlon, 2)
	353	REAL (KIND = 8) zrth, zrtu, zwh2o, zdsco2, zdsh2o, zfppw
[1992]	354	INTEGER jl, jk, jkp1, jkl, jklp1, ja
	355
	356	! ------------------------------------------------------------------
	357
	358	! * 1. COMPUTES AMOUNTS OF ABSORBERS
	359	! -----------------------------
	360
	361	iind(1) = 1
	362	iind(2) = 2
	363
	364	! * 1.1 INITIALIZES QUANTITIES
	365	! ----------------------
	366
	367	DO jl = 1, kdlon
[5144]	368	pud(jl, 1, kflev + 1) = 0.
	369	pud(jl, 2, kflev + 1) = 0.
	370	pud(jl, 3, kflev + 1) = 0.
	371	pud(jl, 4, kflev + 1) = 0.
	372	pud(jl, 5, kflev + 1) = 0.
	373	pfact(jl) = prmu0(jl) * pfrac(jl) * psct
	374	prmu(jl) = sqrt(1224. * prmu0(jl) * prmu0(jl) + 1.) / 35.
	375	psec(jl) = 1. / prmu(jl)
	376	zc1j(jl, kflev + 1) = 0.
[1992]	377	END DO
	378
	379	! * 1.3 AMOUNTS OF ABSORBERS
	380	! --------------------
	381
	382	DO jl = 1, kdlon
	383	zud(jl, 1) = 0.
	384	zud(jl, 2) = 0.
[5144]	385	zo175(jl) = ppsol(jl)**(zpdumg + 1.)
	386	zo190(jl) = ppsol(jl)**(zpdh2o + 1.)
[1992]	387	zsigo(jl) = ppsol(jl)
	388	zclear(jl) = 1.
	389	zcloud(jl) = 0.
	390	END DO
	391
	392	DO jk = 1, kflev
	393	jkp1 = jk + 1
	394	jkl = kflev + 1 - jk
	395	jklp1 = jkl + 1
	396	DO jl = 1, kdlon
[5144]	397	zrth = (rth2o / ptave(jl, jk))**rtdh2o
	398	zrtu = (rtumg / ptave(jl, jk))**rtdumg
	399	zwh2o = max(pwv(jl, jk), zepscq)
	400	zsign(jl) = 100. * ppmb(jl, jkp1)
	401	pdsig(jl, jk) = (zsigo(jl) - zsign(jl)) / ppsol(jl)
	402	zn175(jl) = zsign(jl)**(zpdumg + 1.)
	403	zn190(jl) = zsign(jl)**(zpdh2o + 1.)
[1992]	404	zdsco2 = zo175(jl) - zn175(jl)
	405	zdsh2o = zo190(jl) - zn190(jl)
[5144]	406	pud(jl, 1, jk) = 1. / (10. * rg * (zpdh2o + 1.)) / (zprh2o*zpdh2o) zdsh2o * zwh2o * &
	407	zrth
	408	pud(jl, 2, jk) = 1. / (10. * rg * (zpdumg + 1.)) / (zprumg*zpdumg) zdsco2 * rco2 * &
	409	zrtu
	410	zfppw = 1.6078 * zwh2o / (1. + 0.608 * zwh2o)
	411	pud(jl, 4, jk) = pud(jl, 1, jk) * zfppw
	412	pud(jl, 5, jk) = pud(jl, 1, jk) * (1. - zfppw)
[1992]	413	zud(jl, 1) = zud(jl, 1) + pud(jl, 1, jk)
	414	zud(jl, 2) = zud(jl, 2) + pud(jl, 2, jk)
	415	zsigo(jl) = zsign(jl)
	416	zo175(jl) = zn175(jl)
	417	zo190(jl) = zn190(jl)
	418
	419	IF (novlp==1) THEN
[5144]	420	zclear(jl) = zclear(jl) * (1. - max(pcldsw(jl, jkl), zcloud(jl))) / (1. - min(&
	421	zcloud(jl), 1. - zepsec))
[1992]	422	zc1j(jl, jkl) = 1.0 - zclear(jl)
	423	zcloud(jl) = pcldsw(jl, jkl)
	424	ELSE IF (novlp==2) THEN
[5144]	425	zcloud(jl) = max(pcldsw(jl, jkl), zcloud(jl))
[1992]	426	zc1j(jl, jkl) = zcloud(jl)
	427	ELSE IF (novlp==3) THEN
[5144]	428	zclear(jl) = zclear(jl) * (1. - pcldsw(jl, jkl))
[1992]	429	zcloud(jl) = 1.0 - zclear(jl)
	430	zc1j(jl, jkl) = zcloud(jl)
[998]	431	END IF
[1992]	432	END DO
	433	END DO
	434	DO jl = 1, kdlon
	435	pclear(jl) = 1. - zc1j(jl, 1)
	436	END DO
	437	DO jk = 1, kflev
	438	DO jl = 1, kdlon
	439	IF (pclear(jl)<1.) THEN
[5144]	440	pcld(jl, jk) = pcldsw(jl, jk) / (1. - pclear(jl))
[998]	441	ELSE
[1992]	442	pcld(jl, jk) = 0.
[998]	443	END IF
[1992]	444	END DO
	445	END DO
	446
	447	! * 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
	448	! -----------------------------------------------
	449
	450	DO ja = 1, 2
	451	DO jl = 1, kdlon
[5144]	452	zud(jl, ja) = zud(jl, ja) * psec(jl)
[1992]	453	END DO
	454	END DO
	455
	456	CALL swtt1_lmdar4(2, 2, iind, zud, zr)
	457
	458	DO ja = 1, 2
	459	DO jl = 1, kdlon
[5144]	460	paki(jl, ja) = -log(zr(jl, ja)) / zud(jl, ja)
[1992]	461	END DO
	462	END DO
	463
	464
	465	! ------------------------------------------------------------------
	466
	467	END SUBROUTINE swu_lmdar4
	468	SUBROUTINE sw1s_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbd, palbp, &
[5144]	469	pcg, pcld, pclear, pcldsw, pdsig, pomega, poz, prmu, psec, ptau, pud, &
	470	pfd, pfu)
[1992]	471	USE dimphy
	472	USE radiation_ar4_param, ONLY: rsun, rray
[4389]	473	USE infotrac_phy, ONLY: type_trac
[5185]	474	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
	475	USE lmdz_reprobus_wrappers, ONLY: rsuntime, ok_suntime
[5112]	476	USE lmdz_print_control, ONLY: lunout
[1565]	477
[1992]	478	IMPLICIT NONE
[1279]	479
[1992]	480	! ------------------------------------------------------------------
	481	! PURPOSE.
	482	! --------
	483
	484	! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
	485	! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
	486
	487	! METHOD.
	488	! -------
	489
	490	! 1. COMPUTES UPWARD AND DOWNWARD FLUXES CORRESPONDING TO
	491	! CONTINUUM SCATTERING
	492	! 2. MULTIPLY BY OZONE TRANSMISSION FUNCTION
	493
	494	! REFERENCE.
	495	! ----------
	496
	497	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	498	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	499
	500	! AUTHOR.
	501	! -------
	502	! JEAN-JACQUES MORCRETTE ECMWF
	503
	504	! MODIFICATIONS.
	505	! --------------
	506	! ORIGINAL : 89-07-14
	507	! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
	508	! ------------------------------------------------------------------
	509
	510	! * ARGUMENTS:
	511
	512	INTEGER knu
	513	! -OB
[5144]	514	REAL (KIND = 8) flag_aer
	515	REAL (KIND = 8) tauae(kdlon, kflev, 2)
	516	REAL (KIND = 8) pizae(kdlon, kflev, 2)
	517	REAL (KIND = 8) cgae(kdlon, kflev, 2)
	518	REAL (KIND = 8) paer(kdlon, kflev, 5)
	519	REAL (KIND = 8) palbd(kdlon, 2)
	520	REAL (KIND = 8) palbp(kdlon, 2)
	521	REAL (KIND = 8) pcg(kdlon, 2, kflev)
	522	REAL (KIND = 8) pcld(kdlon, kflev)
	523	REAL (KIND = 8) pcldsw(kdlon, kflev)
	524	REAL (KIND = 8) pclear(kdlon)
	525	REAL (KIND = 8) pdsig(kdlon, kflev)
	526	REAL (KIND = 8) pomega(kdlon, 2, kflev)
	527	REAL (KIND = 8) poz(kdlon, kflev)
	528	REAL (KIND = 8) prmu(kdlon)
	529	REAL (KIND = 8) psec(kdlon)
	530	REAL (KIND = 8) ptau(kdlon, 2, kflev)
	531	REAL (KIND = 8) pud(kdlon, 5, kflev + 1)
[1992]	532
[5144]	533	REAL (KIND = 8) pfd(kdlon, kflev + 1)
	534	REAL (KIND = 8) pfu(kdlon, kflev + 1)
[1992]	535
	536	! * LOCAL VARIABLES:
	537
	538	INTEGER iind(4)
	539
[5144]	540	REAL (KIND = 8) zcgaz(kdlon, kflev)
	541	REAL (KIND = 8) zdiff(kdlon)
	542	REAL (KIND = 8) zdirf(kdlon)
	543	REAL (KIND = 8) zpizaz(kdlon, kflev)
	544	REAL (KIND = 8) zrayl(kdlon)
	545	REAL (KIND = 8) zray1(kdlon, kflev + 1)
	546	REAL (KIND = 8) zray2(kdlon, kflev + 1)
	547	REAL (KIND = 8) zrefz(kdlon, 2, kflev + 1)
	548	REAL (KIND = 8) zrj(kdlon, 6, kflev + 1)
	549	REAL (KIND = 8) zrj0(kdlon, 6, kflev + 1)
	550	REAL (KIND = 8) zrk(kdlon, 6, kflev + 1)
	551	REAL (KIND = 8) zrk0(kdlon, 6, kflev + 1)
	552	REAL (KIND = 8) zrmue(kdlon, kflev + 1)
	553	REAL (KIND = 8) zrmu0(kdlon, kflev + 1)
	554	REAL (KIND = 8) zr(kdlon, 4)
	555	REAL (KIND = 8) ztauaz(kdlon, kflev)
	556	REAL (KIND = 8) ztra1(kdlon, kflev + 1)
	557	REAL (KIND = 8) ztra2(kdlon, kflev + 1)
	558	REAL (KIND = 8) zw(kdlon, 4)
[1992]	559
	560	INTEGER jl, jk, k, jaj, ikm1, ikl
	561
	562	! If running with Reporbus, overwrite default values of RSUN.
	563	! Otherwise keep default values from radiation_AR4_param module.
[4389]	564	IF (type_trac=='repr') THEN
[5185]	565	IF (CPPKEY_REPROBUS) THEN
	566	IF (ok_suntime) THEN
	567	rsun(1) = rsuntime(1)
	568	rsun(2) = rsuntime(2)
	569	END IF
	570	WRITE (lunout, *) 'RSUN(1): ', rsun(1)
[1992]	571	END IF
	572	END IF
[1565]	573
[1992]	574	! ------------------------------------------------------------------
	575
	576	! * 1. FIRST SPECTRAL INTERVAL (0.25-0.68 MICRON)
	577	! ----------------------- ------------------
	578
	579
	580
	581	! * 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
	582	! -----------------------------------------
	583
	584	DO jl = 1, kdlon
[5144]	585	zrayl(jl) = rray(knu, 1) + prmu(jl) * (rray(knu, 2) + prmu(jl) * (rray(knu, &
	586	3) + prmu(jl) * (rray(knu, 4) + prmu(jl) * (rray(knu, 5) + prmu(jl) * rray(knu, 6)))))
[1992]	587	END DO
	588
	589
	590	! ------------------------------------------------------------------
	591
	592	! * 2. CONTINUUM SCATTERING CALCULATIONS
	593	! ---------------------------------
	594
	595
	596	! * 2.1 CLEAR-SKY FRACTION OF THE COLUMN
	597	! --------------------------------
	598
	599	CALL swclr_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
[5144]	600	zrayl, psec, zcgaz, zpizaz, zray1, zray2, zrefz, zrj0, zrk0, zrmu0, &
	601	ztauaz, ztra1, ztra2)
[1992]	602
	603	! * 2.2 CLOUDY FRACTION OF THE COLUMN
	604	! -----------------------------
	605
	606	CALL swr_lmdar4(knu, palbd, pcg, pcld, pdsig, pomega, zrayl, psec, ptau, &
[5144]	607	zcgaz, zpizaz, zray1, zray2, zrefz, zrj, zrk, zrmue, ztauaz, ztra1, &
	608	ztra2)
[1992]	609
	610	! ------------------------------------------------------------------
	611
	612	! * 3. OZONE ABSORPTION
	613	! ----------------
	614
	615	iind(1) = 1
	616	iind(2) = 3
	617	iind(3) = 1
	618	iind(4) = 3
	619
	620	! * 3.1 DOWNWARD FLUXES
	621	! ---------------
	622
	623	jaj = 2
	624
	625	DO jl = 1, kdlon
	626	zw(jl, 1) = 0.
	627	zw(jl, 2) = 0.
	628	zw(jl, 3) = 0.
	629	zw(jl, 4) = 0.
[5144]	630	pfd(jl, kflev + 1) = ((1. - pclear(jl)) * zrj(jl, jaj, kflev + 1) + pclear(jl) * zrj0(&
	631	jl, jaj, kflev + 1)) * rsun(knu)
[1992]	632	END DO
	633	DO jk = 1, kflev
	634	ikl = kflev + 1 - jk
	635	DO jl = 1, kdlon
[5144]	636	zw(jl, 1) = zw(jl, 1) + pud(jl, 1, ikl) / zrmue(jl, ikl)
	637	zw(jl, 2) = zw(jl, 2) + poz(jl, ikl) / zrmue(jl, ikl)
	638	zw(jl, 3) = zw(jl, 3) + pud(jl, 1, ikl) / zrmu0(jl, ikl)
	639	zw(jl, 4) = zw(jl, 4) + poz(jl, ikl) / zrmu0(jl, ikl)
[1992]	640	END DO
	641
	642	CALL swtt1_lmdar4(knu, 4, iind, zw, zr)
	643
	644	DO jl = 1, kdlon
[5144]	645	zdiff(jl) = zr(jl, 1) * zr(jl, 2) * zrj(jl, jaj, ikl)
	646	zdirf(jl) = zr(jl, 3) * zr(jl, 4) * zrj0(jl, jaj, ikl)
	647	pfd(jl, ikl) = ((1. - pclear(jl)) * zdiff(jl) + pclear(jl) * zdirf(jl)) * &
	648	rsun(knu)
[1992]	649	END DO
	650	END DO
	651
	652	! * 3.2 UPWARD FLUXES
	653	! -------------
	654
	655	DO jl = 1, kdlon
[5144]	656	pfu(jl, 1) = ((1. - pclear(jl)) * zdiff(jl) * palbd(jl, knu) + pclear(jl) * zdirf(jl &
	657	) * palbp(jl, knu)) * rsun(knu)
[1992]	658	END DO
	659
	660	DO jk = 2, kflev + 1
	661	ikm1 = jk - 1
	662	DO jl = 1, kdlon
[5144]	663	zw(jl, 1) = zw(jl, 1) + pud(jl, 1, ikm1) * 1.66
	664	zw(jl, 2) = zw(jl, 2) + poz(jl, ikm1) * 1.66
	665	zw(jl, 3) = zw(jl, 3) + pud(jl, 1, ikm1) * 1.66
	666	zw(jl, 4) = zw(jl, 4) + poz(jl, ikm1) * 1.66
[1992]	667	END DO
	668
	669	CALL swtt1_lmdar4(knu, 4, iind, zw, zr)
	670
	671	DO jl = 1, kdlon
[5144]	672	zdiff(jl) = zr(jl, 1) * zr(jl, 2) * zrk(jl, jaj, jk)
	673	zdirf(jl) = zr(jl, 3) * zr(jl, 4) * zrk0(jl, jaj, jk)
	674	pfu(jl, jk) = ((1. - pclear(jl)) * zdiff(jl) + pclear(jl) * zdirf(jl)) * &
	675	rsun(knu)
[1992]	676	END DO
	677	END DO
	678
	679	! ------------------------------------------------------------------
	680
	681	END SUBROUTINE sw1s_lmdar4
	682	SUBROUTINE sw2s_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, paki, palbd, &
[5144]	683	palbp, pcg, pcld, pclear, pcldsw, pdsig, pomega, poz, prmu, psec, ptau, &
	684	pud, pwv, pqs, pfdown, pfup)
[1992]	685	USE dimphy
	686	USE radiation_ar4_param, ONLY: rsun, rray
[4389]	687	USE infotrac_phy, ONLY: type_trac
[5185]	688	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
	689	USE lmdz_reprobus_wrappers, ONLY: rsuntime, ok_suntime
[1565]	690
[1992]	691	IMPLICIT NONE
	692	include "radepsi.h"
[1565]	693
[1992]	694	! ------------------------------------------------------------------
	695	! PURPOSE.
	696	! --------
	697
	698	! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN THE
	699	! SECOND SPECTRAL INTERVAL FOLLOWING FOUQUART AND BONNEL (1980).
	700
	701	! METHOD.
	702	! -------
	703
	704	! 1. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING TO
	705	! CONTINUUM SCATTERING
	706	! 2. COMPUTES REFLECTIVITY/TRANSMISSIVITY CORRESPONDING FOR
	707	! A GREY MOLECULAR ABSORPTION
	708	! 3. LAPLACE TRANSFORM ON THE PREVIOUS TO GET EFFECTIVE AMOUNTS
	709	! OF ABSORBERS
	710	! 4. APPLY H2O AND U.M.G. TRANSMISSION FUNCTIONS
	711	! 5. MULTIPLY BY OZONE TRANSMISSION FUNCTION
	712
	713	! REFERENCE.
	714	! ----------
	715
	716	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	717	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	718
	719	! AUTHOR.
	720	! -------
	721	! JEAN-JACQUES MORCRETTE ECMWF
	722
	723	! MODIFICATIONS.
	724	! --------------
	725	! ORIGINAL : 89-07-14
	726	! 94-11-15 J.-J. MORCRETTE DIRECT/DIFFUSE ALBEDO
	727	! ------------------------------------------------------------------
	728	! * ARGUMENTS:
	729
	730	INTEGER knu
	731	! -OB
[5144]	732	REAL (KIND = 8) flag_aer
	733	REAL (KIND = 8) tauae(kdlon, kflev, 2)
	734	REAL (KIND = 8) pizae(kdlon, kflev, 2)
	735	REAL (KIND = 8) cgae(kdlon, kflev, 2)
	736	REAL (KIND = 8) paer(kdlon, kflev, 5)
	737	REAL (KIND = 8) paki(kdlon, 2)
	738	REAL (KIND = 8) palbd(kdlon, 2)
	739	REAL (KIND = 8) palbp(kdlon, 2)
	740	REAL (KIND = 8) pcg(kdlon, 2, kflev)
	741	REAL (KIND = 8) pcld(kdlon, kflev)
	742	REAL (KIND = 8) pcldsw(kdlon, kflev)
	743	REAL (KIND = 8) pclear(kdlon)
	744	REAL (KIND = 8) pdsig(kdlon, kflev)
	745	REAL (KIND = 8) pomega(kdlon, 2, kflev)
	746	REAL (KIND = 8) poz(kdlon, kflev)
	747	REAL (KIND = 8) pqs(kdlon, kflev)
	748	REAL (KIND = 8) prmu(kdlon)
	749	REAL (KIND = 8) psec(kdlon)
	750	REAL (KIND = 8) ptau(kdlon, 2, kflev)
	751	REAL (KIND = 8) pud(kdlon, 5, kflev + 1)
	752	REAL (KIND = 8) pwv(kdlon, kflev)
[1992]	753
[5144]	754	REAL (KIND = 8) pfdown(kdlon, kflev + 1)
	755	REAL (KIND = 8) pfup(kdlon, kflev + 1)
[1992]	756
	757	! * LOCAL VARIABLES:
	758
	759	INTEGER iind2(2), iind3(3)
[5144]	760	REAL (KIND = 8) zcgaz(kdlon, kflev)
	761	REAL (KIND = 8) zfd(kdlon, kflev + 1)
	762	REAL (KIND = 8) zfu(kdlon, kflev + 1)
	763	REAL (KIND = 8) zg(kdlon)
	764	REAL (KIND = 8) zgg(kdlon)
	765	REAL (KIND = 8) zpizaz(kdlon, kflev)
	766	REAL (KIND = 8) zrayl(kdlon)
	767	REAL (KIND = 8) zray1(kdlon, kflev + 1)
	768	REAL (KIND = 8) zray2(kdlon, kflev + 1)
	769	REAL (KIND = 8) zref(kdlon)
	770	REAL (KIND = 8) zrefz(kdlon, 2, kflev + 1)
	771	REAL (KIND = 8) zre1(kdlon)
	772	REAL (KIND = 8) zre2(kdlon)
	773	REAL (KIND = 8) zrj(kdlon, 6, kflev + 1)
	774	REAL (KIND = 8) zrj0(kdlon, 6, kflev + 1)
	775	REAL (KIND = 8) zrk(kdlon, 6, kflev + 1)
	776	REAL (KIND = 8) zrk0(kdlon, 6, kflev + 1)
	777	REAL (KIND = 8) zrl(kdlon, 8)
	778	REAL (KIND = 8) zrmue(kdlon, kflev + 1)
	779	REAL (KIND = 8) zrmu0(kdlon, kflev + 1)
	780	REAL (KIND = 8) zrmuz(kdlon)
	781	REAL (KIND = 8) zrneb(kdlon)
	782	REAL (KIND = 8) zruef(kdlon, 8)
	783	REAL (KIND = 8) zr1(kdlon)
	784	REAL (KIND = 8) zr2(kdlon, 2)
	785	REAL (KIND = 8) zr3(kdlon, 3)
	786	REAL (KIND = 8) zr4(kdlon)
	787	REAL (KIND = 8) zr21(kdlon)
	788	REAL (KIND = 8) zr22(kdlon)
	789	REAL (KIND = 8) zs(kdlon)
	790	REAL (KIND = 8) ztauaz(kdlon, kflev)
	791	REAL (KIND = 8) zto1(kdlon)
	792	REAL (KIND = 8) ztr(kdlon, 2, kflev + 1)
	793	REAL (KIND = 8) ztra1(kdlon, kflev + 1)
	794	REAL (KIND = 8) ztra2(kdlon, kflev + 1)
	795	REAL (KIND = 8) ztr1(kdlon)
	796	REAL (KIND = 8) ztr2(kdlon)
	797	REAL (KIND = 8) zw(kdlon)
	798	REAL (KIND = 8) zw1(kdlon)
	799	REAL (KIND = 8) zw2(kdlon, 2)
	800	REAL (KIND = 8) zw3(kdlon, 3)
	801	REAL (KIND = 8) zw4(kdlon)
	802	REAL (KIND = 8) zw5(kdlon)
[1992]	803
	804	INTEGER jl, jk, k, jaj, ikm1, ikl, jn, jabs, jkm1
	805	INTEGER jref, jkl, jklp1, jajp, jkki, jkkp4, jn2j, iabs
[5144]	806	REAL (KIND = 8) zrmum1, zwh2o, zcneb, zaa, zbb, zrki, zre11
[1992]	807
	808	! If running with Reporbus, overwrite default values of RSUN.
	809	! Otherwise keep default values from radiation_AR4_param module.
[4389]	810	IF (type_trac=='repr') THEN
[5185]	811	IF (CPPKEY_REPROBUS) THEN
	812	IF (ok_suntime) THEN
	813	rsun(1) = rsuntime(1)
	814	rsun(2) = rsuntime(2)
	815	END IF
[1992]	816	END IF
	817	END IF
[1565]	818
[1992]	819	! ------------------------------------------------------------------
[1279]	820
[1992]	821	! * 1. SECOND SPECTRAL INTERVAL (0.68-4.00 MICRON)
	822	! -------------------------------------------
	823
	824
	825
	826	! * 1.1 OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
	827	! -----------------------------------------
	828
	829	DO jl = 1, kdlon
	830	zrmum1 = 1. - prmu(jl)
[5144]	831	zrayl(jl) = rray(knu, 1) + zrmum1 * (rray(knu, 2) + zrmum1 * (rray(knu, &
	832	3) + zrmum1 * (rray(knu, 4) + zrmum1 * (rray(knu, 5) + zrmum1 * rray(knu, 6)))))
[1992]	833	END DO
	834
	835	! ------------------------------------------------------------------
	836
	837	! * 2. CONTINUUM SCATTERING CALCULATIONS
	838	! ---------------------------------
	839
	840
	841	! * 2.1 CLEAR-SKY FRACTION OF THE COLUMN
	842	! --------------------------------
	843
	844	CALL swclr_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbp, pdsig, &
[5144]	845	zrayl, psec, zcgaz, zpizaz, zray1, zray2, zrefz, zrj0, zrk0, zrmu0, &
	846	ztauaz, ztra1, ztra2)
[1992]	847
	848	! * 2.2 CLOUDY FRACTION OF THE COLUMN
	849	! -----------------------------
	850
	851	CALL swr_lmdar4(knu, palbd, pcg, pcld, pdsig, pomega, zrayl, psec, ptau, &
[5144]	852	zcgaz, zpizaz, zray1, zray2, zrefz, zrj, zrk, zrmue, ztauaz, ztra1, &
	853	ztra2)
[1992]	854
	855	! ------------------------------------------------------------------
	856
	857	! * 3. SCATTERING CALCULATIONS WITH GREY MOLECULAR ABSORPTION
	858	! ------------------------------------------------------
	859
	860	jn = 2
	861
	862	DO jabs = 1, 2
	863	! * 3.1 SURFACE CONDITIONS
	864	! ------------------
	865
	866	DO jl = 1, kdlon
	867	zrefz(jl, 2, 1) = palbd(jl, knu)
	868	zrefz(jl, 1, 1) = palbd(jl, knu)
	869	END DO
	870
	871	! * 3.2 INTRODUCING CLOUD EFFECTS
	872	! -------------------------
	873
	874	DO jk = 2, kflev + 1
	875	jkm1 = jk - 1
	876	ikl = kflev + 1 - jkm1
	877	DO jl = 1, kdlon
	878	zrneb(jl) = pcld(jl, jkm1)
[5144]	879	IF (jabs==1 .AND. zrneb(jl)>2. * zeelog) THEN
	880	zwh2o = max(pwv(jl, jkm1), zeelog)
	881	zcneb = max(zeelog, min(zrneb(jl), 1. - zeelog))
	882	zbb = pud(jl, jabs, jkm1) * pqs(jl, jkm1) / zwh2o
	883	zaa = max((pud(jl, jabs, jkm1) - zcneb * zbb) / (1. - zcneb), zeelog)
[1992]	884	ELSE
	885	zaa = pud(jl, jabs, jkm1)
	886	zbb = zaa
	887	END IF
	888	zrki = paki(jl, jabs)
[5144]	889	zs(jl) = exp(-zrki * zaa * 1.66)
	890	zg(jl) = exp(-zrki * zaa / zrmue(jl, jk))
[1992]	891	ztr1(jl) = 0.
	892	zre1(jl) = 0.
	893	ztr2(jl) = 0.
	894	zre2(jl) = 0.
	895
	896	zw(jl) = pomega(jl, knu, jkm1)
[5144]	897	zto1(jl) = ptau(jl, knu, jkm1) / zw(jl) + ztauaz(jl, jkm1) / zpizaz(jl, &
	898	jkm1) + zbb * zrki
[1992]	899
	900	zr21(jl) = ptau(jl, knu, jkm1) + ztauaz(jl, jkm1)
[5144]	901	zr22(jl) = ptau(jl, knu, jkm1) / zr21(jl)
	902	zgg(jl) = zr22(jl) * pcg(jl, knu, jkm1) + (1. - zr22(jl)) * zcgaz(jl, jkm1)
	903	zw(jl) = zr21(jl) / zto1(jl)
[1992]	904	zref(jl) = zrefz(jl, 1, jkm1)
	905	zrmuz(jl) = zrmue(jl, jk)
	906	END DO
	907
	908	CALL swde_lmdar4(zgg, zref, zrmuz, zto1, zw, zre1, zre2, ztr1, ztr2)
	909
	910	DO jl = 1, kdlon
	911
[5144]	912	zrefz(jl, 2, jk) = (1. - zrneb(jl)) * (zray1(jl, jkm1) + zrefz(jl, 2, jkm1) * &
	913	ztra1(jl, jkm1) * ztra2(jl, jkm1)) * zg(jl) * zs(jl) + zrneb(jl) * zre1(jl)
[1992]	914
[5144]	915	ztr(jl, 2, jkm1) = zrneb(jl) * ztr1(jl) + (ztra1(jl, jkm1)) * zg(jl) * (1. - &
	916	zrneb(jl))
[1992]	917
[5144]	918	zrefz(jl, 1, jk) = (1. - zrneb(jl)) * (zray1(jl, jkm1) + zrefz(jl, 1, jkm1) * &
	919	ztra1(jl, jkm1) * ztra2(jl, jkm1) / (1. - zray2(jl, jkm1) * zrefz(jl, 1, &
	920	jkm1))) * zg(jl) * zs(jl) + zrneb(jl) * zre2(jl)
[1992]	921
[5144]	922	ztr(jl, 1, jkm1) = zrneb(jl) * ztr2(jl) + (ztra1(jl, jkm1) / (1. - zray2(jl, &
	923	jkm1) * zrefz(jl, 1, jkm1))) * zg(jl) * (1. - zrneb(jl))
[1992]	924
	925	END DO
	926	END DO
	927
	928	! * 3.3 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
	929	! -------------------------------------------------
	930
	931	DO jref = 1, 2
	932
	933	jn = jn + 1
	934
	935	DO jl = 1, kdlon
[5144]	936	zrj(jl, jn, kflev + 1) = 1.
	937	zrk(jl, jn, kflev + 1) = zrefz(jl, jref, kflev + 1)
[1992]	938	END DO
	939
	940	DO jk = 1, kflev
	941	jkl = kflev + 1 - jk
	942	jklp1 = jkl + 1
	943	DO jl = 1, kdlon
[5144]	944	zre11 = zrj(jl, jn, jklp1) * ztr(jl, jref, jkl)
[1992]	945	zrj(jl, jn, jkl) = zre11
[5144]	946	zrk(jl, jn, jkl) = zre11 * zrefz(jl, jref, jkl)
[1992]	947	END DO
	948	END DO
	949	END DO
	950	END DO
	951
	952	! ------------------------------------------------------------------
	953
	954	! * 4. INVERT GREY AND CONTINUUM FLUXES
	955	! --------------------------------
	956
	957
	958
	959	! * 4.1 UPWARD (ZRK) AND DOWNWARD (ZRJ) PSEUDO-FLUXES
	960	! ---------------------------------------------
	961
	962	DO jk = 1, kflev + 1
	963	DO jaj = 1, 5, 2
	964	jajp = jaj + 1
	965	DO jl = 1, kdlon
	966	zrj(jl, jaj, jk) = zrj(jl, jaj, jk) - zrj(jl, jajp, jk)
	967	zrk(jl, jaj, jk) = zrk(jl, jaj, jk) - zrk(jl, jajp, jk)
[5144]	968	zrj(jl, jaj, jk) = max(zrj(jl, jaj, jk), zeelog)
	969	zrk(jl, jaj, jk) = max(zrk(jl, jaj, jk), zeelog)
[1992]	970	END DO
	971	END DO
	972	END DO
	973
	974	DO jk = 1, kflev + 1
	975	DO jaj = 2, 6, 2
	976	DO jl = 1, kdlon
[5144]	977	zrj(jl, jaj, jk) = max(zrj(jl, jaj, jk), zeelog)
	978	zrk(jl, jaj, jk) = max(zrk(jl, jaj, jk), zeelog)
[1992]	979	END DO
	980	END DO
	981	END DO
	982
	983	! * 4.2 EFFECTIVE ABSORBER AMOUNTS BY INVERSE LAPLACE
	984	! ---------------------------------------------
	985
	986	DO jk = 1, kflev + 1
	987	jkki = 1
	988	DO jaj = 1, 2
	989	iind2(1) = jaj
	990	iind2(2) = jaj
	991	DO jn = 1, 2
[5144]	992	jn2j = jn + 2 * jaj
[1992]	993	jkkp4 = jkki + 4
	994
	995	! * 4.2.1 EFFECTIVE ABSORBER AMOUNTS
	996	! --------------------------
	997
	998	DO jl = 1, kdlon
[5144]	999	zw2(jl, 1) = log(zrj(jl, jn, jk) / zrj(jl, jn2j, jk)) / paki(jl, jaj)
	1000	zw2(jl, 2) = log(zrk(jl, jn, jk) / zrk(jl, jn2j, jk)) / paki(jl, jaj)
[1992]	1001	END DO
	1002
	1003	! * 4.2.2 TRANSMISSION FUNCTION
	1004	! ---------------------
	1005
	1006	CALL swtt1_lmdar4(knu, 2, iind2, zw2, zr2)
	1007
	1008	DO jl = 1, kdlon
	1009	zrl(jl, jkki) = zr2(jl, 1)
	1010	zruef(jl, jkki) = zw2(jl, 1)
	1011	zrl(jl, jkkp4) = zr2(jl, 2)
	1012	zruef(jl, jkkp4) = zw2(jl, 2)
	1013	END DO
	1014
	1015	jkki = jkki + 1
	1016	END DO
	1017	END DO
	1018
	1019	! * 4.3 UPWARD AND DOWNWARD FLUXES WITH H2O AND UMG ABSORPTION
	1020	! ------------------------------------------------------
	1021
	1022	DO jl = 1, kdlon
[5144]	1023	pfdown(jl, jk) = zrj(jl, 1, jk) * zrl(jl, 1) * zrl(jl, 3) + &
	1024	zrj(jl, 2, jk) * zrl(jl, 2) * zrl(jl, 4)
	1025	pfup(jl, jk) = zrk(jl, 1, jk) * zrl(jl, 5) * zrl(jl, 7) + &
	1026	zrk(jl, 2, jk) * zrl(jl, 6) * zrl(jl, 8)
[1992]	1027	END DO
	1028	END DO
	1029
	1030	! ------------------------------------------------------------------
	1031
	1032	! * 5. MOLECULAR ABSORPTION ON CLEAR-SKY FLUXES
	1033	! ----------------------------------------
	1034
	1035
	1036
	1037	! * 5.1 DOWNWARD FLUXES
	1038	! ---------------
	1039
	1040	jaj = 2
	1041	iind3(1) = 1
	1042	iind3(2) = 2
	1043	iind3(3) = 3
	1044
	1045	DO jl = 1, kdlon
	1046	zw3(jl, 1) = 0.
	1047	zw3(jl, 2) = 0.
	1048	zw3(jl, 3) = 0.
	1049	zw4(jl) = 0.
	1050	zw5(jl) = 0.
	1051	zr4(jl) = 1.
[5144]	1052	zfd(jl, kflev + 1) = zrj0(jl, jaj, kflev + 1)
[1992]	1053	END DO
	1054	DO jk = 1, kflev
	1055	ikl = kflev + 1 - jk
	1056	DO jl = 1, kdlon
[5144]	1057	zw3(jl, 1) = zw3(jl, 1) + pud(jl, 1, ikl) / zrmu0(jl, ikl)
	1058	zw3(jl, 2) = zw3(jl, 2) + pud(jl, 2, ikl) / zrmu0(jl, ikl)
	1059	zw3(jl, 3) = zw3(jl, 3) + poz(jl, ikl) / zrmu0(jl, ikl)
	1060	zw4(jl) = zw4(jl) + pud(jl, 4, ikl) / zrmu0(jl, ikl)
	1061	zw5(jl) = zw5(jl) + pud(jl, 5, ikl) / zrmu0(jl, ikl)
[1992]	1062	END DO
	1063
	1064	CALL swtt1_lmdar4(knu, 3, iind3, zw3, zr3)
	1065
	1066	DO jl = 1, kdlon
	1067	! ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
[5144]	1068	zfd(jl, ikl) = zr3(jl, 1) * zr3(jl, 2) * zr3(jl, 3) * zr4(jl) * &
	1069	zrj0(jl, jaj, ikl)
[1992]	1070	END DO
	1071	END DO
	1072
	1073	! * 5.2 UPWARD FLUXES
	1074	! -------------
	1075
	1076	DO jl = 1, kdlon
[5144]	1077	zfu(jl, 1) = zfd(jl, 1) * palbp(jl, knu)
[1992]	1078	END DO
	1079
	1080	DO jk = 2, kflev + 1
	1081	ikm1 = jk - 1
	1082	DO jl = 1, kdlon
[5144]	1083	zw3(jl, 1) = zw3(jl, 1) + pud(jl, 1, ikm1) * 1.66
	1084	zw3(jl, 2) = zw3(jl, 2) + pud(jl, 2, ikm1) * 1.66
	1085	zw3(jl, 3) = zw3(jl, 3) + poz(jl, ikm1) * 1.66
	1086	zw4(jl) = zw4(jl) + pud(jl, 4, ikm1) * 1.66
	1087	zw5(jl) = zw5(jl) + pud(jl, 5, ikm1) * 1.66
[1992]	1088	END DO
	1089
	1090	CALL swtt1_lmdar4(knu, 3, iind3, zw3, zr3)
	1091
	1092	DO jl = 1, kdlon
	1093	! ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
[5144]	1094	zfu(jl, jk) = zr3(jl, 1) * zr3(jl, 2) * zr3(jl, 3) * zr4(jl) * &
	1095	zrk0(jl, jaj, jk)
[1992]	1096	END DO
	1097	END DO
	1098
	1099	! ------------------------------------------------------------------
	1100
	1101	! * 6. INTRODUCTION OF OZONE AND H2O CONTINUUM ABSORPTION
	1102	! --------------------------------------------------
	1103
	1104	iabs = 3
	1105
	1106	! * 6.1 DOWNWARD FLUXES
	1107	! ---------------
	1108
	1109	DO jl = 1, kdlon
	1110	zw1(jl) = 0.
	1111	zw4(jl) = 0.
	1112	zw5(jl) = 0.
	1113	zr1(jl) = 0.
[5144]	1114	pfdown(jl, kflev + 1) = ((1. - pclear(jl)) * pfdown(jl, kflev + 1) + pclear(jl) * zfd(&
	1115	jl, kflev + 1)) * rsun(knu)
[1992]	1116	END DO
	1117
	1118	DO jk = 1, kflev
	1119	ikl = kflev + 1 - jk
	1120	DO jl = 1, kdlon
[5144]	1121	zw1(jl) = zw1(jl) + poz(jl, ikl) / zrmue(jl, ikl)
	1122	zw4(jl) = zw4(jl) + pud(jl, 4, ikl) / zrmue(jl, ikl)
	1123	zw5(jl) = zw5(jl) + pud(jl, 5, ikl) / zrmue(jl, ikl)
[1992]	1124	! ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
	1125	END DO
	1126
	1127	CALL swtt_lmdar4(knu, iabs, zw1, zr1)
	1128
	1129	DO jl = 1, kdlon
[5144]	1130	pfdown(jl, ikl) = ((1. - pclear(jl)) * zr1(jl) * zr4(jl) * pfdown(jl, ikl) + &
	1131	pclear(jl) * zfd(jl, ikl)) * rsun(knu)
[1992]	1132	END DO
	1133	END DO
	1134
	1135	! * 6.2 UPWARD FLUXES
	1136	! -------------
	1137
	1138	DO jl = 1, kdlon
[5144]	1139	pfup(jl, 1) = ((1. - pclear(jl)) * zr1(jl) * zr4(jl) * pfup(jl, 1) + pclear(jl) * zfu(&
	1140	jl, 1)) * rsun(knu)
[1992]	1141	END DO
	1142
	1143	DO jk = 2, kflev + 1
	1144	ikm1 = jk - 1
	1145	DO jl = 1, kdlon
[5144]	1146	zw1(jl) = zw1(jl) + poz(jl, ikm1) * 1.66
	1147	zw4(jl) = zw4(jl) + pud(jl, 4, ikm1) * 1.66
	1148	zw5(jl) = zw5(jl) + pud(jl, 5, ikm1) * 1.66
[1992]	1149	! ZR4(JL) = EXP(-RSWCEZW4(JL)-RSWCPZW5(JL))
	1150	END DO
	1151
	1152	CALL swtt_lmdar4(knu, iabs, zw1, zr1)
	1153
	1154	DO jl = 1, kdlon
[5144]	1155	pfup(jl, jk) = ((1. - pclear(jl)) * zr1(jl) * zr4(jl) * pfup(jl, jk) + pclear(jl) * &
	1156	zfu(jl, jk)) * rsun(knu)
[1992]	1157	END DO
	1158	END DO
	1159
	1160	! ------------------------------------------------------------------
	1161
	1162	END SUBROUTINE sw2s_lmdar4
	1163	SUBROUTINE swclr_lmdar4(knu, paer, flag_aer, tauae, pizae, cgae, palbp, &
[5144]	1164	pdsig, prayl, psec, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmu0, &
	1165	ptauaz, ptra1, ptra2)
[1992]	1166	USE dimphy
	1167	USE radiation_ar4_param, ONLY: taua, rpiza, rcga
	1168	IMPLICIT NONE
	1169	include "radepsi.h"
	1170	include "radopt.h"
	1171
	1172	! ------------------------------------------------------------------
	1173	! PURPOSE.
	1174	! --------
	1175	! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
	1176	! CLEAR-SKY COLUMN
	1177
	1178	! REFERENCE.
	1179	! ----------
	1180
	1181	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	1182	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	1183
	1184	! AUTHOR.
	1185	! -------
	1186	! JEAN-JACQUES MORCRETTE ECMWF
	1187
	1188	! MODIFICATIONS.
	1189	! --------------
	1190	! ORIGINAL : 94-11-15
	1191	! ------------------------------------------------------------------
	1192	! * ARGUMENTS:
	1193
	1194	INTEGER knu
	1195	! -OB
[5144]	1196	REAL (KIND = 8) flag_aer
	1197	REAL (KIND = 8) tauae(kdlon, kflev, 2)
	1198	REAL (KIND = 8) pizae(kdlon, kflev, 2)
	1199	REAL (KIND = 8) cgae(kdlon, kflev, 2)
	1200	REAL (KIND = 8) paer(kdlon, kflev, 5)
	1201	REAL (KIND = 8) palbp(kdlon, 2)
	1202	REAL (KIND = 8) pdsig(kdlon, kflev)
	1203	REAL (KIND = 8) prayl(kdlon)
	1204	REAL (KIND = 8) psec(kdlon)
[1992]	1205
[5144]	1206	REAL (KIND = 8) pcgaz(kdlon, kflev)
	1207	REAL (KIND = 8) ppizaz(kdlon, kflev)
	1208	REAL (KIND = 8) pray1(kdlon, kflev + 1)
	1209	REAL (KIND = 8) pray2(kdlon, kflev + 1)
	1210	REAL (KIND = 8) prefz(kdlon, 2, kflev + 1)
	1211	REAL (KIND = 8) prj(kdlon, 6, kflev + 1)
	1212	REAL (KIND = 8) prk(kdlon, 6, kflev + 1)
	1213	REAL (KIND = 8) prmu0(kdlon, kflev + 1)
	1214	REAL (KIND = 8) ptauaz(kdlon, kflev)
	1215	REAL (KIND = 8) ptra1(kdlon, kflev + 1)
	1216	REAL (KIND = 8) ptra2(kdlon, kflev + 1)
[1992]	1217
	1218	! * LOCAL VARIABLES:
	1219
[5144]	1220	REAL (KIND = 8) zc0i(kdlon, kflev + 1)
	1221	REAL (KIND = 8) zcle0(kdlon, kflev)
	1222	REAL (KIND = 8) zclear(kdlon)
	1223	REAL (KIND = 8) zr21(kdlon)
	1224	REAL (KIND = 8) zr23(kdlon)
	1225	REAL (KIND = 8) zss0(kdlon)
	1226	REAL (KIND = 8) zscat(kdlon)
	1227	REAL (KIND = 8) ztr(kdlon, 2, kflev + 1)
[1992]	1228
	1229	INTEGER jl, jk, ja, jae, jkl, jklp1, jaj, jkm1, in
[5144]	1230	REAL (KIND = 8) ztray, zgar, zratio, zff, zfacoa, zcorae
	1231	REAL (KIND = 8) zmue, zgap, zww, zto, zden, zmu1, zden1
	1232	REAL (KIND = 8) zbmu0, zbmu1, zre11
[1992]	1233
	1234	! ------------------------------------------------------------------
	1235
	1236	! * 1. OPTICAL PARAMETERS FOR AEROSOLS AND RAYLEIGH
	1237	! --------------------------------------------
	1238
	1239
	1240	! cdir collapse
	1241	DO jk = 1, kflev + 1
	1242	DO ja = 1, 6
	1243	DO jl = 1, kdlon
	1244	prj(jl, ja, jk) = 0.
	1245	prk(jl, ja, jk) = 0.
	1246	END DO
	1247	END DO
	1248	END DO
	1249
	1250	DO jk = 1, kflev
	1251	! -OB
	1252	! DO 104 JL = 1, KDLON
	1253	! PCGAZ(JL,JK) = 0.
	1254	! PPIZAZ(JL,JK) = 0.
	1255	! PTAUAZ(JL,JK) = 0.
	1256	! 104 CONTINUE
	1257	! -OB
	1258	! DO 106 JAE=1,5
	1259	! DO 105 JL = 1, KDLON
	1260	! PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
	1261	! S +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
	1262	! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
	1263	! S * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
	1264	! PCGAZ(JL,JK) = PCGAZ(JL,JK) +PAER(JL,JK,JAE)
	1265	! S * TAUA(KNU,JAE)RPIZA(KNU,JAE)RCGA(KNU,JAE)
	1266	! 105 CONTINUE
	1267	! 106 CONTINUE
	1268	! -OB
	1269	DO jl = 1, kdlon
[5144]	1270	ptauaz(jl, jk) = flag_aer * tauae(jl, jk, knu)
	1271	ppizaz(jl, jk) = flag_aer * pizae(jl, jk, knu)
	1272	pcgaz(jl, jk) = flag_aer * cgae(jl, jk, knu)
[1992]	1273	END DO
	1274
	1275	IF (flag_aer>0) THEN
	1276	! -OB
	1277	DO jl = 1, kdlon
	1278	! PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
	1279	! PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
[5144]	1280	ztray = prayl(jl) * pdsig(jl, jk)
	1281	zratio = ztray / (ztray + ptauaz(jl, jk))
[1992]	1282	zgar = pcgaz(jl, jk)
[5144]	1283	zff = zgar * zgar
	1284	ptauaz(jl, jk) = ztray + ptauaz(jl, jk) * (1. - ppizaz(jl, jk) * zff)
	1285	pcgaz(jl, jk) = zgar * (1. - zratio) / (1. + zgar)
	1286	ppizaz(jl, jk) = zratio + (1. - zratio) * ppizaz(jl, jk) * (1. - zff) / (1. - &
	1287	ppizaz(jl, jk) * zff)
[1992]	1288	END DO
	1289	ELSE
	1290	DO jl = 1, kdlon
[5144]	1291	ztray = prayl(jl) * pdsig(jl, jk)
[1992]	1292	ptauaz(jl, jk) = ztray
	1293	pcgaz(jl, jk) = 0.
	1294	ppizaz(jl, jk) = 1. - repsct
	1295	END DO
	1296	END IF ! check flag_aer
	1297	! 107 CONTINUE
	1298	! PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)
	1299	! $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)
	1300	! 9107 FORMAT(1X,'SWCLR_107',I3,8E12.5)
	1301
	1302	END DO
	1303
	1304	! ------------------------------------------------------------------
	1305
	1306	! * 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
	1307	! ----------------------------------------------
	1308
	1309	DO jl = 1, kdlon
	1310	zr23(jl) = 0.
[5144]	1311	zc0i(jl, kflev + 1) = 0.
[1992]	1312	zclear(jl) = 1.
	1313	zscat(jl) = 0.
	1314	END DO
	1315
	1316	jk = 1
	1317	jkl = kflev + 1 - jk
	1318	jklp1 = jkl + 1
	1319	DO jl = 1, kdlon
[5144]	1320	zfacoa = 1. - ppizaz(jl, jkl) * pcgaz(jl, jkl) * pcgaz(jl, jkl)
	1321	zcorae = zfacoa * ptauaz(jl, jkl) * psec(jl)
[1992]	1322	zr21(jl) = exp(-zcorae)
	1323	zss0(jl) = 1. - zr21(jl)
	1324	zcle0(jl, jkl) = zss0(jl)
	1325
	1326	IF (novlp==1) THEN
	1327	! * maximum-random
[5144]	1328	zclear(jl) = zclear(jl) * (1.0 - max(zss0(jl), zscat(jl))) / &
	1329	(1.0 - min(zscat(jl), 1. - zepsec))
[1992]	1330	zc0i(jl, jkl) = 1.0 - zclear(jl)
	1331	zscat(jl) = zss0(jl)
	1332	ELSE IF (novlp==2) THEN
	1333	! * maximum
	1334	zscat(jl) = max(zss0(jl), zscat(jl))
	1335	zc0i(jl, jkl) = zscat(jl)
	1336	ELSE IF (novlp==3) THEN
	1337	! * random
[5144]	1338	zclear(jl) = zclear(jl) * (1.0 - zss0(jl))
[1992]	1339	zscat(jl) = 1.0 - zclear(jl)
	1340	zc0i(jl, jkl) = zscat(jl)
	1341	END IF
	1342	END DO
	1343
	1344	DO jk = 2, kflev
	1345	jkl = kflev + 1 - jk
	1346	jklp1 = jkl + 1
	1347	DO jl = 1, kdlon
[5144]	1348	zfacoa = 1. - ppizaz(jl, jkl) * pcgaz(jl, jkl) * pcgaz(jl, jkl)
	1349	zcorae = zfacoa * ptauaz(jl, jkl) * psec(jl)
[1992]	1350	zr21(jl) = exp(-zcorae)
	1351	zss0(jl) = 1. - zr21(jl)
	1352	zcle0(jl, jkl) = zss0(jl)
	1353
	1354	IF (novlp==1) THEN
	1355	! * maximum-random
[5144]	1356	zclear(jl) = zclear(jl) * (1.0 - max(zss0(jl), zscat(jl))) / &
	1357	(1.0 - min(zscat(jl), 1. - zepsec))
[1992]	1358	zc0i(jl, jkl) = 1.0 - zclear(jl)
	1359	zscat(jl) = zss0(jl)
	1360	ELSE IF (novlp==2) THEN
	1361	! * maximum
	1362	zscat(jl) = max(zss0(jl), zscat(jl))
	1363	zc0i(jl, jkl) = zscat(jl)
	1364	ELSE IF (novlp==3) THEN
	1365	! * random
[5144]	1366	zclear(jl) = zclear(jl) * (1.0 - zss0(jl))
[1992]	1367	zscat(jl) = 1.0 - zclear(jl)
	1368	zc0i(jl, jkl) = zscat(jl)
[998]	1369	END IF
[1992]	1370	END DO
	1371	END DO
[998]	1372
[1992]	1373	! ------------------------------------------------------------------
[1279]	1374
[1992]	1375	! * 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
	1376	! -----------------------------------------------
	1377
	1378	DO jl = 1, kdlon
[5144]	1379	pray1(jl, kflev + 1) = 0.
	1380	pray2(jl, kflev + 1) = 0.
[1992]	1381	prefz(jl, 2, 1) = palbp(jl, knu)
	1382	prefz(jl, 1, 1) = palbp(jl, knu)
[5144]	1383	ptra1(jl, kflev + 1) = 1.
	1384	ptra2(jl, kflev + 1) = 1.
[1992]	1385	END DO
	1386
	1387	DO jk = 2, kflev + 1
	1388	jkm1 = jk - 1
	1389	DO jl = 1, kdlon
	1390
	1391	! ------------------------------------------------------------------
	1392
	1393	! * 3.1 EQUIVALENT ZENITH ANGLE
	1394	! -----------------------
	1395
[5144]	1396	zmue = (1. - zc0i(jl, jk)) * psec(jl) + zc0i(jl, jk) * 1.66
	1397	prmu0(jl, jk) = 1. / zmue
[1992]	1398
	1399	! ------------------------------------------------------------------
	1400
	1401	! * 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
	1402	! ----------------------------------------------------
	1403
	1404	zgap = pcgaz(jl, jkm1)
[5144]	1405	zbmu0 = 0.5 - 0.75 * zgap / zmue
[1992]	1406	zww = ppizaz(jl, jkm1)
	1407	zto = ptauaz(jl, jkm1)
[5144]	1408	zden = 1. + (1. - zww + zbmu0 * zww) * zto * zmue + (1 - zww) * (1. - zww + 2. * zbmu0 * zww) &
	1409	* zto * zto * zmue * zmue
	1410	pray1(jl, jkm1) = zbmu0 * zww * zto * zmue / zden
	1411	ptra1(jl, jkm1) = 1. / zden
[1992]	1412
	1413	zmu1 = 0.5
[5144]	1414	zbmu1 = 0.5 - 0.75 * zgap * zmu1
	1415	zden1 = 1. + (1. - zww + zbmu1 * zww) * zto / zmu1 + (1 - zww) * (1. - zww + 2. * zbmu1 * zww &
	1416	) * zto * zto / zmu1 / zmu1
	1417	pray2(jl, jkm1) = zbmu1 * zww * zto / zmu1 / zden1
	1418	ptra2(jl, jkm1) = 1. / zden1
[1992]	1419
[5144]	1420	prefz(jl, 1, jk) = (pray1(jl, jkm1) + prefz(jl, 1, jkm1) * ptra1(jl, jkm1) * &
	1421	ptra2(jl, jkm1) / (1. - pray2(jl, jkm1) * prefz(jl, 1, jkm1)))
[1992]	1422
[5144]	1423	ztr(jl, 1, jkm1) = (ptra1(jl, jkm1) / (1. - pray2(jl, jkm1) * prefz(jl, 1, &
	1424	jkm1)))
[1992]	1425
[5144]	1426	prefz(jl, 2, jk) = (pray1(jl, jkm1) + prefz(jl, 2, jkm1) * ptra1(jl, jkm1) * &
	1427	ptra2(jl, jkm1))
[1992]	1428
	1429	ztr(jl, 2, jkm1) = ptra1(jl, jkm1)
	1430
	1431	END DO
	1432	END DO
	1433	DO jl = 1, kdlon
[5144]	1434	zmue = (1. - zc0i(jl, 1)) * psec(jl) + zc0i(jl, 1) * 1.66
	1435	prmu0(jl, 1) = 1. / zmue
[1992]	1436	END DO
	1437
	1438	! ------------------------------------------------------------------
	1439
	1440	! * 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
	1441	! -------------------------------------------------
	1442
	1443	IF (knu==1) THEN
	1444	jaj = 2
	1445	DO jl = 1, kdlon
[5144]	1446	prj(jl, jaj, kflev + 1) = 1.
	1447	prk(jl, jaj, kflev + 1) = prefz(jl, 1, kflev + 1)
[1992]	1448	END DO
	1449
	1450	DO jk = 1, kflev
	1451	jkl = kflev + 1 - jk
	1452	jklp1 = jkl + 1
	1453	DO jl = 1, kdlon
[5144]	1454	zre11 = prj(jl, jaj, jklp1) * ztr(jl, 1, jkl)
[1992]	1455	prj(jl, jaj, jkl) = zre11
[5144]	1456	prk(jl, jaj, jkl) = zre11 * prefz(jl, 1, jkl)
[998]	1457	END DO
[1992]	1458	END DO
	1459
	1460	ELSE
	1461
	1462	DO jaj = 1, 2
	1463	DO jl = 1, kdlon
[5144]	1464	prj(jl, jaj, kflev + 1) = 1.
	1465	prk(jl, jaj, kflev + 1) = prefz(jl, jaj, kflev + 1)
[1992]	1466	END DO
	1467
	1468	DO jk = 1, kflev
	1469	jkl = kflev + 1 - jk
	1470	jklp1 = jkl + 1
	1471	DO jl = 1, kdlon
[5144]	1472	zre11 = prj(jl, jaj, jklp1) * ztr(jl, jaj, jkl)
[1992]	1473	prj(jl, jaj, jkl) = zre11
[5144]	1474	prk(jl, jaj, jkl) = zre11 * prefz(jl, jaj, jkl)
[1992]	1475	END DO
	1476	END DO
	1477	END DO
	1478
	1479	END IF
	1480
	1481	! ------------------------------------------------------------------
	1482
	1483	END SUBROUTINE swclr_lmdar4
	1484	SUBROUTINE swr_lmdar4(knu, palbd, pcg, pcld, pdsig, pomega, prayl, psec, &
[5144]	1485	ptau, pcgaz, ppizaz, pray1, pray2, prefz, prj, prk, prmue, ptauaz, ptra1, &
	1486	ptra2)
[1992]	1487	USE dimphy
	1488	IMPLICIT NONE
	1489	include "radepsi.h"
	1490	include "radopt.h"
	1491
	1492	! ------------------------------------------------------------------
	1493	! PURPOSE.
	1494	! --------
	1495	! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY IN CASE OF
	1496	! CONTINUUM SCATTERING
	1497
	1498	! METHOD.
	1499	! -------
	1500
	1501	! 1. COMPUTES CONTINUUM FLUXES CORRESPONDING TO AEROSOL
	1502	! OR/AND RAYLEIGH SCATTERING (NO MOLECULAR GAS ABSORPTION)
	1503
	1504	! REFERENCE.
	1505	! ----------
	1506
	1507	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	1508	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	1509
	1510	! AUTHOR.
	1511	! -------
	1512	! JEAN-JACQUES MORCRETTE ECMWF
	1513
	1514	! MODIFICATIONS.
	1515	! --------------
	1516	! ORIGINAL : 89-07-14
	1517	! ------------------------------------------------------------------
	1518	! * ARGUMENTS:
	1519
	1520	INTEGER knu
[5144]	1521	REAL (KIND = 8) palbd(kdlon, 2)
	1522	REAL (KIND = 8) pcg(kdlon, 2, kflev)
	1523	REAL (KIND = 8) pcld(kdlon, kflev)
	1524	REAL (KIND = 8) pdsig(kdlon, kflev)
	1525	REAL (KIND = 8) pomega(kdlon, 2, kflev)
	1526	REAL (KIND = 8) prayl(kdlon)
	1527	REAL (KIND = 8) psec(kdlon)
	1528	REAL (KIND = 8) ptau(kdlon, 2, kflev)
[1992]	1529
[5144]	1530	REAL (KIND = 8) pray1(kdlon, kflev + 1)
	1531	REAL (KIND = 8) pray2(kdlon, kflev + 1)
	1532	REAL (KIND = 8) prefz(kdlon, 2, kflev + 1)
	1533	REAL (KIND = 8) prj(kdlon, 6, kflev + 1)
	1534	REAL (KIND = 8) prk(kdlon, 6, kflev + 1)
	1535	REAL (KIND = 8) prmue(kdlon, kflev + 1)
	1536	REAL (KIND = 8) pcgaz(kdlon, kflev)
	1537	REAL (KIND = 8) ppizaz(kdlon, kflev)
	1538	REAL (KIND = 8) ptauaz(kdlon, kflev)
	1539	REAL (KIND = 8) ptra1(kdlon, kflev + 1)
	1540	REAL (KIND = 8) ptra2(kdlon, kflev + 1)
[1992]	1541
	1542	! * LOCAL VARIABLES:
	1543
[5144]	1544	REAL (KIND = 8) zc1i(kdlon, kflev + 1)
	1545	REAL (KIND = 8) zcleq(kdlon, kflev)
	1546	REAL (KIND = 8) zclear(kdlon)
	1547	REAL (KIND = 8) zcloud(kdlon)
	1548	REAL (KIND = 8) zgg(kdlon)
	1549	REAL (KIND = 8) zref(kdlon)
	1550	REAL (KIND = 8) zre1(kdlon)
	1551	REAL (KIND = 8) zre2(kdlon)
	1552	REAL (KIND = 8) zrmuz(kdlon)
	1553	REAL (KIND = 8) zrneb(kdlon)
	1554	REAL (KIND = 8) zr21(kdlon)
	1555	REAL (KIND = 8) zr22(kdlon)
	1556	REAL (KIND = 8) zr23(kdlon)
	1557	REAL (KIND = 8) zss1(kdlon)
	1558	REAL (KIND = 8) zto1(kdlon)
	1559	REAL (KIND = 8) ztr(kdlon, 2, kflev + 1)
	1560	REAL (KIND = 8) ztr1(kdlon)
	1561	REAL (KIND = 8) ztr2(kdlon)
	1562	REAL (KIND = 8) zw(kdlon)
[1992]	1563
	1564	INTEGER jk, jl, ja, jkl, jklp1, jkm1, jaj
[5144]	1565	REAL (KIND = 8) zfacoa, zfacoc, zcorae, zcorcd
	1566	REAL (KIND = 8) zmue, zgap, zww, zto, zden, zden1
	1567	REAL (KIND = 8) zmu1, zre11, zbmu0, zbmu1
[1992]	1568
	1569	! ------------------------------------------------------------------
	1570
	1571	! * 1. INITIALIZATION
	1572	! --------------
	1573
	1574	DO jk = 1, kflev + 1
	1575	DO ja = 1, 6
	1576	DO jl = 1, kdlon
	1577	prj(jl, ja, jk) = 0.
	1578	prk(jl, ja, jk) = 0.
	1579	END DO
	1580	END DO
	1581	END DO
	1582
	1583	! ------------------------------------------------------------------
	1584
	1585	! * 2. TOTAL EFFECTIVE CLOUDINESS ABOVE A GIVEN LEVEL
	1586	! ----------------------------------------------
	1587
	1588	DO jl = 1, kdlon
	1589	zr23(jl) = 0.
[5144]	1590	zc1i(jl, kflev + 1) = 0.
[1992]	1591	zclear(jl) = 1.
	1592	zcloud(jl) = 0.
	1593	END DO
	1594
	1595	jk = 1
	1596	jkl = kflev + 1 - jk
	1597	jklp1 = jkl + 1
	1598	DO jl = 1, kdlon
[5144]	1599	zfacoa = 1. - ppizaz(jl, jkl) * pcgaz(jl, jkl) * pcgaz(jl, jkl)
	1600	zfacoc = 1. - pomega(jl, knu, jkl) * pcg(jl, knu, jkl) * pcg(jl, knu, jkl)
	1601	zcorae = zfacoa * ptauaz(jl, jkl) * psec(jl)
	1602	zcorcd = zfacoc * ptau(jl, knu, jkl) * psec(jl)
[1992]	1603	zr21(jl) = exp(-zcorae)
	1604	zr22(jl) = exp(-zcorcd)
[5144]	1605	zss1(jl) = pcld(jl, jkl) * (1.0 - zr21(jl) * zr22(jl)) + &
	1606	(1.0 - pcld(jl, jkl)) * (1.0 - zr21(jl))
[1992]	1607	zcleq(jl, jkl) = zss1(jl)
	1608
	1609	IF (novlp==1) THEN
	1610	! * maximum-random
[5144]	1611	zclear(jl) = zclear(jl) * (1.0 - max(zss1(jl), zcloud(jl))) / &
	1612	(1.0 - min(zcloud(jl), 1. - zepsec))
[1992]	1613	zc1i(jl, jkl) = 1.0 - zclear(jl)
	1614	zcloud(jl) = zss1(jl)
	1615	ELSE IF (novlp==2) THEN
	1616	! * maximum
	1617	zcloud(jl) = max(zss1(jl), zcloud(jl))
	1618	zc1i(jl, jkl) = zcloud(jl)
	1619	ELSE IF (novlp==3) THEN
	1620	! * random
[5144]	1621	zclear(jl) = zclear(jl) * (1.0 - zss1(jl))
[1992]	1622	zcloud(jl) = 1.0 - zclear(jl)
	1623	zc1i(jl, jkl) = zcloud(jl)
	1624	END IF
	1625	END DO
	1626
	1627	DO jk = 2, kflev
	1628	jkl = kflev + 1 - jk
	1629	jklp1 = jkl + 1
	1630	DO jl = 1, kdlon
[5144]	1631	zfacoa = 1. - ppizaz(jl, jkl) * pcgaz(jl, jkl) * pcgaz(jl, jkl)
	1632	zfacoc = 1. - pomega(jl, knu, jkl) * pcg(jl, knu, jkl) * pcg(jl, knu, jkl)
	1633	zcorae = zfacoa * ptauaz(jl, jkl) * psec(jl)
	1634	zcorcd = zfacoc * ptau(jl, knu, jkl) * psec(jl)
[1992]	1635	zr21(jl) = exp(-zcorae)
	1636	zr22(jl) = exp(-zcorcd)
[5144]	1637	zss1(jl) = pcld(jl, jkl) * (1.0 - zr21(jl) * zr22(jl)) + &
	1638	(1.0 - pcld(jl, jkl)) * (1.0 - zr21(jl))
[1992]	1639	zcleq(jl, jkl) = zss1(jl)
	1640
	1641	IF (novlp==1) THEN
	1642	! * maximum-random
[5144]	1643	zclear(jl) = zclear(jl) * (1.0 - max(zss1(jl), zcloud(jl))) / &
	1644	(1.0 - min(zcloud(jl), 1. - zepsec))
[1992]	1645	zc1i(jl, jkl) = 1.0 - zclear(jl)
	1646	zcloud(jl) = zss1(jl)
	1647	ELSE IF (novlp==2) THEN
	1648	! * maximum
	1649	zcloud(jl) = max(zss1(jl), zcloud(jl))
	1650	zc1i(jl, jkl) = zcloud(jl)
	1651	ELSE IF (novlp==3) THEN
	1652	! * random
[5144]	1653	zclear(jl) = zclear(jl) * (1.0 - zss1(jl))
[1992]	1654	zcloud(jl) = 1.0 - zclear(jl)
	1655	zc1i(jl, jkl) = zcloud(jl)
[998]	1656	END IF
[1992]	1657	END DO
	1658	END DO
	1659
	1660	! ------------------------------------------------------------------
	1661
	1662	! * 3. REFLECTIVITY/TRANSMISSIVITY FOR PURE SCATTERING
	1663	! -----------------------------------------------
	1664
	1665	DO jl = 1, kdlon
[5144]	1666	pray1(jl, kflev + 1) = 0.
	1667	pray2(jl, kflev + 1) = 0.
[1992]	1668	prefz(jl, 2, 1) = palbd(jl, knu)
	1669	prefz(jl, 1, 1) = palbd(jl, knu)
[5144]	1670	ptra1(jl, kflev + 1) = 1.
	1671	ptra2(jl, kflev + 1) = 1.
[1992]	1672	END DO
	1673
	1674	DO jk = 2, kflev + 1
	1675	jkm1 = jk - 1
	1676	DO jl = 1, kdlon
	1677	zrneb(jl) = pcld(jl, jkm1)
	1678	zre1(jl) = 0.
	1679	ztr1(jl) = 0.
	1680	zre2(jl) = 0.
	1681	ztr2(jl) = 0.
	1682
	1683	! ------------------------------------------------------------------
	1684
	1685	! * 3.1 EQUIVALENT ZENITH ANGLE
	1686	! -----------------------
	1687
[5144]	1688	zmue = (1. - zc1i(jl, jk)) * psec(jl) + zc1i(jl, jk) * 1.66
	1689	prmue(jl, jk) = 1. / zmue
[1992]	1690
	1691	! ------------------------------------------------------------------
	1692
	1693	! * 3.2 REFLECT./TRANSMISSIVITY DUE TO RAYLEIGH AND AEROSOLS
	1694	! ----------------------------------------------------
	1695
	1696	zgap = pcgaz(jl, jkm1)
[5144]	1697	zbmu0 = 0.5 - 0.75 * zgap / zmue
[1992]	1698	zww = ppizaz(jl, jkm1)
	1699	zto = ptauaz(jl, jkm1)
[5144]	1700	zden = 1. + (1. - zww + zbmu0 * zww) * zto * zmue + (1 - zww) * (1. - zww + 2. * zbmu0 * zww) &
	1701	* zto * zto * zmue * zmue
	1702	pray1(jl, jkm1) = zbmu0 * zww * zto * zmue / zden
	1703	ptra1(jl, jkm1) = 1. / zden
[1992]	1704	! PRINT ,' LOOP 342 * 3 ** JL=',JL,PRAY1(JL,JKM1),PTRA1(JL,JKM1)
	1705
	1706	zmu1 = 0.5
[5144]	1707	zbmu1 = 0.5 - 0.75 * zgap * zmu1
	1708	zden1 = 1. + (1. - zww + zbmu1 * zww) * zto / zmu1 + (1 - zww) * (1. - zww + 2. * zbmu1 * zww &
	1709	) * zto * zto / zmu1 / zmu1
	1710	pray2(jl, jkm1) = zbmu1 * zww * zto / zmu1 / zden1
	1711	ptra2(jl, jkm1) = 1. / zden1
[1992]	1712
	1713	! ------------------------------------------------------------------
	1714
	1715	! * 3.3 EFFECT OF CLOUD LAYER
	1716	! ---------------------
	1717
	1718	zw(jl) = pomega(jl, knu, jkm1)
[5144]	1719	zto1(jl) = ptau(jl, knu, jkm1) / zw(jl) + ptauaz(jl, jkm1) / ppizaz(jl, &
	1720	jkm1)
[1992]	1721	zr21(jl) = ptau(jl, knu, jkm1) + ptauaz(jl, jkm1)
[5144]	1722	zr22(jl) = ptau(jl, knu, jkm1) / zr21(jl)
	1723	zgg(jl) = zr22(jl) * pcg(jl, knu, jkm1) + (1. - zr22(jl)) * pcgaz(jl, jkm1)
[1992]	1724	! Modif PhD - JJM 19/03/96 pour erreurs arrondis
	1725	! machine
	1726	! PHD PROTECTION ZW(JL) = ZR21(JL) / ZTO1(JL)
[5144]	1727	IF (zw(jl)==1. .AND. ppizaz(jl, jkm1)==1.) THEN
[1992]	1728	zw(jl) = 1.
[998]	1729	ELSE
[5144]	1730	zw(jl) = zr21(jl) / zto1(jl)
[998]	1731	END IF
[1992]	1732	zref(jl) = prefz(jl, 1, jkm1)
	1733	zrmuz(jl) = prmue(jl, jk)
	1734	END DO
[1279]	1735
[1992]	1736	CALL swde_lmdar4(zgg, zref, zrmuz, zto1, zw, zre1, zre2, ztr1, ztr2)
[1279]	1737
[1992]	1738	DO jl = 1, kdlon
[1279]	1739
[5144]	1740	prefz(jl, 1, jk) = (1. - zrneb(jl)) * (pray1(jl, jkm1) + prefz(jl, 1, jkm1) * &
	1741	ptra1(jl, jkm1) * ptra2(jl, jkm1) / (1. - pray2(jl, jkm1) * prefz(jl, 1, &
	1742	jkm1))) + zrneb(jl) * zre2(jl)
[1279]	1743
[5144]	1744	ztr(jl, 1, jkm1) = zrneb(jl) * ztr2(jl) + (ptra1(jl, jkm1) / (1. - pray2(jl, &
	1745	jkm1) * prefz(jl, 1, jkm1))) * (1. - zrneb(jl))
[998]	1746
[5144]	1747	prefz(jl, 2, jk) = (1. - zrneb(jl)) * (pray1(jl, jkm1) + prefz(jl, 2, jkm1) * &
	1748	ptra1(jl, jkm1) * ptra2(jl, jkm1)) + zrneb(jl) * zre1(jl)
[1992]	1749
[5144]	1750	ztr(jl, 2, jkm1) = zrneb(jl) * ztr1(jl) + ptra1(jl, jkm1) * (1. - zrneb(jl))
[1992]	1751
	1752	END DO
	1753	END DO
	1754	DO jl = 1, kdlon
[5144]	1755	zmue = (1. - zc1i(jl, 1)) * psec(jl) + zc1i(jl, 1) * 1.66
	1756	prmue(jl, 1) = 1. / zmue
[1992]	1757	END DO
	1758
	1759	! ------------------------------------------------------------------
	1760
	1761	! * 3.5 REFLECT./TRANSMISSIVITY BETWEEN SURFACE AND LEVEL
	1762	! -------------------------------------------------
	1763
	1764	IF (knu==1) THEN
	1765	jaj = 2
	1766	DO jl = 1, kdlon
[5144]	1767	prj(jl, jaj, kflev + 1) = 1.
	1768	prk(jl, jaj, kflev + 1) = prefz(jl, 1, kflev + 1)
[1992]	1769	END DO
	1770
	1771	DO jk = 1, kflev
	1772	jkl = kflev + 1 - jk
	1773	jklp1 = jkl + 1
	1774	DO jl = 1, kdlon
[5144]	1775	zre11 = prj(jl, jaj, jklp1) * ztr(jl, 1, jkl)
[1992]	1776	prj(jl, jaj, jkl) = zre11
[5144]	1777	prk(jl, jaj, jkl) = zre11 * prefz(jl, 1, jkl)
[1992]	1778	END DO
	1779	END DO
	1780
	1781	ELSE
	1782
	1783	DO jaj = 1, 2
	1784	DO jl = 1, kdlon
[5144]	1785	prj(jl, jaj, kflev + 1) = 1.
	1786	prk(jl, jaj, kflev + 1) = prefz(jl, jaj, kflev + 1)
[1992]	1787	END DO
	1788
	1789	DO jk = 1, kflev
	1790	jkl = kflev + 1 - jk
	1791	jklp1 = jkl + 1
	1792	DO jl = 1, kdlon
[5144]	1793	zre11 = prj(jl, jaj, jklp1) * ztr(jl, jaj, jkl)
[1992]	1794	prj(jl, jaj, jkl) = zre11
[5144]	1795	prk(jl, jaj, jkl) = zre11 * prefz(jl, jaj, jkl)
[1992]	1796	END DO
	1797	END DO
	1798	END DO
	1799
	1800	END IF
	1801
	1802	! ------------------------------------------------------------------
	1803
	1804	END SUBROUTINE swr_lmdar4
	1805	SUBROUTINE swde_lmdar4(pgg, pref, prmuz, pto1, pw, pre1, pre2, ptr1, ptr2)
	1806	USE dimphy
	1807	IMPLICIT NONE
	1808
	1809	! ------------------------------------------------------------------
	1810	! PURPOSE.
	1811	! --------
	1812	! COMPUTES THE REFLECTIVITY AND TRANSMISSIVITY OF A CLOUDY
	1813	! LAYER USING THE DELTA-EDDINGTON'S APPROXIMATION.
	1814
	1815	! METHOD.
	1816	! -------
	1817
	1818	! STANDARD DELTA-EDDINGTON LAYER CALCULATIONS.
	1819
	1820	! REFERENCE.
	1821	! ----------
	1822
	1823	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	1824	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	1825
	1826	! AUTHOR.
	1827	! -------
	1828	! JEAN-JACQUES MORCRETTE ECMWF
	1829
	1830	! MODIFICATIONS.
	1831	! --------------
	1832	! ORIGINAL : 88-12-15
	1833	! ------------------------------------------------------------------
	1834	! * ARGUMENTS:
	1835
[5144]	1836	REAL (KIND = 8) pgg(kdlon) ! ASSYMETRY FACTOR
	1837	REAL (KIND = 8) pref(kdlon) ! REFLECTIVITY OF THE UNDERLYING LAYER
	1838	REAL (KIND = 8) prmuz(kdlon) ! COSINE OF SOLAR ZENITH ANGLE
	1839	REAL (KIND = 8) pto1(kdlon) ! OPTICAL THICKNESS
	1840	REAL (KIND = 8) pw(kdlon) ! SINGLE SCATTERING ALBEDO
	1841	REAL (KIND = 8) pre1(kdlon) ! LAYER REFLECTIVITY (NO UNDERLYING-LAYER REFLECTION)
	1842	REAL (KIND = 8) pre2(kdlon) ! LAYER REFLECTIVITY
	1843	REAL (KIND = 8) ptr1(kdlon) ! LAYER TRANSMISSIVITY (NO UNDERLYING-LAYER REFLECTION)
	1844	REAL (KIND = 8) ptr2(kdlon) ! LAYER TRANSMISSIVITY
[1992]	1845
	1846	! * LOCAL VARIABLES:
	1847
	1848	INTEGER jl
[5144]	1849	REAL (KIND = 8) zff, zgp, ztop, zwcp, zdt, zx1, zwm
	1850	REAL (KIND = 8) zrm2, zrk, zx2, zrp, zalpha, zbeta, zarg
	1851	REAL (KIND = 8) zexmu0, zarg2, zexkp, zexkm, zxp2p, zxm2p, zap2b, zam2b
	1852	REAL (KIND = 8) za11, za12, za13, za21, za22, za23
	1853	REAL (KIND = 8) zdena, zc1a, zc2a, zri0a, zri1a
	1854	REAL (KIND = 8) zri0b, zri1b
	1855	REAL (KIND = 8) zb21, zb22, zb23, zdenb, zc1b, zc2b
	1856	REAL (KIND = 8) zri0c, zri1c, zri0d, zri1d
[1992]	1857
	1858	! ------------------------------------------------------------------
	1859
	1860	! * 1. DELTA-EDDINGTON CALCULATIONS
	1861
	1862	DO jl = 1, kdlon
	1863	! * 1.1 SET UP THE DELTA-MODIFIED PARAMETERS
	1864
[5144]	1865	zff = pgg(jl) * pgg(jl)
	1866	zgp = pgg(jl) / (1. + pgg(jl))
	1867	ztop = (1. - pw(jl) * zff) * pto1(jl)
	1868	zwcp = (1 - zff) * pw(jl) / (1. - pw(jl) * zff)
	1869	zdt = 2. / 3.
	1870	zx1 = 1. - zwcp * zgp
[1992]	1871	zwm = 1. - zwcp
[5144]	1872	zrm2 = prmuz(jl) * prmuz(jl)
	1873	zrk = sqrt(3. * zwm * zx1)
	1874	zx2 = 4. * (1. - zrk * zrk * zrm2)
	1875	zrp = zrk / zx1
	1876	zalpha = 3. * zwcp * zrm2 * (1. + zgp * zwm) / zx2
	1877	zbeta = 3. * zwcp * prmuz(jl) * (1. + 3. * zgp * zrm2 * zwm) / zx2
	1878	zarg = min(ztop / prmuz(jl), 200._8)
[1992]	1879	zexmu0 = exp(-zarg)
[5144]	1880	zarg2 = min(zrk * ztop, 200._8)
[1992]	1881	zexkp = exp(zarg2)
[5144]	1882	zexkm = 1. / zexkp
	1883	zxp2p = 1. + zdt * zrp
	1884	zxm2p = 1. - zdt * zrp
	1885	zap2b = zalpha + zdt * zbeta
	1886	zam2b = zalpha - zdt * zbeta
[1992]	1887
	1888	! * 1.2 WITHOUT REFLECTION FROM THE UNDERLYING LAYER
	1889
	1890	za11 = zxp2p
	1891	za12 = zxm2p
	1892	za13 = zap2b
[5144]	1893	za22 = zxp2p * zexkp
	1894	za21 = zxm2p * zexkm
	1895	za23 = zam2b * zexmu0
	1896	zdena = za11 * za22 - za21 * za12
	1897	zc1a = (za22 * za13 - za12 * za23) / zdena
	1898	zc2a = (za11 * za23 - za21 * za13) / zdena
[1992]	1899	zri0a = zc1a + zc2a - zalpha
[5144]	1900	zri1a = zrp * (zc1a - zc2a) - zbeta
	1901	pre1(jl) = (zri0a - zdt * zri1a) / prmuz(jl)
	1902	zri0b = zc1a * zexkm + zc2a * zexkp - zalpha * zexmu0
	1903	zri1b = zrp * (zc1a * zexkm - zc2a * zexkp) - zbeta * zexmu0
	1904	ptr1(jl) = zexmu0 + (zri0b + zdt * zri1b) / prmuz(jl)
[1992]	1905
	1906	! * 1.3 WITH REFLECTION FROM THE UNDERLYING LAYER
	1907
[5144]	1908	zb21 = za21 - pref(jl) * zxp2p * zexkm
	1909	zb22 = za22 - pref(jl) * zxm2p * zexkp
	1910	zb23 = za23 - pref(jl) * zexmu0 * (zap2b - prmuz(jl))
	1911	zdenb = za11 * zb22 - zb21 * za12
	1912	zc1b = (zb22 * za13 - za12 * zb23) / zdenb
	1913	zc2b = (za11 * zb23 - zb21 * za13) / zdenb
[1992]	1914	zri0c = zc1b + zc2b - zalpha
[5144]	1915	zri1c = zrp * (zc1b - zc2b) - zbeta
	1916	pre2(jl) = (zri0c - zdt * zri1c) / prmuz(jl)
	1917	zri0d = zc1b * zexkm + zc2b * zexkp - zalpha * zexmu0
	1918	zri1d = zrp * (zc1b * zexkm - zc2b * zexkp) - zbeta * zexmu0
	1919	ptr2(jl) = zexmu0 + (zri0d + zdt * zri1d) / prmuz(jl)
[1992]	1920
	1921	END DO
[5105]	1922
[1992]	1923	END SUBROUTINE swde_lmdar4
	1924	SUBROUTINE swtt_lmdar4(knu, ka, pu, ptr)
	1925	USE dimphy
	1926	USE radiation_ar4_param, ONLY: apad, bpad, d
	1927	IMPLICIT NONE
	1928
	1929	! -----------------------------------------------------------------------
	1930	! PURPOSE.
	1931	! --------
	1932	! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	1933	! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
	1934	! INTERVALS.
	1935
	1936	! METHOD.
	1937	! -------
	1938
	1939	! TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
	1940	! AND HORNER'S ALGORITHM.
	1941
	1942	! REFERENCE.
	1943	! ----------
	1944
	1945	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	1946	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	1947
	1948	! AUTHOR.
	1949	! -------
	1950	! JEAN-JACQUES MORCRETTE ECMWF
	1951
	1952	! MODIFICATIONS.
	1953	! --------------
	1954	! ORIGINAL : 88-12-15
	1955	! -----------------------------------------------------------------------
	1956
	1957	! * ARGUMENTS
	1958
	1959	INTEGER knu ! INDEX OF THE SPECTRAL INTERVAL
	1960	INTEGER ka ! INDEX OF THE ABSORBER
[5144]	1961	REAL (KIND = 8) pu(kdlon) ! ABSORBER AMOUNT
[1992]	1962
[5144]	1963	REAL (KIND = 8) ptr(kdlon) ! TRANSMISSION FUNCTION
[1992]	1964
	1965	! * LOCAL VARIABLES:
	1966
[5144]	1967	REAL (KIND = 8) zr1(kdlon), zr2(kdlon)
[1992]	1968	INTEGER jl, i, j
	1969
	1970	! -----------------------------------------------------------------------
	1971
	1972	! * 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
	1973
	1974	DO jl = 1, kdlon
[5144]	1975	zr1(jl) = apad(knu, ka, 1) + pu(jl) * (apad(knu, ka, 2) + pu(jl) * (apad(knu, ka, &
	1976	3) + pu(jl) * (apad(knu, ka, 4) + pu(jl) * (apad(knu, ka, 5) + pu(jl) * (apad(knu, ka, 6) &
	1977	+ pu(jl) * (apad(knu, ka, 7)))))))
[1992]	1978
[5144]	1979	zr2(jl) = bpad(knu, ka, 1) + pu(jl) * (bpad(knu, ka, 2) + pu(jl) * (bpad(knu, ka, &
	1980	3) + pu(jl) * (bpad(knu, ka, 4) + pu(jl) * (bpad(knu, ka, 5) + pu(jl) * (bpad(knu, ka, 6) &
	1981	+ pu(jl) * (bpad(knu, ka, 7)))))))
[1992]	1982
	1983	! * 2. ADD THE BACKGROUND TRANSMISSION
	1984
[5144]	1985	ptr(jl) = (zr1(jl) / zr2(jl)) * (1. - d(knu, ka)) + d(knu, ka)
[1992]	1986	END DO
	1987
	1988	END SUBROUTINE swtt_lmdar4
	1989	SUBROUTINE swtt1_lmdar4(knu, kabs, kind, pu, ptr)
	1990	USE dimphy
	1991	USE radiation_ar4_param, ONLY: apad, bpad, d
	1992	IMPLICIT NONE
	1993
	1994	! -----------------------------------------------------------------------
	1995	! PURPOSE.
	1996	! --------
	1997	! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	1998	! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN THE TWO SPECTRAL
	1999	! INTERVALS.
	2000
	2001	! METHOD.
	2002	! -------
	2003
	2004	! TRANSMISSION FUNCTION ARE COMPUTED USING PADE APPROXIMANTS
	2005	! AND HORNER'S ALGORITHM.
	2006
	2007	! REFERENCE.
	2008	! ----------
	2009
	2010	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2011	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2012
	2013	! AUTHOR.
	2014	! -------
	2015	! JEAN-JACQUES MORCRETTE ECMWF
	2016
	2017	! MODIFICATIONS.
	2018	! --------------
	2019	! ORIGINAL : 95-01-20
	2020	! -----------------------------------------------------------------------
	2021	! * ARGUMENTS:
	2022
	2023	INTEGER knu ! INDEX OF THE SPECTRAL INTERVAL
	2024	INTEGER kabs ! NUMBER OF ABSORBERS
	2025	INTEGER kind(kabs) ! INDICES OF THE ABSORBERS
[5144]	2026	REAL (KIND = 8) pu(kdlon, kabs) ! ABSORBER AMOUNT
[1992]	2027
[5144]	2028	REAL (KIND = 8) ptr(kdlon, kabs) ! TRANSMISSION FUNCTION
[1992]	2029
	2030	! * LOCAL VARIABLES:
	2031
[5144]	2032	REAL (KIND = 8) zr1(kdlon)
	2033	REAL (KIND = 8) zr2(kdlon)
	2034	REAL (KIND = 8) zu(kdlon)
[1992]	2035	INTEGER jl, ja, i, j, ia
	2036
	2037	! -----------------------------------------------------------------------
	2038
	2039	! * 1. HORNER'S ALGORITHM TO COMPUTE TRANSMISSION FUNCTION
	2040
	2041	DO ja = 1, kabs
	2042	ia = kind(ja)
	2043	DO jl = 1, kdlon
	2044	zu(jl) = pu(jl, ja)
[5144]	2045	zr1(jl) = apad(knu, ia, 1) + zu(jl) * (apad(knu, ia, 2) + zu(jl) * (apad(knu, &
	2046	ia, 3) + zu(jl) * (apad(knu, ia, 4) + zu(jl) * (apad(knu, ia, 5) + zu(jl) * (apad(knu, &
	2047	ia, 6) + zu(jl) * (apad(knu, ia, 7)))))))
[1992]	2048
[5144]	2049	zr2(jl) = bpad(knu, ia, 1) + zu(jl) * (bpad(knu, ia, 2) + zu(jl) * (bpad(knu, &
	2050	ia, 3) + zu(jl) * (bpad(knu, ia, 4) + zu(jl) * (bpad(knu, ia, 5) + zu(jl) * (bpad(knu, &
	2051	ia, 6) + zu(jl) * (bpad(knu, ia, 7)))))))
[1992]	2052
	2053	! * 2. ADD THE BACKGROUND TRANSMISSION
	2054
[5144]	2055	ptr(jl, ja) = (zr1(jl) / zr2(jl)) * (1. - d(knu, ia)) + d(knu, ia)
[1992]	2056	END DO
	2057	END DO
	2058
	2059	END SUBROUTINE swtt1_lmdar4
	2060	! IM ctes ds clesphys.h SUBROUTINE LW(RCO2,RCH4,RN2O,RCFC11,RCFC12,
	2061	SUBROUTINE lw_lmdar4(ppmb, pdp, ppsol, pdt0, pemis, ptl, ptave, pwv, pozon, &
[5144]	2062	paer, pcldld, pcldlu, pview, pcolr, pcolr0, ptoplw, psollw, ptoplw0, &
	2063	psollw0, psollwdown, & ! IM .
	2064	! psollwdown,psollwdownclr,
	2065	! IM . ptoplwdown,ptoplwdownclr)
	2066	plwup, plwdn, plwup0, plwdn0)
[1992]	2067	USE dimphy
[5112]	2068	USE lmdz_print_control, ONLY: lunout
[5144]	2069	! IM ctes ds clesphys.h
[5137]	2070	! REAL(KIND=8) RCO2 ! CO2 CONCENTRATION (IPCC:353.E-06* 44.011/28.97)
	2071	! REAL(KIND=8) RCH4 ! CH4 CONCENTRATION (IPCC: 1.72E-06* 16.043/28.97)
	2072	! REAL(KIND=8) RN2O ! N2O CONCENTRATION (IPCC: 310.E-09* 44.013/28.97)
	2073	! REAL(KIND=8) RCFC11 ! CFC11 CONCENTRATION (IPCC: 280.E-12* 137.3686/28.97)
	2074	! REAL(KIND=8) RCFC12 ! CFC12 CONCENTRATION (IPCC: 484.E-12* 120.9140/28.97)
	2075	USE lmdz_clesphys, ONLY: rco2, rch4, rn2o, rcfc11, rcfc12
[5144]	2076	USE lmdz_yomcst
[5137]	2077
[1992]	2078	IMPLICIT NONE
	2079	include "raddimlw.h"
	2080
	2081	! -----------------------------------------------------------------------
	2082	! METHOD.
	2083	! -------
	2084
	2085	! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
	2086	! ABSORBERS.
	2087	! 2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
	2088	! GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
	2089	! 3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
	2090	! TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
	2091	! BOUNDARIES.
	2092	! 4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
	2093	! 5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES.
	2094
	2095
	2096	! REFERENCE.
	2097	! ----------
	2098
	2099	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2100	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2101
	2102	! AUTHOR.
	2103	! -------
	2104	! JEAN-JACQUES MORCRETTE ECMWF
	2105
	2106	! MODIFICATIONS.
	2107	! --------------
	2108	! ORIGINAL : 89-07-14
	2109	! -----------------------------------------------------------------------
[5137]	2110
[5144]	2111	REAL (KIND = 8) pcldld(kdlon, kflev) ! DOWNWARD EFFECTIVE CLOUD COVER
	2112	REAL (KIND = 8) pcldlu(kdlon, kflev) ! UPWARD EFFECTIVE CLOUD COVER
	2113	REAL (KIND = 8) pdp(kdlon, kflev) ! LAYER PRESSURE THICKNESS (Pa)
	2114	REAL (KIND = 8) pdt0(kdlon) ! SURFACE TEMPERATURE DISCONTINUITY (K)
	2115	REAL (KIND = 8) pemis(kdlon) ! SURFACE EMISSIVITY
	2116	REAL (KIND = 8) ppmb(kdlon, kflev + 1) ! HALF LEVEL PRESSURE (mb)
	2117	REAL (KIND = 8) ppsol(kdlon) ! SURFACE PRESSURE (Pa)
	2118	REAL (KIND = 8) pozon(kdlon, kflev) ! O3 mass fraction
	2119	REAL (KIND = 8) ptl(kdlon, kflev + 1) ! HALF LEVEL TEMPERATURE (K)
	2120	REAL (KIND = 8) paer(kdlon, kflev, 5) ! OPTICAL THICKNESS OF THE AEROSOLS
	2121	REAL (KIND = 8) ptave(kdlon, kflev) ! LAYER TEMPERATURE (K)
	2122	REAL (KIND = 8) pview(kdlon) ! COSECANT OF VIEWING ANGLE
	2123	REAL (KIND = 8) pwv(kdlon, kflev) ! SPECIFIC HUMIDITY (kg/kg)
[1992]	2124
[5144]	2125	REAL (KIND = 8) pcolr(kdlon, kflev) ! LONG-WAVE TENDENCY (K/day)
	2126	REAL (KIND = 8) pcolr0(kdlon, kflev) ! LONG-WAVE TENDENCY (K/day) clear-sky
	2127	REAL (KIND = 8) ptoplw(kdlon) ! LONGWAVE FLUX AT T.O.A.
	2128	REAL (KIND = 8) psollw(kdlon) ! LONGWAVE FLUX AT SURFACE
	2129	REAL (KIND = 8) ptoplw0(kdlon) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
	2130	REAL (KIND = 8) psollw0(kdlon) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
[1992]	2131	! Rajout LF
[5144]	2132	REAL (KIND = 8) psollwdown(kdlon) ! LONGWAVE downwards flux at surface
[1992]	2133	! Rajout IM
	2134	! IM real(kind=8) psollwdownclr(kdlon) ! LONGWAVE CS downwards flux at
	2135	! surface
	2136	! IM real(kind=8) ptoplwdown(kdlon) ! LONGWAVE downwards flux at
	2137	! T.O.A.
	2138	! IM real(kind=8) ptoplwdownclr(kdlon) ! LONGWAVE CS downwards flux at
	2139	! T.O.A.
	2140	! IM
[5144]	2141	REAL (KIND = 8) plwup(kdlon, kflev + 1) ! LW up total sky
	2142	REAL (KIND = 8) plwup0(kdlon, kflev + 1) ! LW up clear sky
	2143	REAL (KIND = 8) plwdn(kdlon, kflev + 1) ! LW down total sky
	2144	REAL (KIND = 8) plwdn0(kdlon, kflev + 1) ! LW down clear sky
[1992]	2145	! -------------------------------------------------------------------------
[5144]	2146	REAL (KIND = 8) zabcu(kdlon, nua, 3 * kflev + 1)
[1992]	2147
[5144]	2148	REAL (KIND = 8) zoz(kdlon, kflev)
[1992]	2149	! equivalent pressure of ozone in a layer, in Pa
	2150
	2151	! ym REAL(KIND=8) ZFLUX(KDLON,2,KFLEV+1) ! RADIATIVE FLUXES (1:up;
	2152	! 2:down)
	2153	! ym REAL(KIND=8) ZFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
	2154	! ym REAL(KIND=8) ZBINT(KDLON,KFLEV+1) ! Intermediate
	2155	! variable
	2156	! ym REAL(KIND=8) ZBSUI(KDLON) ! Intermediate
	2157	! variable
	2158	! ym REAL(KIND=8) ZCTS(KDLON,KFLEV) ! Intermediate
	2159	! variable
	2160	! ym REAL(KIND=8) ZCNTRB(KDLON,KFLEV+1,KFLEV+1) ! Intermediate
	2161	! variable
	2162	! ym SAVE ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB
[5144]	2163	REAL (KIND = 8), ALLOCATABLE, SAVE :: zflux(:, :, :) ! RADIATIVE FLUXES (1:up; 2:down)
	2164	REAL (KIND = 8), ALLOCATABLE, SAVE :: zfluc(:, :, :) ! CLEAR-SKY RADIATIVE FLUXES
	2165	REAL (KIND = 8), ALLOCATABLE, SAVE :: zbint(:, :) ! Intermediate variable
	2166	REAL (KIND = 8), ALLOCATABLE, SAVE :: zbsui(:) ! Intermediate variable
	2167	REAL (KIND = 8), ALLOCATABLE, SAVE :: zcts(:, :) ! Intermediate variable
	2168	REAL (KIND = 8), ALLOCATABLE, SAVE :: zcntrb(:, :, :) ! Intermediate variable
[1992]	2169	!$OMP THREADPRIVATE(ZFLUX, ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
	2170
	2171	INTEGER ilim, i, k, kpl1
	2172
	2173	INTEGER lw0pas ! Every lw0pas steps, clear-sky is done
[5144]	2174	PARAMETER (lw0pas = 1)
[1992]	2175	INTEGER lwpas ! Every lwpas steps, cloudy-sky is done
[5144]	2176	PARAMETER (lwpas = 1)
[1992]	2177
	2178	INTEGER itaplw0, itaplw
	2179	LOGICAL appel1er
	2180	SAVE appel1er, itaplw0, itaplw
	2181	!$OMP THREADPRIVATE(appel1er, itaplw0, itaplw)
	2182	DATA appel1er/.TRUE./
	2183	DATA itaplw0, itaplw/0, 0/
	2184
	2185	! ------------------------------------------------------------------
	2186	IF (appel1er) THEN
	2187	WRITE (lunout, *) 'LW clear-sky calling frequency: ', lw0pas
	2188	WRITE (lunout, *) 'LW cloudy-sky calling frequency: ', lwpas
	2189	WRITE (lunout, *) ' In general, they should be 1'
	2190	! ym
[5144]	2191	ALLOCATE (zflux(kdlon, 2, kflev + 1))
	2192	ALLOCATE (zfluc(kdlon, 2, kflev + 1))
	2193	ALLOCATE (zbint(kdlon, kflev + 1))
[1992]	2194	ALLOCATE (zbsui(kdlon))
[5144]	2195	ALLOCATE (zcts(kdlon, kflev))
	2196	ALLOCATE (zcntrb(kdlon, kflev + 1, kflev + 1))
[1992]	2197	appel1er = .FALSE.
	2198	END IF
	2199
[5144]	2200	IF (mod(itaplw0, lw0pas)==0) THEN
[1992]	2201	! Compute equivalent pressure of ozone from mass fraction:
	2202	DO k = 1, kflev
	2203	DO i = 1, kdlon
[5144]	2204	zoz(i, k) = pozon(i, k) * pdp(i, k)
[1992]	2205	END DO
	2206	END DO
	2207	! IM ctes ds clesphys.h CALL LWU(RCO2,RCH4, RN2O, RCFC11, RCFC12,
	2208	CALL lwu_lmdar4(paer, pdp, ppmb, ppsol, zoz, ptave, pview, pwv, zabcu)
	2209	CALL lwbv_lmdar4(ilim, pdp, pdt0, pemis, ppmb, ptl, ptave, zabcu, zfluc, &
[5144]	2210	zbint, zbsui, zcts, zcntrb)
[1992]	2211	itaplw0 = 0
	2212	END IF
	2213	itaplw0 = itaplw0 + 1
	2214
[5144]	2215	IF (mod(itaplw, lwpas)==0) THEN
[1992]	2216	CALL lwc_lmdar4(ilim, pcldld, pcldlu, pemis, zfluc, zbint, zbsui, zcts, &
[5144]	2217	zcntrb, zflux)
[1992]	2218	itaplw = 0
	2219	END IF
	2220	itaplw = itaplw + 1
	2221
	2222	DO k = 1, kflev
	2223	kpl1 = k + 1
	2224	DO i = 1, kdlon
	2225	pcolr(i, k) = zflux(i, 1, kpl1) + zflux(i, 2, kpl1) - zflux(i, 1, k) - &
[5144]	2226	zflux(i, 2, k)
	2227	pcolr(i, k) = pcolr(i, k) * rday * rg / rcpd / pdp(i, k)
[1992]	2228	pcolr0(i, k) = zfluc(i, 1, kpl1) + zfluc(i, 2, kpl1) - zfluc(i, 1, k) - &
[5144]	2229	zfluc(i, 2, k)
	2230	pcolr0(i, k) = pcolr0(i, k) * rday * rg / rcpd / pdp(i, k)
[1992]	2231	END DO
	2232	END DO
	2233	DO i = 1, kdlon
	2234	psollw(i) = -zflux(i, 1, 1) - zflux(i, 2, 1)
[5144]	2235	ptoplw(i) = zflux(i, 1, kflev + 1) + zflux(i, 2, kflev + 1)
[1992]	2236
	2237	psollw0(i) = -zfluc(i, 1, 1) - zfluc(i, 2, 1)
[5144]	2238	ptoplw0(i) = zfluc(i, 1, kflev + 1) + zfluc(i, 2, kflev + 1)
[1992]	2239	psollwdown(i) = -zflux(i, 2, 1)
	2240
	2241	! IM attention aux signes !; LWtop >0, LWdn < 0
	2242	DO k = 1, kflev + 1
	2243	plwup(i, k) = zflux(i, 1, k)
	2244	plwup0(i, k) = zfluc(i, 1, k)
	2245	plwdn(i, k) = zflux(i, 2, k)
	2246	plwdn0(i, k) = zfluc(i, 2, k)
	2247	END DO
	2248	END DO
	2249	! ------------------------------------------------------------------
[5105]	2250
[1992]	2251	END SUBROUTINE lw_lmdar4
	2252	! IM ctes ds clesphys.h SUBROUTINE LWU(RCO2, RCH4, RN2O, RCFC11, RCFC12,
	2253	SUBROUTINE lwu_lmdar4(paer, pdp, ppmb, ppsol, poz, ptave, pview, pwv, pabcu)
	2254	USE dimphy
	2255	USE radiation_ar4_param, ONLY: tref, rt1, raer, at, bt, oct
[4389]	2256	USE infotrac_phy, ONLY: type_trac
[5185]	2257	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
	2258	USE lmdz_reprobus_wrappers, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d
[5144]	2259	! IM ctes ds clesphys.h
[5137]	2260	! REAL(KIND=8) RCO2
	2261	! REAL(KIND=8) RCH4, RN2O, RCFC11, RCFC12
	2262	USE lmdz_clesphys, ONLY: rco2, rch4, rn2o, rcfc11, rcfc12
[5144]	2263	USE lmdz_yomcst
[1565]	2264
[1992]	2265	IMPLICIT NONE
	2266	include "raddimlw.h"
	2267	include "radepsi.h"
	2268	include "radopt.h"
[1279]	2269
[1992]	2270	! PURPOSE.
	2271	! --------
	2272	! COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
	2273	! TEMPERATURE EFFECTS
[1565]	2274
[1992]	2275	! METHOD.
	2276	! -------
	2277
	2278	! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
	2279	! ABSORBERS.
	2280
	2281
	2282	! REFERENCE.
	2283	! ----------
	2284
	2285	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2286	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2287
	2288	! AUTHOR.
	2289	! -------
	2290	! JEAN-JACQUES MORCRETTE ECMWF
	2291
	2292	! MODIFICATIONS.
	2293	! --------------
	2294	! ORIGINAL : 89-07-14
	2295	! Voigt lines (loop 404 modified) - JJM & PhD - 01/96
	2296	! -----------------------------------------------------------------------
	2297	! * ARGUMENTS:
[5144]	2298	REAL (KIND = 8) paer(kdlon, kflev, 5)
	2299	REAL (KIND = 8) pdp(kdlon, kflev)
	2300	REAL (KIND = 8) ppmb(kdlon, kflev + 1)
	2301	REAL (KIND = 8) ppsol(kdlon)
	2302	REAL (KIND = 8) poz(kdlon, kflev)
	2303	REAL (KIND = 8) ptave(kdlon, kflev)
	2304	REAL (KIND = 8) pview(kdlon)
	2305	REAL (KIND = 8) pwv(kdlon, kflev)
[1992]	2306
[5144]	2307	REAL (KIND = 8) pabcu(kdlon, nua, 3 * kflev + 1) ! EFFECTIVE ABSORBER AMOUNTS
[1992]	2308
	2309	! -----------------------------------------------------------------------
	2310	! * LOCAL VARIABLES:
[5144]	2311	REAL (KIND = 8) zably(kdlon, nua, 3 * kflev + 1)
	2312	REAL (KIND = 8) zduc(kdlon, 3 * kflev + 1)
	2313	REAL (KIND = 8) zphio(kdlon)
	2314	REAL (KIND = 8) zpsc2(kdlon)
	2315	REAL (KIND = 8) zpsc3(kdlon)
	2316	REAL (KIND = 8) zpsh1(kdlon)
	2317	REAL (KIND = 8) zpsh2(kdlon)
	2318	REAL (KIND = 8) zpsh3(kdlon)
	2319	REAL (KIND = 8) zpsh4(kdlon)
	2320	REAL (KIND = 8) zpsh5(kdlon)
	2321	REAL (KIND = 8) zpsh6(kdlon)
	2322	REAL (KIND = 8) zpsio(kdlon)
	2323	REAL (KIND = 8) ztcon(kdlon)
	2324	REAL (KIND = 8) zphm6(kdlon)
	2325	REAL (KIND = 8) zpsm6(kdlon)
	2326	REAL (KIND = 8) zphn6(kdlon)
	2327	REAL (KIND = 8) zpsn6(kdlon)
	2328	REAL (KIND = 8) zssig(kdlon, 3 * kflev + 1)
	2329	REAL (KIND = 8) ztavi(kdlon)
	2330	REAL (KIND = 8) zuaer(kdlon, ninter)
	2331	REAL (KIND = 8) zxoz(kdlon)
	2332	REAL (KIND = 8) zxwv(kdlon)
[1992]	2333
	2334	INTEGER jl, jk, jkj, jkjr, jkjp, ig1
	2335	INTEGER jki, jkip1, ja, jj
	2336	INTEGER jkl, jkp1, jkk, jkjpn
	2337	INTEGER jae1, jae2, jae3, jae, jjpn
	2338	INTEGER ir, jc, jcp1
[5144]	2339	REAL (KIND = 8) zdpm, zupm, zupmh2o, zupmco2, zupmo3, zu6, zup
	2340	REAL (KIND = 8) zfppw, ztx, ztx2, zzably
	2341	REAL (KIND = 8) zcah1, zcbh1, zcah2, zcbh2, zcah3, zcbh3
	2342	REAL (KIND = 8) zcah4, zcbh4, zcah5, zcbh5, zcah6, zcbh6
	2343	REAL (KIND = 8) zcac8, zcbc8
	2344	REAL (KIND = 8) zalup, zdiff
[1992]	2345
[5144]	2346	REAL (KIND = 8) pvgco2, pvgh2o, pvgo3
[1992]	2347
[5144]	2348	REAL (KIND = 8) r10e ! DECIMAL/NATURAL LOG.FACTOR
	2349	PARAMETER (r10e = 0.4342945)
[1992]	2350
	2351	! -----------------------------------------------------------------------
	2352
	2353	IF (levoigt) THEN
	2354	pvgco2 = 60.
	2355	pvgh2o = 30.
	2356	pvgo3 = 400.
	2357	ELSE
	2358	pvgco2 = 0.
	2359	pvgh2o = 0.
	2360	pvgo3 = 0.
	2361	END IF
	2362
	2363	! * 2. PRESSURE OVER GAUSS SUB-LEVELS
	2364	! ------------------------------
	2365
	2366	DO jl = 1, kdlon
[5144]	2367	zssig(jl, 1) = ppmb(jl, 1) * 100.
[1992]	2368	END DO
	2369
	2370	DO jk = 1, kflev
[5144]	2371	jkj = (jk - 1) * ng1p1 + 1
[1992]	2372	jkjr = jkj
	2373	jkjp = jkj + ng1p1
	2374	DO jl = 1, kdlon
[5144]	2375	zssig(jl, jkjp) = ppmb(jl, jk + 1) * 100.
[1992]	2376	END DO
	2377	DO ig1 = 1, ng1
	2378	jkj = jkj + 1
	2379	DO jl = 1, kdlon
[5144]	2380	zssig(jl, jkj) = (zssig(jl, jkjr) + zssig(jl, jkjp)) * 0.5 + &
	2381	rt1(ig1) * (zssig(jl, jkjp) - zssig(jl, jkjr)) * 0.5
[1992]	2382	END DO
	2383	END DO
	2384	END DO
	2385
	2386	! -----------------------------------------------------------------------
	2387
	2388
	2389	! * 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
	2390	! --------------------------------------------------
	2391
[5144]	2392	DO jki = 1, 3 * kflev
[1992]	2393	jkip1 = jki + 1
	2394	DO jl = 1, kdlon
[5144]	2395	zably(jl, 5, jki) = (zssig(jl, jki) + zssig(jl, jkip1)) * 0.5
	2396	zably(jl, 3, jki) = (zssig(jl, jki) - zssig(jl, jkip1)) / (10. * rg)
[1992]	2397	END DO
	2398	END DO
	2399
	2400	DO jk = 1, kflev
	2401	jkp1 = jk + 1
	2402	jkl = kflev + 1 - jk
	2403	DO jl = 1, kdlon
[5144]	2404	zxwv(jl) = max(pwv(jl, jk), zepscq)
	2405	zxoz(jl) = max(poz(jl, jk) / pdp(jl, jk), zepsco)
[1992]	2406	END DO
[5144]	2407	jkj = (jk - 1) * ng1p1 + 1
[1992]	2408	jkjpn = jkj + ng1
	2409	DO jkk = jkj, jkjpn
	2410	DO jl = 1, kdlon
	2411	zdpm = zably(jl, 3, jkk)
[5144]	2412	zupm = zably(jl, 5, jkk) * zdpm / 101325.
	2413	zupmco2 = (zably(jl, 5, jkk) + pvgco2) * zdpm / 101325.
	2414	zupmh2o = (zably(jl, 5, jkk) + pvgh2o) * zdpm / 101325.
	2415	zupmo3 = (zably(jl, 5, jkk) + pvgo3) * zdpm / 101325.
[1992]	2416	zduc(jl, jkk) = zdpm
[5144]	2417	zably(jl, 12, jkk) = zxoz(jl) * zdpm
	2418	zably(jl, 13, jkk) = zxoz(jl) * zupmo3
	2419	zu6 = zxwv(jl) * zupm
	2420	zfppw = 1.6078 * zxwv(jl) / (1. + 0.608 * zxwv(jl))
	2421	zably(jl, 6, jkk) = zxwv(jl) * zupmh2o
	2422	zably(jl, 11, jkk) = zu6 * zfppw
	2423	zably(jl, 10, jkk) = zu6 * (1. - zfppw)
	2424	zably(jl, 9, jkk) = rco2 * zupmco2
	2425	zably(jl, 8, jkk) = rco2 * zdpm
[1992]	2426	END DO
	2427	END DO
	2428	END DO
	2429
	2430	! -----------------------------------------------------------------------
	2431
	2432
	2433	! * 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
	2434	! --------------------------------------------------
	2435
	2436	DO ja = 1, nua
	2437	DO jl = 1, kdlon
[5144]	2438	pabcu(jl, ja, 3 * kflev + 1) = 0.
[1992]	2439	END DO
	2440	END DO
	2441
	2442	DO jk = 1, kflev
[5144]	2443	jj = (jk - 1) * ng1p1 + 1
[1992]	2444	jjpn = jj + ng1
	2445	jkl = kflev + 1 - jk
	2446
	2447	! * 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
	2448	! --------------------------------------------------
	2449
[5144]	2450	jae1 = 3 * kflev + 1 - jj
	2451	jae2 = 3 * kflev + 1 - (jj + 1)
	2452	jae3 = 3 * kflev + 1 - jjpn
[1992]	2453	DO jae = 1, 5
	2454	DO jl = 1, kdlon
[5144]	2455	zuaer(jl, jae) = (raer(jae, 1) * paer(jl, jkl, 1) + raer(jae, 2) * paer(jl, jkl, &
	2456	2) + raer(jae, 3) * paer(jl, jkl, 3) + raer(jae, 4) * paer(jl, jkl, 4) + &
	2457	raer(jae, 5) * paer(jl, jkl, 5)) / (zduc(jl, jae1) + zduc(jl, jae2) + zduc(jl, &
	2458	jae3))
[1992]	2459	END DO
	2460	END DO
	2461
	2462	! * 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
	2463	! --------------------------------------------------
	2464
	2465	DO jl = 1, kdlon
	2466	ztavi(jl) = ptave(jl, jkl)
[5144]	2467	ztcon(jl) = exp(6.08 * (296. / ztavi(jl) - 1.))
[1992]	2468	ztx = ztavi(jl) - tref
[5144]	2469	ztx2 = ztx * ztx
[1992]	2470	zzably = zably(jl, 6, jae1) + zably(jl, 6, jae2) + zably(jl, 6, jae3)
[5144]	2471	zup = min(max(0.5 * r10e * log(zzably) + 5., 0._8), 6._8)
	2472	zcah1 = at(1, 1) + zup * (at(1, 2) + zup * (at(1, 3)))
	2473	zcbh1 = bt(1, 1) + zup * (bt(1, 2) + zup * (bt(1, 3)))
	2474	zpsh1(jl) = exp(zcah1 * ztx + zcbh1 * ztx2)
	2475	zcah2 = at(2, 1) + zup * (at(2, 2) + zup * (at(2, 3)))
	2476	zcbh2 = bt(2, 1) + zup * (bt(2, 2) + zup * (bt(2, 3)))
	2477	zpsh2(jl) = exp(zcah2 * ztx + zcbh2 * ztx2)
	2478	zcah3 = at(3, 1) + zup * (at(3, 2) + zup * (at(3, 3)))
	2479	zcbh3 = bt(3, 1) + zup * (bt(3, 2) + zup * (bt(3, 3)))
	2480	zpsh3(jl) = exp(zcah3 * ztx + zcbh3 * ztx2)
	2481	zcah4 = at(4, 1) + zup * (at(4, 2) + zup * (at(4, 3)))
	2482	zcbh4 = bt(4, 1) + zup * (bt(4, 2) + zup * (bt(4, 3)))
	2483	zpsh4(jl) = exp(zcah4 * ztx + zcbh4 * ztx2)
	2484	zcah5 = at(5, 1) + zup * (at(5, 2) + zup * (at(5, 3)))
	2485	zcbh5 = bt(5, 1) + zup * (bt(5, 2) + zup * (bt(5, 3)))
	2486	zpsh5(jl) = exp(zcah5 * ztx + zcbh5 * ztx2)
	2487	zcah6 = at(6, 1) + zup * (at(6, 2) + zup * (at(6, 3)))
	2488	zcbh6 = bt(6, 1) + zup * (bt(6, 2) + zup * (bt(6, 3)))
	2489	zpsh6(jl) = exp(zcah6 * ztx + zcbh6 * ztx2)
	2490	zphm6(jl) = exp(-5.81E-4 * ztx - 1.13E-6 * ztx2)
	2491	zpsm6(jl) = exp(-5.57E-4 * ztx - 3.30E-6 * ztx2)
	2492	zphn6(jl) = exp(-3.46E-5 * ztx + 2.05E-7 * ztx2)
	2493	zpsn6(jl) = exp(3.70E-3 * ztx - 2.30E-6 * ztx2)
[1992]	2494	END DO
	2495
	2496	DO jl = 1, kdlon
	2497	ztavi(jl) = ptave(jl, jkl)
	2498	ztx = ztavi(jl) - tref
[5144]	2499	ztx2 = ztx * ztx
[1992]	2500	zzably = zably(jl, 9, jae1) + zably(jl, 9, jae2) + zably(jl, 9, jae3)
[5144]	2501	zalup = r10e * log(zzably)
	2502	zup = max(0._8, 5.0 + 0.5 * zalup)
	2503	zpsc2(jl) = (ztavi(jl) / tref)**zup
	2504	zcac8 = at(8, 1) + zup * (at(8, 2) + zup * (at(8, 3)))
	2505	zcbc8 = bt(8, 1) + zup * (bt(8, 2) + zup * (bt(8, 3)))
	2506	zpsc3(jl) = exp(zcac8 * ztx + zcbc8 * ztx2)
	2507	zphio(jl) = exp(oct(1) * ztx + oct(2) * ztx2)
	2508	zpsio(jl) = exp(2. * (oct(3) * ztx + oct(4) * ztx2))
[1992]	2509	END DO
	2510
	2511	DO jkk = jj, jjpn
[5144]	2512	jc = 3 * kflev + 1 - jkk
[1992]	2513	jcp1 = jc + 1
	2514	DO jl = 1, kdlon
	2515	zdiff = pview(jl)
[5144]	2516	pabcu(jl, 10, jc) = pabcu(jl, 10, jcp1) + zably(jl, 10, jc) * zdiff
	2517	pabcu(jl, 11, jc) = pabcu(jl, 11, jcp1) + zably(jl, 11, jc) * ztcon(jl) &
	2518	* zdiff
[1992]	2519
[5144]	2520	pabcu(jl, 12, jc) = pabcu(jl, 12, jcp1) + zably(jl, 12, jc) * zphio(jl) &
	2521	* zdiff
	2522	pabcu(jl, 13, jc) = pabcu(jl, 13, jcp1) + zably(jl, 13, jc) * zpsio(jl) &
	2523	* zdiff
[1992]	2524
[5144]	2525	pabcu(jl, 7, jc) = pabcu(jl, 7, jcp1) + zably(jl, 9, jc) * zpsc2(jl) * &
	2526	zdiff
	2527	pabcu(jl, 8, jc) = pabcu(jl, 8, jcp1) + zably(jl, 9, jc) * zpsc3(jl) * &
	2528	zdiff
	2529	pabcu(jl, 9, jc) = pabcu(jl, 9, jcp1) + zably(jl, 9, jc) * zpsc3(jl) * &
	2530	zdiff
[1992]	2531
[5144]	2532	pabcu(jl, 1, jc) = pabcu(jl, 1, jcp1) + zably(jl, 6, jc) * zpsh1(jl) * &
	2533	zdiff
	2534	pabcu(jl, 2, jc) = pabcu(jl, 2, jcp1) + zably(jl, 6, jc) * zpsh2(jl) * &
	2535	zdiff
	2536	pabcu(jl, 3, jc) = pabcu(jl, 3, jcp1) + zably(jl, 6, jc) * zpsh5(jl) * &
	2537	zdiff
	2538	pabcu(jl, 4, jc) = pabcu(jl, 4, jcp1) + zably(jl, 6, jc) * zpsh3(jl) * &
	2539	zdiff
	2540	pabcu(jl, 5, jc) = pabcu(jl, 5, jcp1) + zably(jl, 6, jc) * zpsh4(jl) * &
	2541	zdiff
	2542	pabcu(jl, 6, jc) = pabcu(jl, 6, jcp1) + zably(jl, 6, jc) * zpsh6(jl) * &
	2543	zdiff
[1992]	2544
[5144]	2545	pabcu(jl, 14, jc) = pabcu(jl, 14, jcp1) + zuaer(jl, 1) * zduc(jl, jc) * &
	2546	zdiff
	2547	pabcu(jl, 15, jc) = pabcu(jl, 15, jcp1) + zuaer(jl, 2) * zduc(jl, jc) * &
	2548	zdiff
	2549	pabcu(jl, 16, jc) = pabcu(jl, 16, jcp1) + zuaer(jl, 3) * zduc(jl, jc) * &
	2550	zdiff
	2551	pabcu(jl, 17, jc) = pabcu(jl, 17, jcp1) + zuaer(jl, 4) * zduc(jl, jc) * &
	2552	zdiff
	2553	pabcu(jl, 18, jc) = pabcu(jl, 18, jcp1) + zuaer(jl, 5) * zduc(jl, jc) * &
	2554	zdiff
[1992]	2555
[4389]	2556	IF (type_trac=='repr') THEN
[5185]	2557	IF (CPPKEY_REPROBUS) THEN
	2558	IF (ok_rtime2d) THEN
	2559	pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
	2560	zably(jl, 8, jc) * rch42d(jl, jc) / rco2 * zphm6(jl) * zdiff
	2561	pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
	2562	zably(jl, 9, jc) * rch42d(jl, jc) / rco2 * zpsm6(jl) * zdiff
	2563	pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
	2564	zably(jl, 8, jc) * rn2o2d(jl, jc) / rco2 * zphn6(jl) * zdiff
	2565	pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
	2566	zably(jl, 9, jc) * rn2o2d(jl, jc) / rco2 * zpsn6(jl) * zdiff
[1992]	2567
[5185]	2568	pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
	2569	zably(jl, 8, jc) * rcfc112d(jl, jc) / rco2 * zdiff
	2570	pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
	2571	zably(jl, 8, jc) * rcfc122d(jl, jc) / rco2 * zdiff
	2572	ELSE
[1992]	2573	! Same calculation as for type_trac /= repr
[5185]	2574	pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
	2575	zably(jl, 8, jc) * rch4 / rco2 * zphm6(jl) * zdiff
	2576	pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
	2577	zably(jl, 9, jc) * rch4 / rco2 * zpsm6(jl) * zdiff
	2578	pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
	2579	zably(jl, 8, jc) * rn2o / rco2 * zphn6(jl) * zdiff
	2580	pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
	2581	zably(jl, 9, jc) * rn2o / rco2 * zpsn6(jl) * zdiff
[1992]	2582
[5185]	2583	pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
	2584	zably(jl, 8, jc) * rcfc11 / rco2 * zdiff
	2585	pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
	2586	zably(jl, 8, jc) * rcfc12 / rco2 * zdiff
	2587	END IF
[1992]	2588	END IF
	2589	ELSE
	2590	pabcu(jl, 19, jc) = pabcu(jl, 19, jcp1) + &
[5144]	2591	zably(jl, 8, jc) * rch4 / rco2 * zphm6(jl) * zdiff
[1992]	2592	pabcu(jl, 20, jc) = pabcu(jl, 20, jcp1) + &
[5144]	2593	zably(jl, 9, jc) * rch4 / rco2 * zpsm6(jl) * zdiff
[1992]	2594	pabcu(jl, 21, jc) = pabcu(jl, 21, jcp1) + &
[5144]	2595	zably(jl, 8, jc) * rn2o / rco2 * zphn6(jl) * zdiff
[1992]	2596	pabcu(jl, 22, jc) = pabcu(jl, 22, jcp1) + &
[5144]	2597	zably(jl, 9, jc) * rn2o / rco2 * zpsn6(jl) * zdiff
[1992]	2598
	2599	pabcu(jl, 23, jc) = pabcu(jl, 23, jcp1) + &
[5144]	2600	zably(jl, 8, jc) * rcfc11 / rco2 * zdiff
[1992]	2601	pabcu(jl, 24, jc) = pabcu(jl, 24, jcp1) + &
[5144]	2602	zably(jl, 8, jc) * rcfc12 / rco2 * zdiff
[1992]	2603	END IF
	2604
	2605	END DO
	2606	END DO
	2607
	2608	END DO
	2609
	2610	END SUBROUTINE lwu_lmdar4
	2611	SUBROUTINE lwbv_lmdar4(klim, pdp, pdt0, pemis, ppmb, ptl, ptave, pabcu, &
[5144]	2612	pfluc, pbint, pbsui, pcts, pcntrb)
[1992]	2613	USE dimphy
[5144]	2614	USE lmdz_yomcst
	2615
[1992]	2616	IMPLICIT NONE
	2617	include "raddimlw.h"
	2618
	2619	! PURPOSE.
	2620	! --------
	2621	! TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
	2622	! VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
	2623	! SAVING
	2624
	2625	! METHOD.
	2626	! -------
	2627
	2628	! 1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
	2629	! GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
	2630	! 2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
	2631	! TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
	2632	! BOUNDARIES.
	2633	! 3. COMPUTES THE CLEAR-SKY COOLING RATES.
	2634
	2635	! REFERENCE.
	2636	! ----------
	2637
	2638	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2639	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2640
	2641	! AUTHOR.
	2642	! -------
	2643	! JEAN-JACQUES MORCRETTE ECMWF
	2644
	2645	! MODIFICATIONS.
	2646	! --------------
	2647	! ORIGINAL : 89-07-14
	2648	! MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
	2649	! MEMORY)
	2650	! -----------------------------------------------------------------------
	2651	! * ARGUMENTS:
	2652	INTEGER klim
	2653
[5144]	2654	REAL (KIND = 8) pdp(kdlon, kflev)
	2655	REAL (KIND = 8) pdt0(kdlon)
	2656	REAL (KIND = 8) pemis(kdlon)
	2657	REAL (KIND = 8) ppmb(kdlon, kflev + 1)
	2658	REAL (KIND = 8) ptl(kdlon, kflev + 1)
	2659	REAL (KIND = 8) ptave(kdlon, kflev)
[1992]	2660
[5144]	2661	REAL (KIND = 8) pfluc(kdlon, 2, kflev + 1)
[1992]	2662
[5144]	2663	REAL (KIND = 8) pabcu(kdlon, nua, 3 * kflev + 1)
	2664	REAL (KIND = 8) pbint(kdlon, kflev + 1)
	2665	REAL (KIND = 8) pbsui(kdlon)
	2666	REAL (KIND = 8) pcts(kdlon, kflev)
	2667	REAL (KIND = 8) pcntrb(kdlon, kflev + 1, kflev + 1)
[1992]	2668
	2669	! -------------------------------------------------------------------------
	2670
	2671	! * LOCAL VARIABLES:
[5144]	2672	REAL (KIND = 8) zb(kdlon, ninter, kflev + 1)
	2673	REAL (KIND = 8) zbsur(kdlon, ninter)
	2674	REAL (KIND = 8) zbtop(kdlon, ninter)
	2675	REAL (KIND = 8) zdbsl(kdlon, ninter, kflev * 2)
	2676	REAL (KIND = 8) zga(kdlon, 8, 2, kflev)
	2677	REAL (KIND = 8) zgb(kdlon, 8, 2, kflev)
	2678	REAL (KIND = 8) zgasur(kdlon, 8, 2)
	2679	REAL (KIND = 8) zgbsur(kdlon, 8, 2)
	2680	REAL (KIND = 8) zgatop(kdlon, 8, 2)
	2681	REAL (KIND = 8) zgbtop(kdlon, 8, 2)
[1992]	2682
	2683	INTEGER nuaer, ntraer
	2684	! ------------------------------------------------------------------
	2685	! * COMPUTES PLANCK FUNCTIONS:
	2686	CALL lwb_lmdar4(pdt0, ptave, ptl, zb, pbint, pbsui, zbsur, zbtop, zdbsl, &
[5144]	2687	zga, zgb, zgasur, zgbsur, zgatop, zgbtop)
[1992]	2688	! ------------------------------------------------------------------
	2689	! * PERFORMS THE VERTICAL INTEGRATION:
	2690	nuaer = nua
	2691	ntraer = ntra
	2692	CALL lwv_lmdar4(nuaer, ntraer, klim, pabcu, zb, pbint, pbsui, zbsur, zbtop, &
[5144]	2693	zdbsl, pemis, ppmb, ptave, zga, zgb, zgasur, zgbsur, zgatop, zgbtop, &
	2694	pcntrb, pcts, pfluc)
[1992]	2695	! ------------------------------------------------------------------
[5105]	2696
[1992]	2697	END SUBROUTINE lwbv_lmdar4
	2698	SUBROUTINE lwc_lmdar4(klim, pcldld, pcldlu, pemis, pfluc, pbint, pbsuin, &
[5144]	2699	pcts, pcntrb, pflux)
[1992]	2700	USE dimphy
	2701	IMPLICIT NONE
	2702	include "radepsi.h"
	2703	include "radopt.h"
	2704
	2705	! PURPOSE.
	2706	! --------
	2707	! INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR
	2708	! RADIANCES
	2709
	2710	! EXPLICIT ARGUMENTS :
	2711	! --------------------
	2712	! ==== INPUTS ===
	2713	! PBINT : (KDLON,0:KFLEV) ; HALF LEVEL PLANCK FUNCTION
	2714	! PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION
	2715	! PCLDLD : (KDLON,KFLEV) ; DOWNWARD EFFECTIVE CLOUD FRACTION
	2716	! PCLDLU : (KDLON,KFLEV) ; UPWARD EFFECTIVE CLOUD FRACTION
	2717	! PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE
	2718	! PCTS : (KDLON,KFLEV) ; CLEAR-SKY LAYER COOLING-TO-SPACE
	2719	! PEMIS : (KDLON) ; SURFACE EMISSIVITY
	2720	! PFLUC
	2721	! ==== OUTPUTS ===
	2722	! PFLUX(KDLON,2,KFLEV) ; RADIATIVE FLUXES :
	2723	! 1 ==> UPWARD FLUX TOTAL
	2724	! 2 ==> DOWNWARD FLUX TOTAL
	2725
	2726	! METHOD.
	2727	! -------
	2728
	2729	! 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES
	2730	! 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER
	2731	! 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED
	2732	! CLOUDS
	2733
	2734	! REFERENCE.
	2735	! ----------
	2736
	2737	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	2738	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	2739
	2740	! AUTHOR.
	2741	! -------
	2742	! JEAN-JACQUES MORCRETTE ECMWF
	2743
	2744	! MODIFICATIONS.
	2745	! --------------
	2746	! ORIGINAL : 89-07-14
	2747	! Voigt lines (loop 231 to 233) - JJM & PhD - 01/96
	2748	! -----------------------------------------------------------------------
	2749	! * ARGUMENTS:
	2750	INTEGER klim
[5144]	2751	REAL (KIND = 8) pfluc(kdlon, 2, kflev + 1) ! CLEAR-SKY RADIATIVE FLUXES
	2752	REAL (KIND = 8) pbint(kdlon, kflev + 1) ! HALF LEVEL PLANCK FUNCTION
	2753	REAL (KIND = 8) pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
	2754	REAL (KIND = 8) pcntrb(kdlon, kflev + 1, kflev + 1) !CLEAR-SKY ENERGY EXCHANGE
	2755	REAL (KIND = 8) pcts(kdlon, kflev) ! CLEAR-SKY LAYER COOLING-TO-SPACE
[1992]	2756
[5144]	2757	REAL (KIND = 8) pcldld(kdlon, kflev)
	2758	REAL (KIND = 8) pcldlu(kdlon, kflev)
	2759	REAL (KIND = 8) pemis(kdlon)
[1992]	2760
[5144]	2761	REAL (KIND = 8) pflux(kdlon, 2, kflev + 1)
[1992]	2762	! -----------------------------------------------------------------------
	2763	! * LOCAL VARIABLES:
	2764	INTEGER imx(kdlon), imxp(kdlon)
	2765
[5144]	2766	REAL (KIND = 8) zclear(kdlon), zcloud(kdlon), zdnf(kdlon, kflev + 1, kflev + 1), &
	2767	zfd(kdlon), zfn10(kdlon), zfu(kdlon), zupf(kdlon, kflev + 1, kflev + 1)
	2768	REAL (KIND = 8) zclm(kdlon, kflev + 1, kflev + 1)
[1992]	2769
	2770	INTEGER jk, jl, imaxc, imx1, imx2, jkj, jkp1, jkm1
	2771	INTEGER jk1, jk2, jkc, jkcp1, jcloud
	2772	INTEGER imxm1, imxp1
[5144]	2773	REAL (KIND = 8) zcfrac
[1992]	2774
	2775	! ------------------------------------------------------------------
	2776
	2777	! * 1. INITIALIZATION
	2778	! --------------
	2779
	2780	imaxc = 0
	2781
	2782	DO jl = 1, kdlon
	2783	imx(jl) = 0
	2784	imxp(jl) = 0
	2785	zcloud(jl) = 0.
	2786	END DO
	2787
	2788	! * 1.1 SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD
	2789	! -------------------------------------------
	2790
	2791	DO jk = 1, kflev
	2792	DO jl = 1, kdlon
	2793	imx1 = imx(jl)
	2794	imx2 = jk
[5144]	2795	IF (pcldlu(jl, jk)>zepsc) THEN
[1992]	2796	imxp(jl) = imx2
[1565]	2797	ELSE
[1992]	2798	imxp(jl) = imx1
[1565]	2799	END IF
[1992]	2800	imaxc = max(imxp(jl), imaxc)
	2801	imx(jl) = imxp(jl)
	2802	END DO
	2803	END DO
	2804	! GM*******
	2805	imaxc = kflev
	2806	! GM*******
	2807
	2808	DO jk = 1, kflev + 1
	2809	DO jl = 1, kdlon
	2810	pflux(jl, 1, jk) = pfluc(jl, 1, jk)
	2811	pflux(jl, 2, jk) = pfluc(jl, 2, jk)
	2812	END DO
	2813	END DO
	2814
	2815	! ------------------------------------------------------------------
	2816
	2817	! * 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES
	2818	! ---------------------------------------
	2819
	2820	IF (imaxc>0) THEN
	2821
	2822	imxp1 = imaxc + 1
	2823	imxm1 = imaxc - 1
	2824
	2825	! * 2.0 INITIALIZE TO CLEAR-SKY FLUXES
	2826	! ------------------------------
	2827
	2828	DO jk1 = 1, kflev + 1
	2829	DO jk2 = 1, kflev + 1
	2830	DO jl = 1, kdlon
	2831	zupf(jl, jk2, jk1) = pfluc(jl, 1, jk1)
	2832	zdnf(jl, jk2, jk1) = pfluc(jl, 2, jk1)
	2833	END DO
	2834	END DO
	2835	END DO
	2836
	2837	! * 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD
	2838	! ----------------------------------------------
	2839
	2840	DO jkc = 1, imaxc
	2841	jcloud = jkc
	2842	jkcp1 = jcloud + 1
	2843
	2844	! * 2.1.1 ABOVE THE CLOUD
	2845	! ---------------
	2846
	2847	DO jk = jkcp1, kflev + 1
	2848	jkm1 = jk - 1
	2849	DO jl = 1, kdlon
	2850	zfu(jl) = 0.
	2851	END DO
	2852	IF (jk>jkcp1) THEN
	2853	DO jkj = jkcp1, jkm1
	2854	DO jl = 1, kdlon
	2855	zfu(jl) = zfu(jl) + pcntrb(jl, jk, jkj)
	2856	END DO
	2857	END DO
	2858	END IF
	2859
	2860	DO jl = 1, kdlon
	2861	zupf(jl, jkcp1, jk) = pbint(jl, jk) - zfu(jl)
	2862	END DO
	2863	END DO
	2864
	2865	! * 2.1.2 BELOW THE CLOUD
	2866	! ---------------
	2867
	2868	DO jk = 1, jcloud
	2869	jkp1 = jk + 1
	2870	DO jl = 1, kdlon
	2871	zfd(jl) = 0.
	2872	END DO
	2873
	2874	IF (jk<jcloud) THEN
	2875	DO jkj = jkp1, jcloud
	2876	DO jl = 1, kdlon
	2877	zfd(jl) = zfd(jl) + pcntrb(jl, jk, jkj)
	2878	END DO
	2879	END DO
	2880	END IF
	2881	DO jl = 1, kdlon
	2882	zdnf(jl, jkcp1, jk) = -pbint(jl, jk) - zfd(jl)
	2883	END DO
	2884	END DO
	2885
	2886	END DO
	2887
	2888	! * 2.2 CLOUD COVER MATRIX
	2889	! ------------------
	2890
	2891	! * ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN
	2892	! HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1
	2893
	2894	DO jk1 = 1, kflev + 1
	2895	DO jk2 = 1, kflev + 1
	2896	DO jl = 1, kdlon
	2897	zclm(jl, jk1, jk2) = 0.
	2898	END DO
	2899	END DO
	2900	END DO
	2901
	2902	! * 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION
	2903	! ------------------------------------------
	2904
	2905	DO jk1 = 2, kflev + 1
	2906	DO jl = 1, kdlon
	2907	zclear(jl) = 1.
	2908	zcloud(jl) = 0.
	2909	END DO
	2910	DO jk = jk1 - 1, 1, -1
	2911	DO jl = 1, kdlon
	2912	IF (novlp==1) THEN
	2913	! * maximum-random
[5144]	2914	zclear(jl) = zclear(jl) * (1.0 - max(pcldlu(jl, &
	2915	jk), zcloud(jl))) / (1.0 - min(zcloud(jl), 1. - zepsec))
[1992]	2916	zclm(jl, jk1, jk) = 1.0 - zclear(jl)
	2917	zcloud(jl) = pcldlu(jl, jk)
	2918	ELSE IF (novlp==2) THEN
	2919	! * maximum
[5144]	2920	zcloud(jl) = max(zcloud(jl), pcldlu(jl, jk))
[1992]	2921	zclm(jl, jk1, jk) = zcloud(jl)
	2922	ELSE IF (novlp==3) THEN
	2923	! * random
[5144]	2924	zclear(jl) = zclear(jl) * (1.0 - pcldlu(jl, jk))
[1992]	2925	zcloud(jl) = 1.0 - zclear(jl)
	2926	zclm(jl, jk1, jk) = zcloud(jl)
	2927	END IF
	2928	END DO
	2929	END DO
	2930	END DO
	2931
	2932	! * 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION
	2933	! ------------------------------------------
	2934
	2935	DO jk1 = 1, kflev
	2936	DO jl = 1, kdlon
	2937	zclear(jl) = 1.
	2938	zcloud(jl) = 0.
	2939	END DO
	2940	DO jk = jk1, kflev
	2941	DO jl = 1, kdlon
	2942	IF (novlp==1) THEN
	2943	! * maximum-random
[5144]	2944	zclear(jl) = zclear(jl) * (1.0 - max(pcldld(jl, &
	2945	jk), zcloud(jl))) / (1.0 - min(zcloud(jl), 1. - zepsec))
[1992]	2946	zclm(jl, jk1, jk) = 1.0 - zclear(jl)
	2947	zcloud(jl) = pcldld(jl, jk)
	2948	ELSE IF (novlp==2) THEN
	2949	! * maximum
[5144]	2950	zcloud(jl) = max(zcloud(jl), pcldld(jl, jk))
[1992]	2951	zclm(jl, jk1, jk) = zcloud(jl)
	2952	ELSE IF (novlp==3) THEN
	2953	! * random
[5144]	2954	zclear(jl) = zclear(jl) * (1.0 - pcldld(jl, jk))
[1992]	2955	zcloud(jl) = 1.0 - zclear(jl)
	2956	zclm(jl, jk1, jk) = zcloud(jl)
	2957	END IF
	2958	END DO
	2959	END DO
	2960	END DO
	2961
	2962	! * 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS
	2963	! ----------------------------------------------
	2964
	2965
	2966	! * 3.1 DOWNWARD FLUXES
	2967	! ---------------
	2968
	2969	DO jl = 1, kdlon
[5144]	2970	pflux(jl, 2, kflev + 1) = 0.
[1992]	2971	END DO
	2972
	2973	DO jk1 = kflev, 1, -1
	2974
	2975	! * CONTRIBUTION FROM CLEAR-SKY FRACTION
	2976
	2977	DO jl = 1, kdlon
[5144]	2978	zfd(jl) = (1. - zclm(jl, jk1, kflev)) * zdnf(jl, 1, jk1)
[1992]	2979	END DO
	2980
	2981	! * CONTRIBUTION FROM ADJACENT CLOUD
	2982
	2983	DO jl = 1, kdlon
[5144]	2984	zfd(jl) = zfd(jl) + zclm(jl, jk1, jk1) * zdnf(jl, jk1 + 1, jk1)
[1992]	2985	END DO
	2986
	2987	! * CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
	2988
	2989	DO jk = kflev - 1, jk1, -1
	2990	DO jl = 1, kdlon
[5144]	2991	zcfrac = zclm(jl, jk1, jk + 1) - zclm(jl, jk1, jk)
	2992	zfd(jl) = zfd(jl) + zcfrac * zdnf(jl, jk + 2, jk1)
[1992]	2993	END DO
	2994	END DO
	2995
	2996	DO jl = 1, kdlon
	2997	pflux(jl, 2, jk1) = zfd(jl)
	2998	END DO
	2999
	3000	END DO
	3001
	3002	! * 3.2 UPWARD FLUX AT THE SURFACE
	3003	! --------------------------
	3004
	3005	DO jl = 1, kdlon
[5144]	3006	pflux(jl, 1, 1) = pemis(jl) * pbsuin(jl) - (1. - pemis(jl)) * pflux(jl, 2, 1)
[1992]	3007	END DO
	3008
	3009	! * 3.3 UPWARD FLUXES
	3010	! -------------
	3011
	3012	DO jk1 = 2, kflev + 1
	3013
	3014	! * CONTRIBUTION FROM CLEAR-SKY FRACTION
	3015
	3016	DO jl = 1, kdlon
[5144]	3017	zfu(jl) = (1. - zclm(jl, jk1, 1)) * zupf(jl, 1, jk1)
[1992]	3018	END DO
	3019
	3020	! * CONTRIBUTION FROM ADJACENT CLOUD
	3021
	3022	DO jl = 1, kdlon
[5144]	3023	zfu(jl) = zfu(jl) + zclm(jl, jk1, jk1 - 1) * zupf(jl, jk1, jk1)
[1992]	3024	END DO
	3025
	3026	! * CONTRIBUTION FROM OTHER CLOUDY FRACTIONS
	3027
	3028	DO jk = 2, jk1 - 1
	3029	DO jl = 1, kdlon
[5144]	3030	zcfrac = zclm(jl, jk1, jk - 1) - zclm(jl, jk1, jk)
	3031	zfu(jl) = zfu(jl) + zcfrac * zupf(jl, jk, jk1)
[1992]	3032	END DO
	3033	END DO
	3034
	3035	DO jl = 1, kdlon
	3036	pflux(jl, 1, jk1) = zfu(jl)
	3037	END DO
	3038
	3039	END DO
	3040
	3041	END IF
	3042
	3043	! * 2.3 END OF CLOUD EFFECT COMPUTATIONS
	3044
	3045	IF (.NOT. levoigt) THEN
	3046	DO jl = 1, kdlon
	3047	zfn10(jl) = pflux(jl, 1, klim) + pflux(jl, 2, klim)
	3048	END DO
	3049	DO jk = klim + 1, kflev + 1
	3050	DO jl = 1, kdlon
[5144]	3051	zfn10(jl) = zfn10(jl) + pcts(jl, jk - 1)
[1992]	3052	pflux(jl, 1, jk) = zfn10(jl)
	3053	pflux(jl, 2, jk) = 0.0
	3054	END DO
	3055	END DO
	3056	END IF
	3057
	3058	END SUBROUTINE lwc_lmdar4
	3059	SUBROUTINE lwb_lmdar4(pdt0, ptave, ptl, pb, pbint, pbsuin, pbsur, pbtop, &
[5144]	3060	pdbsl, pga, pgb, pgasur, pgbsur, pgatop, pgbtop)
[1992]	3061	USE dimphy
	3062	USE radiation_ar4_param, ONLY: tintp, xp, ga, gb
	3063	IMPLICIT NONE
	3064	include "raddimlw.h"
	3065
	3066	! -----------------------------------------------------------------------
	3067	! PURPOSE.
	3068	! --------
	3069	! COMPUTES PLANCK FUNCTIONS
	3070
	3071	! EXPLICIT ARGUMENTS :
	3072	! --------------------
	3073	! ==== INPUTS ===
	3074	! PDT0 : (KDLON) ; SURFACE TEMPERATURE DISCONTINUITY
	3075	! PTAVE : (KDLON,KFLEV) ; TEMPERATURE
	3076	! PTL : (KDLON,0:KFLEV) ; HALF LEVEL TEMPERATURE
	3077	! ==== OUTPUTS ===
	3078	! PB : (KDLON,Ninter,KFLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION
	3079	! PBINT : (KDLON,KFLEV+1) ; HALF LEVEL PLANCK FUNCTION
	3080	! PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION
	3081	! PBSUR : (KDLON,Ninter) ; SURFACE SPECTRAL PLANCK FUNCTION
	3082	! PBTOP : (KDLON,Ninter) ; TOP SPECTRAL PLANCK FUNCTION
	3083	! PDBSL : (KDLON,Ninter,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT
	3084	! PGA : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
	3085	! PGB : (KDLON,8,2,KFLEV); dB/dT-weighted LAYER PADE APPROXIMANTS
	3086	! PGASUR, PGBSUR (KDLON,8,2) ; SURFACE PADE APPROXIMANTS
	3087	! PGATOP, PGBTOP (KDLON,8,2) ; T.O.A. PADE APPROXIMANTS
	3088
	3089	! IMPLICIT ARGUMENTS : NONE
	3090	! --------------------
	3091
	3092	! METHOD.
	3093	! -------
	3094
	3095	! 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS
	3096	! FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION
	3097
	3098	! REFERENCE.
	3099	! ----------
	3100
	3101	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	3102	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS "
	3103
	3104	! AUTHOR.
	3105	! -------
	3106	! JEAN-JACQUES MORCRETTE ECMWF
	3107
	3108	! MODIFICATIONS.
	3109	! --------------
	3110	! ORIGINAL : 89-07-14
	3111
	3112	! -----------------------------------------------------------------------
	3113
	3114	! ARGUMENTS:
	3115
[5144]	3116	REAL (KIND = 8) pdt0(kdlon)
	3117	REAL (KIND = 8) ptave(kdlon, kflev)
	3118	REAL (KIND = 8) ptl(kdlon, kflev + 1)
[1992]	3119
[5144]	3120	REAL (KIND = 8) pb(kdlon, ninter, kflev + 1) ! SPECTRAL HALF LEVEL PLANCK FUNCTION
	3121	REAL (KIND = 8) pbint(kdlon, kflev + 1) ! HALF LEVEL PLANCK FUNCTION
	3122	REAL (KIND = 8) pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
	3123	REAL (KIND = 8) pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
	3124	REAL (KIND = 8) pbtop(kdlon, ninter) ! TOP SPECTRAL PLANCK FUNCTION
	3125	REAL (KIND = 8) pdbsl(kdlon, ninter, kflev * 2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
	3126	REAL (KIND = 8) pga(kdlon, 8, 2, kflev) ! dB/dT-weighted LAYER PADE APPROXIMANTS
	3127	REAL (KIND = 8) pgb(kdlon, 8, 2, kflev) ! dB/dT-weighted LAYER PADE APPROXIMANTS
	3128	REAL (KIND = 8) pgasur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
	3129	REAL (KIND = 8) pgbsur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
	3130	REAL (KIND = 8) pgatop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
	3131	REAL (KIND = 8) pgbtop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
[1992]	3132
	3133	! -------------------------------------------------------------------------
	3134	! * LOCAL VARIABLES:
	3135	INTEGER indb(kdlon), inds(kdlon)
[5144]	3136	REAL (KIND = 8) zblay(kdlon, kflev), zblev(kdlon, kflev + 1)
	3137	REAL (KIND = 8) zres(kdlon), zres2(kdlon), zti(kdlon), zti2(kdlon)
[1992]	3138
	3139	INTEGER jk, jl, ic, jnu, jf, jg
	3140	INTEGER jk1, jk2
	3141	INTEGER k, j, ixtox, indto, ixtx, indt
	3142	INTEGER indsu, indtp
[5144]	3143	REAL (KIND = 8) zdsto1, zdstox, zdst1, zdstx
[1992]	3144
	3145	! * Quelques parametres:
[5144]	3146	REAL (KIND = 8) tstand
	3147	PARAMETER (tstand = 250.0)
	3148	REAL (KIND = 8) tstp
	3149	PARAMETER (tstp = 12.5)
[1992]	3150	INTEGER mxixt
[5144]	3151	PARAMETER (mxixt = 10)
[1992]	3152
	3153	! * Used Data Block:
	3154	! REAL*8 TINTP(11)
	3155	! SAVE TINTP
	3156	! c$OMP THREADPRIVATE(TINTP)
	3157	! REAL*8 GA(11,16,3), GB(11,16,3)
	3158	! SAVE GA, GB
	3159	! c$OMP THREADPRIVATE(GA, GB)
	3160	! REAL*8 XP(6,6)
	3161	! SAVE XP
	3162	! c$OMP THREADPRIVATE(XP)
	3163
	3164	! DATA TINTP / 187.5, 200., 212.5, 225., 237.5, 250.,
	3165	! S 262.5, 275., 287.5, 300., 312.5 /
	3166	! -----------------------------------------------------------------------
	3167	! -- WATER VAPOR -- INT.1 -- 0- 500 CM-1 -- FROM ABS225 ----------------
	3168
	3169
	3170
	3171
	3172	! -- R.D. -- G = - 0.2 SLA
	3173
	3174
	3175	! ----- INTERVAL = 1 ----- T = 187.5
	3176
	3177	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3178	! DATA (GA( 1, 1,IC),IC=1,3) /
	3179	! S 0.63499072E-02,-0.99506586E-03, 0.00000000E+00/
	3180	! DATA (GB( 1, 1,IC),IC=1,3) /
	3181	! S 0.63499072E-02, 0.97222852E-01, 0.10000000E+01/
	3182	! DATA (GA( 1, 2,IC),IC=1,3) /
	3183	! S 0.77266491E-02,-0.11661515E-02, 0.00000000E+00/
	3184	! DATA (GB( 1, 2,IC),IC=1,3) /
	3185	! S 0.77266491E-02, 0.10681591E+00, 0.10000000E+01/
	3186
	3187	! ----- INTERVAL = 1 ----- T = 200.0
	3188
	3189	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3190	! DATA (GA( 2, 1,IC),IC=1,3) /
	3191	! S 0.65566348E-02,-0.10184169E-02, 0.00000000E+00/
	3192	! DATA (GB( 2, 1,IC),IC=1,3) /
	3193	! S 0.65566348E-02, 0.98862238E-01, 0.10000000E+01/
	3194	! DATA (GA( 2, 2,IC),IC=1,3) /
	3195	! S 0.81323287E-02,-0.11886130E-02, 0.00000000E+00/
	3196	! DATA (GB( 2, 2,IC),IC=1,3) /
	3197	! S 0.81323287E-02, 0.10921298E+00, 0.10000000E+01/
	3198
	3199	! ----- INTERVAL = 1 ----- T = 212.5
	3200
	3201	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3202	! DATA (GA( 3, 1,IC),IC=1,3) /
	3203	! S 0.67849730E-02,-0.10404730E-02, 0.00000000E+00/
	3204	! DATA (GB( 3, 1,IC),IC=1,3) /
	3205	! S 0.67849730E-02, 0.10061504E+00, 0.10000000E+01/
	3206	! DATA (GA( 3, 2,IC),IC=1,3) /
	3207	! S 0.86507620E-02,-0.12139929E-02, 0.00000000E+00/
	3208	! DATA (GB( 3, 2,IC),IC=1,3) /
	3209	! S 0.86507620E-02, 0.11198225E+00, 0.10000000E+01/
	3210
	3211	! ----- INTERVAL = 1 ----- T = 225.0
	3212
	3213	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3214	! DATA (GA( 4, 1,IC),IC=1,3) /
	3215	! S 0.70481947E-02,-0.10621792E-02, 0.00000000E+00/
	3216	! DATA (GB( 4, 1,IC),IC=1,3) /
	3217	! S 0.70481947E-02, 0.10256222E+00, 0.10000000E+01/
	3218	! DATA (GA( 4, 2,IC),IC=1,3) /
	3219	! S 0.92776391E-02,-0.12445811E-02, 0.00000000E+00/
	3220	! DATA (GB( 4, 2,IC),IC=1,3) /
	3221	! S 0.92776391E-02, 0.11487826E+00, 0.10000000E+01/
	3222
	3223	! ----- INTERVAL = 1 ----- T = 237.5
	3224
	3225	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3226	! DATA (GA( 5, 1,IC),IC=1,3) /
	3227	! S 0.73585943E-02,-0.10847662E-02, 0.00000000E+00/
	3228	! DATA (GB( 5, 1,IC),IC=1,3) /
	3229	! S 0.73585943E-02, 0.10475952E+00, 0.10000000E+01/
	3230	! DATA (GA( 5, 2,IC),IC=1,3) /
	3231	! S 0.99806312E-02,-0.12807672E-02, 0.00000000E+00/
	3232	! DATA (GB( 5, 2,IC),IC=1,3) /
	3233	! S 0.99806312E-02, 0.11751113E+00, 0.10000000E+01/
	3234
	3235	! ----- INTERVAL = 1 ----- T = 250.0
	3236
	3237	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3238	! DATA (GA( 6, 1,IC),IC=1,3) /
	3239	! S 0.77242818E-02,-0.11094726E-02, 0.00000000E+00/
	3240	! DATA (GB( 6, 1,IC),IC=1,3) /
	3241	! S 0.77242818E-02, 0.10720986E+00, 0.10000000E+01/
	3242	! DATA (GA( 6, 2,IC),IC=1,3) /
	3243	! S 0.10709803E-01,-0.13208251E-02, 0.00000000E+00/
	3244	! DATA (GB( 6, 2,IC),IC=1,3) /
	3245	! S 0.10709803E-01, 0.11951535E+00, 0.10000000E+01/
	3246
	3247	! ----- INTERVAL = 1 ----- T = 262.5
	3248
	3249	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3250	! DATA (GA( 7, 1,IC),IC=1,3) /
	3251	! S 0.81472693E-02,-0.11372949E-02, 0.00000000E+00/
	3252	! DATA (GB( 7, 1,IC),IC=1,3) /
	3253	! S 0.81472693E-02, 0.10985370E+00, 0.10000000E+01/
	3254	! DATA (GA( 7, 2,IC),IC=1,3) /
	3255	! S 0.11414739E-01,-0.13619034E-02, 0.00000000E+00/
	3256	! DATA (GB( 7, 2,IC),IC=1,3) /
	3257	! S 0.11414739E-01, 0.12069945E+00, 0.10000000E+01/
	3258
	3259	! ----- INTERVAL = 1 ----- T = 275.0
	3260
	3261	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3262	! DATA (GA( 8, 1,IC),IC=1,3) /
	3263	! S 0.86227527E-02,-0.11687683E-02, 0.00000000E+00/
	3264	! DATA (GB( 8, 1,IC),IC=1,3) /
	3265	! S 0.86227527E-02, 0.11257633E+00, 0.10000000E+01/
	3266	! DATA (GA( 8, 2,IC),IC=1,3) /
	3267	! S 0.12058772E-01,-0.14014165E-02, 0.00000000E+00/
	3268	! DATA (GB( 8, 2,IC),IC=1,3) /
	3269	! S 0.12058772E-01, 0.12108524E+00, 0.10000000E+01/
	3270
	3271	! ----- INTERVAL = 1 ----- T = 287.5
	3272
	3273	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3274	! DATA (GA( 9, 1,IC),IC=1,3) /
	3275	! S 0.91396814E-02,-0.12038314E-02, 0.00000000E+00/
	3276	! DATA (GB( 9, 1,IC),IC=1,3) /
	3277	! S 0.91396814E-02, 0.11522980E+00, 0.10000000E+01/
	3278	! DATA (GA( 9, 2,IC),IC=1,3) /
	3279	! S 0.12623992E-01,-0.14378639E-02, 0.00000000E+00/
	3280	! DATA (GB( 9, 2,IC),IC=1,3) /
	3281	! S 0.12623992E-01, 0.12084229E+00, 0.10000000E+01/
	3282
	3283	! ----- INTERVAL = 1 ----- T = 300.0
	3284
	3285	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3286	! DATA (GA(10, 1,IC),IC=1,3) /
	3287	! S 0.96825438E-02,-0.12418367E-02, 0.00000000E+00/
	3288	! DATA (GB(10, 1,IC),IC=1,3) /
	3289	! S 0.96825438E-02, 0.11766343E+00, 0.10000000E+01/
	3290	! DATA (GA(10, 2,IC),IC=1,3) /
	3291	! S 0.13108146E-01,-0.14708488E-02, 0.00000000E+00/
	3292	! DATA (GB(10, 2,IC),IC=1,3) /
	3293	! S 0.13108146E-01, 0.12019005E+00, 0.10000000E+01/
	3294
	3295	! ----- INTERVAL = 1 ----- T = 312.5
	3296
	3297	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	3298	! DATA (GA(11, 1,IC),IC=1,3) /
	3299	! S 0.10233955E-01,-0.12817135E-02, 0.00000000E+00/
	3300	! DATA (GB(11, 1,IC),IC=1,3) /
	3301	! S 0.10233955E-01, 0.11975320E+00, 0.10000000E+01/
	3302	! DATA (GA(11, 2,IC),IC=1,3) /
	3303	! S 0.13518390E-01,-0.15006791E-02, 0.00000000E+00/
	3304	! DATA (GB(11, 2,IC),IC=1,3) /
	3305	! S 0.13518390E-01, 0.11932684E+00, 0.10000000E+01/
	3306
	3307
	3308
	3309	! --- WATER VAPOR --- INTERVAL 2 -- 500-800 CM-1--- FROM ABS225 ---------
	3310
	3311
	3312
	3313
	3314	! --- R.D. --- G = 0.02 + 0.50 / ( 1 + 4.5 U )
	3315
	3316
	3317	! ----- INTERVAL = 2 ----- T = 187.5
	3318
	3319	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3320	! DATA (GA( 1, 3,IC),IC=1,3) /
	3321	! S 0.11644593E+01, 0.41243390E+00, 0.00000000E+00/
	3322	! DATA (GB( 1, 3,IC),IC=1,3) /
	3323	! S 0.11644593E+01, 0.10346097E+01, 0.10000000E+01/
	3324	! DATA (GA( 1, 4,IC),IC=1,3) /
	3325	! S 0.12006968E+01, 0.48318936E+00, 0.00000000E+00/
	3326	! DATA (GB( 1, 4,IC),IC=1,3) /
	3327	! S 0.12006968E+01, 0.10626130E+01, 0.10000000E+01/
	3328
	3329	! ----- INTERVAL = 2 ----- T = 200.0
	3330
	3331	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3332	! DATA (GA( 2, 3,IC),IC=1,3) /
	3333	! S 0.11747203E+01, 0.43407282E+00, 0.00000000E+00/
	3334	! DATA (GB( 2, 3,IC),IC=1,3) /
	3335	! S 0.11747203E+01, 0.10433655E+01, 0.10000000E+01/
	3336	! DATA (GA( 2, 4,IC),IC=1,3) /
	3337	! S 0.12108196E+01, 0.50501827E+00, 0.00000000E+00/
	3338	! DATA (GB( 2, 4,IC),IC=1,3) /
	3339	! S 0.12108196E+01, 0.10716026E+01, 0.10000000E+01/
	3340
	3341	! ----- INTERVAL = 2 ----- T = 212.5
	3342
	3343	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3344	! DATA (GA( 3, 3,IC),IC=1,3) /
	3345	! S 0.11837872E+01, 0.45331413E+00, 0.00000000E+00/
	3346	! DATA (GB( 3, 3,IC),IC=1,3) /
	3347	! S 0.11837872E+01, 0.10511933E+01, 0.10000000E+01/
	3348	! DATA (GA( 3, 4,IC),IC=1,3) /
	3349	! S 0.12196717E+01, 0.52409502E+00, 0.00000000E+00/
	3350	! DATA (GB( 3, 4,IC),IC=1,3) /
	3351	! S 0.12196717E+01, 0.10795108E+01, 0.10000000E+01/
	3352
	3353	! ----- INTERVAL = 2 ----- T = 225.0
	3354
	3355	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3356	! DATA (GA( 4, 3,IC),IC=1,3) /
	3357	! S 0.11918561E+01, 0.47048604E+00, 0.00000000E+00/
	3358	! DATA (GB( 4, 3,IC),IC=1,3) /
	3359	! S 0.11918561E+01, 0.10582150E+01, 0.10000000E+01/
	3360	! DATA (GA( 4, 4,IC),IC=1,3) /
	3361	! S 0.12274493E+01, 0.54085277E+00, 0.00000000E+00/
	3362	! DATA (GB( 4, 4,IC),IC=1,3) /
	3363	! S 0.12274493E+01, 0.10865006E+01, 0.10000000E+01/
	3364
	3365	! ----- INTERVAL = 2 ----- T = 237.5
	3366
	3367	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3368	! DATA (GA( 5, 3,IC),IC=1,3) /
	3369	! S 0.11990757E+01, 0.48586286E+00, 0.00000000E+00/
	3370	! DATA (GB( 5, 3,IC),IC=1,3) /
	3371	! S 0.11990757E+01, 0.10645317E+01, 0.10000000E+01/
	3372	! DATA (GA( 5, 4,IC),IC=1,3) /
	3373	! S 0.12343189E+01, 0.55565422E+00, 0.00000000E+00/
	3374	! DATA (GB( 5, 4,IC),IC=1,3) /
	3375	! S 0.12343189E+01, 0.10927103E+01, 0.10000000E+01/
	3376
	3377	! ----- INTERVAL = 2 ----- T = 250.0
	3378
	3379	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3380	! DATA (GA( 6, 3,IC),IC=1,3) /
	3381	! S 0.12055643E+01, 0.49968044E+00, 0.00000000E+00/
	3382	! DATA (GB( 6, 3,IC),IC=1,3) /
	3383	! S 0.12055643E+01, 0.10702313E+01, 0.10000000E+01/
	3384	! DATA (GA( 6, 4,IC),IC=1,3) /
	3385	! S 0.12404147E+01, 0.56878618E+00, 0.00000000E+00/
	3386	! DATA (GB( 6, 4,IC),IC=1,3) /
	3387	! S 0.12404147E+01, 0.10982489E+01, 0.10000000E+01/
	3388
	3389	! ----- INTERVAL = 2 ----- T = 262.5
	3390
	3391	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3392	! DATA (GA( 7, 3,IC),IC=1,3) /
	3393	! S 0.12114186E+01, 0.51214132E+00, 0.00000000E+00/
	3394	! DATA (GB( 7, 3,IC),IC=1,3) /
	3395	! S 0.12114186E+01, 0.10753907E+01, 0.10000000E+01/
	3396	! DATA (GA( 7, 4,IC),IC=1,3) /
	3397	! S 0.12458431E+01, 0.58047395E+00, 0.00000000E+00/
	3398	! DATA (GB( 7, 4,IC),IC=1,3) /
	3399	! S 0.12458431E+01, 0.11032019E+01, 0.10000000E+01/
	3400
	3401	! ----- INTERVAL = 2 ----- T = 275.0
	3402
	3403	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3404	! DATA (GA( 8, 3,IC),IC=1,3) /
	3405	! S 0.12167192E+01, 0.52341830E+00, 0.00000000E+00/
	3406	! DATA (GB( 8, 3,IC),IC=1,3) /
	3407	! S 0.12167192E+01, 0.10800762E+01, 0.10000000E+01/
	3408	! DATA (GA( 8, 4,IC),IC=1,3) /
	3409	! S 0.12506907E+01, 0.59089894E+00, 0.00000000E+00/
	3410	! DATA (GB( 8, 4,IC),IC=1,3) /
	3411	! S 0.12506907E+01, 0.11076379E+01, 0.10000000E+01/
	3412
	3413	! ----- INTERVAL = 2 ----- T = 287.5
	3414
	3415	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3416	! DATA (GA( 9, 3,IC),IC=1,3) /
	3417	! S 0.12215344E+01, 0.53365803E+00, 0.00000000E+00/
	3418	! DATA (GB( 9, 3,IC),IC=1,3) /
	3419	! S 0.12215344E+01, 0.10843446E+01, 0.10000000E+01/
	3420	! DATA (GA( 9, 4,IC),IC=1,3) /
	3421	! S 0.12550299E+01, 0.60021475E+00, 0.00000000E+00/
	3422	! DATA (GB( 9, 4,IC),IC=1,3) /
	3423	! S 0.12550299E+01, 0.11116160E+01, 0.10000000E+01/
	3424
	3425	! ----- INTERVAL = 2 ----- T = 300.0
	3426
	3427	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3428	! DATA (GA(10, 3,IC),IC=1,3) /
	3429	! S 0.12259226E+01, 0.54298448E+00, 0.00000000E+00/
	3430	! DATA (GB(10, 3,IC),IC=1,3) /
	3431	! S 0.12259226E+01, 0.10882439E+01, 0.10000000E+01/
	3432	! DATA (GA(10, 4,IC),IC=1,3) /
	3433	! S 0.12589256E+01, 0.60856112E+00, 0.00000000E+00/
	3434	! DATA (GB(10, 4,IC),IC=1,3) /
	3435	! S 0.12589256E+01, 0.11151910E+01, 0.10000000E+01/
	3436
	3437	! ----- INTERVAL = 2 ----- T = 312.5
	3438
	3439	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3440	! DATA (GA(11, 3,IC),IC=1,3) /
	3441	! S 0.12299344E+01, 0.55150227E+00, 0.00000000E+00/
	3442	! DATA (GB(11, 3,IC),IC=1,3) /
	3443	! S 0.12299344E+01, 0.10918144E+01, 0.10000000E+01/
	3444	! DATA (GA(11, 4,IC),IC=1,3) /
	3445	! S 0.12624402E+01, 0.61607594E+00, 0.00000000E+00/
	3446	! DATA (GB(11, 4,IC),IC=1,3) /
	3447	! S 0.12624402E+01, 0.11184188E+01, 0.10000000E+01/
	3448
	3449
	3450
	3451
	3452
	3453
	3454	! - WATER VAPOR - INT. 3 -- 800-970 + 1110-1250 CM-1 -- FIT FROM 215 IS -
	3455
	3456
	3457	! -- WATER VAPOR LINES IN THE WINDOW REGION (800-1250 CM-1)
	3458
	3459
	3460
	3461	! --- G = 3.875E-03 ---------------
	3462
	3463	! ----- INTERVAL = 3 ----- T = 187.5
	3464
	3465	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3466	! DATA (GA( 1, 7,IC),IC=1,3) /
	3467	! S 0.10192131E+02, 0.80737799E+01, 0.00000000E+00/
	3468	! DATA (GB( 1, 7,IC),IC=1,3) /
	3469	! S 0.10192131E+02, 0.82623280E+01, 0.10000000E+01/
	3470	! DATA (GA( 1, 8,IC),IC=1,3) /
	3471	! S 0.92439050E+01, 0.77425778E+01, 0.00000000E+00/
	3472	! DATA (GB( 1, 8,IC),IC=1,3) /
	3473	! S 0.92439050E+01, 0.79342219E+01, 0.10000000E+01/
	3474
	3475	! ----- INTERVAL = 3 ----- T = 200.0
	3476
	3477	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3478	! DATA (GA( 2, 7,IC),IC=1,3) /
	3479	! S 0.97258602E+01, 0.79171158E+01, 0.00000000E+00/
	3480	! DATA (GB( 2, 7,IC),IC=1,3) /
	3481	! S 0.97258602E+01, 0.81072291E+01, 0.10000000E+01/
	3482	! DATA (GA( 2, 8,IC),IC=1,3) /
	3483	! S 0.87567422E+01, 0.75443460E+01, 0.00000000E+00/
	3484	! DATA (GB( 2, 8,IC),IC=1,3) /
	3485	! S 0.87567422E+01, 0.77373458E+01, 0.10000000E+01/
	3486
	3487	! ----- INTERVAL = 3 ----- T = 212.5
	3488
	3489	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3490	! DATA (GA( 3, 7,IC),IC=1,3) /
	3491	! S 0.92992890E+01, 0.77609605E+01, 0.00000000E+00/
	3492	! DATA (GB( 3, 7,IC),IC=1,3) /
	3493	! S 0.92992890E+01, 0.79523834E+01, 0.10000000E+01/
	3494	! DATA (GA( 3, 8,IC),IC=1,3) /
	3495	! S 0.83270144E+01, 0.73526151E+01, 0.00000000E+00/
	3496	! DATA (GB( 3, 8,IC),IC=1,3) /
	3497	! S 0.83270144E+01, 0.75467334E+01, 0.10000000E+01/
	3498
	3499	! ----- INTERVAL = 3 ----- T = 225.0
	3500
	3501	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3502	! DATA (GA( 4, 7,IC),IC=1,3) /
	3503	! S 0.89154021E+01, 0.76087371E+01, 0.00000000E+00/
	3504	! DATA (GB( 4, 7,IC),IC=1,3) /
	3505	! S 0.89154021E+01, 0.78012527E+01, 0.10000000E+01/
	3506	! DATA (GA( 4, 8,IC),IC=1,3) /
	3507	! S 0.79528337E+01, 0.71711188E+01, 0.00000000E+00/
	3508	! DATA (GB( 4, 8,IC),IC=1,3) /
	3509	! S 0.79528337E+01, 0.73661786E+01, 0.10000000E+01/
	3510
	3511	! ----- INTERVAL = 3 ----- T = 237.5
	3512
	3513	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3514	! DATA (GA( 5, 7,IC),IC=1,3) /
	3515	! S 0.85730084E+01, 0.74627112E+01, 0.00000000E+00/
	3516	! DATA (GB( 5, 7,IC),IC=1,3) /
	3517	! S 0.85730084E+01, 0.76561458E+01, 0.10000000E+01/
	3518	! DATA (GA( 5, 8,IC),IC=1,3) /
	3519	! S 0.76286839E+01, 0.70015571E+01, 0.00000000E+00/
	3520	! DATA (GB( 5, 8,IC),IC=1,3) /
	3521	! S 0.76286839E+01, 0.71974319E+01, 0.10000000E+01/
	3522
	3523	! ----- INTERVAL = 3 ----- T = 250.0
	3524
	3525	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3526	! DATA (GA( 6, 7,IC),IC=1,3) /
	3527	! S 0.82685838E+01, 0.73239981E+01, 0.00000000E+00/
	3528	! DATA (GB( 6, 7,IC),IC=1,3) /
	3529	! S 0.82685838E+01, 0.75182174E+01, 0.10000000E+01/
	3530	! DATA (GA( 6, 8,IC),IC=1,3) /
	3531	! S 0.73477879E+01, 0.68442532E+01, 0.00000000E+00/
	3532	! DATA (GB( 6, 8,IC),IC=1,3) /
	3533	! S 0.73477879E+01, 0.70408543E+01, 0.10000000E+01/
	3534
	3535	! ----- INTERVAL = 3 ----- T = 262.5
	3536
	3537	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3538	! DATA (GA( 7, 7,IC),IC=1,3) /
	3539	! S 0.79978921E+01, 0.71929934E+01, 0.00000000E+00/
	3540	! DATA (GB( 7, 7,IC),IC=1,3) /
	3541	! S 0.79978921E+01, 0.73878952E+01, 0.10000000E+01/
	3542	! DATA (GA( 7, 8,IC),IC=1,3) /
	3543	! S 0.71035818E+01, 0.66987996E+01, 0.00000000E+00/
	3544	! DATA (GB( 7, 8,IC),IC=1,3) /
	3545	! S 0.71035818E+01, 0.68960649E+01, 0.10000000E+01/
	3546
	3547	! ----- INTERVAL = 3 ----- T = 275.0
	3548
	3549	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3550	! DATA (GA( 8, 7,IC),IC=1,3) /
	3551	! S 0.77568055E+01, 0.70697065E+01, 0.00000000E+00/
	3552	! DATA (GB( 8, 7,IC),IC=1,3) /
	3553	! S 0.77568055E+01, 0.72652133E+01, 0.10000000E+01/
	3554	! DATA (GA( 8, 8,IC),IC=1,3) /
	3555	! S 0.68903312E+01, 0.65644820E+01, 0.00000000E+00/
	3556	! DATA (GB( 8, 8,IC),IC=1,3) /
	3557	! S 0.68903312E+01, 0.67623672E+01, 0.10000000E+01/
	3558
	3559	! ----- INTERVAL = 3 ----- T = 287.5
	3560
	3561	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3562	! DATA (GA( 9, 7,IC),IC=1,3) /
	3563	! S 0.75416266E+01, 0.69539626E+01, 0.00000000E+00/
	3564	! DATA (GB( 9, 7,IC),IC=1,3) /
	3565	! S 0.75416266E+01, 0.71500151E+01, 0.10000000E+01/
	3566	! DATA (GA( 9, 8,IC),IC=1,3) /
	3567	! S 0.67032875E+01, 0.64405267E+01, 0.00000000E+00/
	3568	! DATA (GB( 9, 8,IC),IC=1,3) /
	3569	! S 0.67032875E+01, 0.66389989E+01, 0.10000000E+01/
	3570
	3571	! ----- INTERVAL = 3 ----- T = 300.0
	3572
	3573	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3574	! DATA (GA(10, 7,IC),IC=1,3) /
	3575	! S 0.73491694E+01, 0.68455144E+01, 0.00000000E+00/
	3576	! DATA (GB(10, 7,IC),IC=1,3) /
	3577	! S 0.73491694E+01, 0.70420667E+01, 0.10000000E+01/
	3578	! DATA (GA(10, 8,IC),IC=1,3) /
	3579	! S 0.65386461E+01, 0.63262376E+01, 0.00000000E+00/
	3580	! DATA (GB(10, 8,IC),IC=1,3) /
	3581	! S 0.65386461E+01, 0.65252707E+01, 0.10000000E+01/
	3582
	3583	! ----- INTERVAL = 3 ----- T = 312.5
	3584
	3585	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3586	! DATA (GA(11, 7,IC),IC=1,3) /
	3587	! S 0.71767400E+01, 0.67441020E+01, 0.00000000E+00/
	3588	! DATA (GB(11, 7,IC),IC=1,3) /
	3589	! S 0.71767400E+01, 0.69411177E+01, 0.10000000E+01/
	3590	! DATA (GA(11, 8,IC),IC=1,3) /
	3591	! S 0.63934377E+01, 0.62210701E+01, 0.00000000E+00/
	3592	! DATA (GB(11, 8,IC),IC=1,3) /
	3593	! S 0.63934377E+01, 0.64206412E+01, 0.10000000E+01/
	3594
	3595
	3596	! -- WATER VAPOR -- 970-1110 CM-1 ----------------------------------------
	3597
	3598	! -- G = 3.6E-03
	3599
	3600	! ----- INTERVAL = 4 ----- T = 187.5
	3601
	3602	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3603	! DATA (GA( 1, 9,IC),IC=1,3) /
	3604	! S 0.24870635E+02, 0.10542131E+02, 0.00000000E+00/
	3605	! DATA (GB( 1, 9,IC),IC=1,3) /
	3606	! S 0.24870635E+02, 0.10656640E+02, 0.10000000E+01/
	3607	! DATA (GA( 1,10,IC),IC=1,3) /
	3608	! S 0.24586283E+02, 0.10490353E+02, 0.00000000E+00/
	3609	! DATA (GB( 1,10,IC),IC=1,3) /
	3610	! S 0.24586283E+02, 0.10605856E+02, 0.10000000E+01/
	3611
	3612	! ----- INTERVAL = 4 ----- T = 200.0
	3613
	3614	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3615	! DATA (GA( 2, 9,IC),IC=1,3) /
	3616	! S 0.24725591E+02, 0.10515895E+02, 0.00000000E+00/
	3617	! DATA (GB( 2, 9,IC),IC=1,3) /
	3618	! S 0.24725591E+02, 0.10630910E+02, 0.10000000E+01/
	3619	! DATA (GA( 2,10,IC),IC=1,3) /
	3620	! S 0.24441465E+02, 0.10463512E+02, 0.00000000E+00/
	3621	! DATA (GB( 2,10,IC),IC=1,3) /
	3622	! S 0.24441465E+02, 0.10579514E+02, 0.10000000E+01/
	3623
	3624	! ----- INTERVAL = 4 ----- T = 212.5
	3625
	3626	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3627	! DATA (GA( 3, 9,IC),IC=1,3) /
	3628	! S 0.24600320E+02, 0.10492949E+02, 0.00000000E+00/
	3629	! DATA (GB( 3, 9,IC),IC=1,3) /
	3630	! S 0.24600320E+02, 0.10608399E+02, 0.10000000E+01/
	3631	! DATA (GA( 3,10,IC),IC=1,3) /
	3632	! S 0.24311657E+02, 0.10439183E+02, 0.00000000E+00/
	3633	! DATA (GB( 3,10,IC),IC=1,3) /
	3634	! S 0.24311657E+02, 0.10555632E+02, 0.10000000E+01/
	3635
	3636	! ----- INTERVAL = 4 ----- T = 225.0
	3637
	3638	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3639	! DATA (GA( 4, 9,IC),IC=1,3) /
	3640	! S 0.24487300E+02, 0.10472049E+02, 0.00000000E+00/
	3641	! DATA (GB( 4, 9,IC),IC=1,3) /
	3642	! S 0.24487300E+02, 0.10587891E+02, 0.10000000E+01/
	3643	! DATA (GA( 4,10,IC),IC=1,3) /
	3644	! S 0.24196167E+02, 0.10417324E+02, 0.00000000E+00/
	3645	! DATA (GB( 4,10,IC),IC=1,3) /
	3646	! S 0.24196167E+02, 0.10534169E+02, 0.10000000E+01/
	3647
	3648	! ----- INTERVAL = 4 ----- T = 237.5
	3649
	3650	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3651	! DATA (GA( 5, 9,IC),IC=1,3) /
	3652	! S 0.24384935E+02, 0.10452961E+02, 0.00000000E+00/
	3653	! DATA (GB( 5, 9,IC),IC=1,3) /
	3654	! S 0.24384935E+02, 0.10569156E+02, 0.10000000E+01/
	3655	! DATA (GA( 5,10,IC),IC=1,3) /
	3656	! S 0.24093406E+02, 0.10397704E+02, 0.00000000E+00/
	3657	! DATA (GB( 5,10,IC),IC=1,3) /
	3658	! S 0.24093406E+02, 0.10514900E+02, 0.10000000E+01/
	3659
	3660	! ----- INTERVAL = 4 ----- T = 250.0
	3661
	3662	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3663	! DATA (GA( 6, 9,IC),IC=1,3) /
	3664	! S 0.24292341E+02, 0.10435562E+02, 0.00000000E+00/
	3665	! DATA (GB( 6, 9,IC),IC=1,3) /
	3666	! S 0.24292341E+02, 0.10552075E+02, 0.10000000E+01/
	3667	! DATA (GA( 6,10,IC),IC=1,3) /
	3668	! S 0.24001597E+02, 0.10380038E+02, 0.00000000E+00/
	3669	! DATA (GB( 6,10,IC),IC=1,3) /
	3670	! S 0.24001597E+02, 0.10497547E+02, 0.10000000E+01/
	3671
	3672	! ----- INTERVAL = 4 ----- T = 262.5
	3673
	3674	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3675	! DATA (GA( 7, 9,IC),IC=1,3) /
	3676	! S 0.24208572E+02, 0.10419710E+02, 0.00000000E+00/
	3677	! DATA (GB( 7, 9,IC),IC=1,3) /
	3678	! S 0.24208572E+02, 0.10536510E+02, 0.10000000E+01/
	3679	! DATA (GA( 7,10,IC),IC=1,3) /
	3680	! S 0.23919098E+02, 0.10364052E+02, 0.00000000E+00/
	3681	! DATA (GB( 7,10,IC),IC=1,3) /
	3682	! S 0.23919098E+02, 0.10481842E+02, 0.10000000E+01/
	3683
	3684	! ----- INTERVAL = 4 ----- T = 275.0
	3685
	3686	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3687	! DATA (GA( 8, 9,IC),IC=1,3) /
	3688	! S 0.24132642E+02, 0.10405247E+02, 0.00000000E+00/
	3689	! DATA (GB( 8, 9,IC),IC=1,3) /
	3690	! S 0.24132642E+02, 0.10522307E+02, 0.10000000E+01/
	3691	! DATA (GA( 8,10,IC),IC=1,3) /
	3692	! S 0.23844511E+02, 0.10349509E+02, 0.00000000E+00/
	3693	! DATA (GB( 8,10,IC),IC=1,3) /
	3694	! S 0.23844511E+02, 0.10467553E+02, 0.10000000E+01/
	3695
	3696	! ----- INTERVAL = 4 ----- T = 287.5
	3697
	3698	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3699	! DATA (GA( 9, 9,IC),IC=1,3) /
	3700	! S 0.24063614E+02, 0.10392022E+02, 0.00000000E+00/
	3701	! DATA (GB( 9, 9,IC),IC=1,3) /
	3702	! S 0.24063614E+02, 0.10509317E+02, 0.10000000E+01/
	3703	! DATA (GA( 9,10,IC),IC=1,3) /
	3704	! S 0.23776708E+02, 0.10336215E+02, 0.00000000E+00/
	3705	! DATA (GB( 9,10,IC),IC=1,3) /
	3706	! S 0.23776708E+02, 0.10454488E+02, 0.10000000E+01/
	3707
	3708	! ----- INTERVAL = 4 ----- T = 300.0
	3709
	3710	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3711	! DATA (GA(10, 9,IC),IC=1,3) /
	3712	! S 0.24000649E+02, 0.10379892E+02, 0.00000000E+00/
	3713	! DATA (GB(10, 9,IC),IC=1,3) /
	3714	! S 0.24000649E+02, 0.10497402E+02, 0.10000000E+01/
	3715	! DATA (GA(10,10,IC),IC=1,3) /
	3716	! S 0.23714816E+02, 0.10324018E+02, 0.00000000E+00/
	3717	! DATA (GB(10,10,IC),IC=1,3) /
	3718	! S 0.23714816E+02, 0.10442501E+02, 0.10000000E+01/
	3719
	3720	! ----- INTERVAL = 4 ----- T = 312.5
	3721
	3722	! -- INDICES FOR PADE APPROXIMATION 1 28 37 45
	3723	! DATA (GA(11, 9,IC),IC=1,3) /
	3724	! S 0.23943021E+02, 0.10368736E+02, 0.00000000E+00/
	3725	! DATA (GB(11, 9,IC),IC=1,3) /
	3726	! S 0.23943021E+02, 0.10486443E+02, 0.10000000E+01/
	3727	! DATA (GA(11,10,IC),IC=1,3) /
	3728	! S 0.23658197E+02, 0.10312808E+02, 0.00000000E+00/
	3729	! DATA (GB(11,10,IC),IC=1,3) /
	3730	! S 0.23658197E+02, 0.10431483E+02, 0.10000000E+01/
	3731
	3732
	3733
	3734	! -- H2O -- WEAKER PARTS OF THE STRONG BANDS -- FROM ABS225 ----
	3735
	3736	! -- WATER VAPOR --- 350 - 500 CM-1
	3737
	3738	! -- G = - 0.2*SLA, 0.0 +0.5/(1+0.5U)
	3739
	3740	! ----- INTERVAL = 5 ----- T = 187.5
	3741
	3742	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3743	! DATA (GA( 1, 5,IC),IC=1,3) /
	3744	! S 0.15750172E+00,-0.22159303E-01, 0.00000000E+00/
	3745	! DATA (GB( 1, 5,IC),IC=1,3) /
	3746	! S 0.15750172E+00, 0.38103212E+00, 0.10000000E+01/
	3747	! DATA (GA( 1, 6,IC),IC=1,3) /
	3748	! S 0.17770551E+00,-0.24972399E-01, 0.00000000E+00/
	3749	! DATA (GB( 1, 6,IC),IC=1,3) /
	3750	! S 0.17770551E+00, 0.41646579E+00, 0.10000000E+01/
	3751
	3752	! ----- INTERVAL = 5 ----- T = 200.0
	3753
	3754	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3755	! DATA (GA( 2, 5,IC),IC=1,3) /
	3756	! S 0.16174076E+00,-0.22748917E-01, 0.00000000E+00/
	3757	! DATA (GB( 2, 5,IC),IC=1,3) /
	3758	! S 0.16174076E+00, 0.38913800E+00, 0.10000000E+01/
	3759	! DATA (GA( 2, 6,IC),IC=1,3) /
	3760	! S 0.18176757E+00,-0.25537247E-01, 0.00000000E+00/
	3761	! DATA (GB( 2, 6,IC),IC=1,3) /
	3762	! S 0.18176757E+00, 0.42345095E+00, 0.10000000E+01/
	3763
	3764	! ----- INTERVAL = 5 ----- T = 212.5
	3765
	3766	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3767	! DATA (GA( 3, 5,IC),IC=1,3) /
	3768	! S 0.16548628E+00,-0.23269898E-01, 0.00000000E+00/
	3769	! DATA (GB( 3, 5,IC),IC=1,3) /
	3770	! S 0.16548628E+00, 0.39613651E+00, 0.10000000E+01/
	3771	! DATA (GA( 3, 6,IC),IC=1,3) /
	3772	! S 0.18527967E+00,-0.26025624E-01, 0.00000000E+00/
	3773	! DATA (GB( 3, 6,IC),IC=1,3) /
	3774	! S 0.18527967E+00, 0.42937476E+00, 0.10000000E+01/
	3775
	3776	! ----- INTERVAL = 5 ----- T = 225.0
	3777
	3778	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3779	! DATA (GA( 4, 5,IC),IC=1,3) /
	3780	! S 0.16881124E+00,-0.23732392E-01, 0.00000000E+00/
	3781	! DATA (GB( 4, 5,IC),IC=1,3) /
	3782	! S 0.16881124E+00, 0.40222421E+00, 0.10000000E+01/
	3783	! DATA (GA( 4, 6,IC),IC=1,3) /
	3784	! S 0.18833348E+00,-0.26450280E-01, 0.00000000E+00/
	3785	! DATA (GB( 4, 6,IC),IC=1,3) /
	3786	! S 0.18833348E+00, 0.43444062E+00, 0.10000000E+01/
	3787
	3788	! ----- INTERVAL = 5 ----- T = 237.5
	3789
	3790	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3791	! DATA (GA( 5, 5,IC),IC=1,3) /
	3792	! S 0.17177839E+00,-0.24145123E-01, 0.00000000E+00/
	3793	! DATA (GB( 5, 5,IC),IC=1,3) /
	3794	! S 0.17177839E+00, 0.40756010E+00, 0.10000000E+01/
	3795	! DATA (GA( 5, 6,IC),IC=1,3) /
	3796	! S 0.19100108E+00,-0.26821236E-01, 0.00000000E+00/
	3797	! DATA (GB( 5, 6,IC),IC=1,3) /
	3798	! S 0.19100108E+00, 0.43880316E+00, 0.10000000E+01/
	3799
	3800	! ----- INTERVAL = 5 ----- T = 250.0
	3801
	3802	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3803	! DATA (GA( 6, 5,IC),IC=1,3) /
	3804	! S 0.17443933E+00,-0.24515269E-01, 0.00000000E+00/
	3805	! DATA (GB( 6, 5,IC),IC=1,3) /
	3806	! S 0.17443933E+00, 0.41226954E+00, 0.10000000E+01/
	3807	! DATA (GA( 6, 6,IC),IC=1,3) /
	3808	! S 0.19334122E+00,-0.27146657E-01, 0.00000000E+00/
	3809	! DATA (GB( 6, 6,IC),IC=1,3) /
	3810	! S 0.19334122E+00, 0.44258354E+00, 0.10000000E+01/
	3811
	3812	! ----- INTERVAL = 5 ----- T = 262.5
	3813
	3814	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3815	! DATA (GA( 7, 5,IC),IC=1,3) /
	3816	! S 0.17683622E+00,-0.24848690E-01, 0.00000000E+00/
	3817	! DATA (GB( 7, 5,IC),IC=1,3) /
	3818	! S 0.17683622E+00, 0.41645142E+00, 0.10000000E+01/
	3819	! DATA (GA( 7, 6,IC),IC=1,3) /
	3820	! S 0.19540288E+00,-0.27433354E-01, 0.00000000E+00/
	3821	! DATA (GB( 7, 6,IC),IC=1,3) /
	3822	! S 0.19540288E+00, 0.44587882E+00, 0.10000000E+01/
	3823
	3824	! ----- INTERVAL = 5 ----- T = 275.0
	3825
	3826	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3827	! DATA (GA( 8, 5,IC),IC=1,3) /
	3828	! S 0.17900375E+00,-0.25150210E-01, 0.00000000E+00/
	3829	! DATA (GB( 8, 5,IC),IC=1,3) /
	3830	! S 0.17900375E+00, 0.42018474E+00, 0.10000000E+01/
	3831	! DATA (GA( 8, 6,IC),IC=1,3) /
	3832	! S 0.19722732E+00,-0.27687065E-01, 0.00000000E+00/
	3833	! DATA (GB( 8, 6,IC),IC=1,3) /
	3834	! S 0.19722732E+00, 0.44876776E+00, 0.10000000E+01/
	3835
	3836	! ----- INTERVAL = 5 ----- T = 287.5
	3837
	3838	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3839	! DATA (GA( 9, 5,IC),IC=1,3) /
	3840	! S 0.18097099E+00,-0.25423873E-01, 0.00000000E+00/
	3841	! DATA (GB( 9, 5,IC),IC=1,3) /
	3842	! S 0.18097099E+00, 0.42353379E+00, 0.10000000E+01/
	3843	! DATA (GA( 9, 6,IC),IC=1,3) /
	3844	! S 0.19884918E+00,-0.27912608E-01, 0.00000000E+00/
	3845	! DATA (GB( 9, 6,IC),IC=1,3) /
	3846	! S 0.19884918E+00, 0.45131451E+00, 0.10000000E+01/
	3847
	3848	! ----- INTERVAL = 5 ----- T = 300.0
	3849
	3850	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3851	! DATA (GA(10, 5,IC),IC=1,3) /
	3852	! S 0.18276283E+00,-0.25673139E-01, 0.00000000E+00/
	3853	! DATA (GB(10, 5,IC),IC=1,3) /
	3854	! S 0.18276283E+00, 0.42655211E+00, 0.10000000E+01/
	3855	! DATA (GA(10, 6,IC),IC=1,3) /
	3856	! S 0.20029696E+00,-0.28113944E-01, 0.00000000E+00/
	3857	! DATA (GB(10, 6,IC),IC=1,3) /
	3858	! S 0.20029696E+00, 0.45357095E+00, 0.10000000E+01/
	3859
	3860	! ----- INTERVAL = 5 ----- T = 312.5
	3861
	3862	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3863	! DATA (GA(11, 5,IC),IC=1,3) /
	3864	! S 0.18440117E+00,-0.25901055E-01, 0.00000000E+00/
	3865	! DATA (GB(11, 5,IC),IC=1,3) /
	3866	! S 0.18440117E+00, 0.42928533E+00, 0.10000000E+01/
	3867	! DATA (GA(11, 6,IC),IC=1,3) /
	3868	! S 0.20159300E+00,-0.28294180E-01, 0.00000000E+00/
	3869	! DATA (GB(11, 6,IC),IC=1,3) /
	3870	! S 0.20159300E+00, 0.45557797E+00, 0.10000000E+01/
	3871
	3872
	3873
	3874
	3875	! - WATER VAPOR - WINGS OF VIBRATION-ROTATION BAND - 1250-1450+1880-2820 -
	3876	! --- G = 0.0
	3877
	3878
	3879	! ----- INTERVAL = 6 ----- T = 187.5
	3880
	3881	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3882	! DATA (GA( 1,11,IC),IC=1,3) /
	3883	! S 0.11990218E+02,-0.12823142E+01, 0.00000000E+00/
	3884	! DATA (GB( 1,11,IC),IC=1,3) /
	3885	! S 0.11990218E+02, 0.26681588E+02, 0.10000000E+01/
	3886	! DATA (GA( 1,12,IC),IC=1,3) /
	3887	! S 0.79709806E+01,-0.74805226E+00, 0.00000000E+00/
	3888	! DATA (GB( 1,12,IC),IC=1,3) /
	3889	! S 0.79709806E+01, 0.18377807E+02, 0.10000000E+01/
	3890
	3891	! ----- INTERVAL = 6 ----- T = 200.0
	3892
	3893	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3894	! DATA (GA( 2,11,IC),IC=1,3) /
	3895	! S 0.10904073E+02,-0.10571588E+01, 0.00000000E+00/
	3896	! DATA (GB( 2,11,IC),IC=1,3) /
	3897	! S 0.10904073E+02, 0.24728346E+02, 0.10000000E+01/
	3898	! DATA (GA( 2,12,IC),IC=1,3) /
	3899	! S 0.75400737E+01,-0.56252739E+00, 0.00000000E+00/
	3900	! DATA (GB( 2,12,IC),IC=1,3) /
	3901	! S 0.75400737E+01, 0.17643148E+02, 0.10000000E+01/
	3902
	3903	! ----- INTERVAL = 6 ----- T = 212.5
	3904
	3905	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3906	! DATA (GA( 3,11,IC),IC=1,3) /
	3907	! S 0.89126838E+01,-0.74864953E+00, 0.00000000E+00/
	3908	! DATA (GB( 3,11,IC),IC=1,3) /
	3909	! S 0.89126838E+01, 0.20551342E+02, 0.10000000E+01/
	3910	! DATA (GA( 3,12,IC),IC=1,3) /
	3911	! S 0.81804377E+01,-0.46188072E+00, 0.00000000E+00/
	3912	! DATA (GB( 3,12,IC),IC=1,3) /
	3913	! S 0.81804377E+01, 0.19296161E+02, 0.10000000E+01/
	3914
	3915	! ----- INTERVAL = 6 ----- T = 225.0
	3916
	3917	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3918	! DATA (GA( 4,11,IC),IC=1,3) /
	3919	! S 0.85622405E+01,-0.58705980E+00, 0.00000000E+00/
	3920	! DATA (GB( 4,11,IC),IC=1,3) /
	3921	! S 0.85622405E+01, 0.19955244E+02, 0.10000000E+01/
	3922	! DATA (GA( 4,12,IC),IC=1,3) /
	3923	! S 0.10564339E+02,-0.40712065E+00, 0.00000000E+00/
	3924	! DATA (GB( 4,12,IC),IC=1,3) /
	3925	! S 0.10564339E+02, 0.24951120E+02, 0.10000000E+01/
	3926
	3927	! ----- INTERVAL = 6 ----- T = 237.5
	3928
	3929	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3930	! DATA (GA( 5,11,IC),IC=1,3) /
	3931	! S 0.94892164E+01,-0.49305772E+00, 0.00000000E+00/
	3932	! DATA (GB( 5,11,IC),IC=1,3) /
	3933	! S 0.94892164E+01, 0.22227100E+02, 0.10000000E+01/
	3934	! DATA (GA( 5,12,IC),IC=1,3) /
	3935	! S 0.46896789E+02,-0.15295996E+01, 0.00000000E+00/
	3936	! DATA (GB( 5,12,IC),IC=1,3) /
	3937	! S 0.46896789E+02, 0.10957372E+03, 0.10000000E+01/
	3938
	3939	! ----- INTERVAL = 6 ----- T = 250.0
	3940
	3941	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3942	! DATA (GA( 6,11,IC),IC=1,3) /
	3943	! S 0.13580937E+02,-0.51461431E+00, 0.00000000E+00/
	3944	! DATA (GB( 6,11,IC),IC=1,3) /
	3945	! S 0.13580937E+02, 0.31770288E+02, 0.10000000E+01/
	3946	! DATA (GA( 6,12,IC),IC=1,3) /
	3947	! S-0.30926524E+01, 0.43555255E+00, 0.00000000E+00/
	3948	! DATA (GB( 6,12,IC),IC=1,3) /
	3949	! S-0.30926524E+01,-0.67432659E+01, 0.10000000E+01/
	3950
	3951	! ----- INTERVAL = 6 ----- T = 262.5
	3952
	3953	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3954	! DATA (GA( 7,11,IC),IC=1,3) /
	3955	! S-0.32050918E+03, 0.12373350E+02, 0.00000000E+00/
	3956	! DATA (GB( 7,11,IC),IC=1,3) /
	3957	! S-0.32050918E+03,-0.74061287E+03, 0.10000000E+01/
	3958	! DATA (GA( 7,12,IC),IC=1,3) /
	3959	! S 0.85742941E+00, 0.50380874E+00, 0.00000000E+00/
	3960	! DATA (GB( 7,12,IC),IC=1,3) /
	3961	! S 0.85742941E+00, 0.24550746E+01, 0.10000000E+01/
	3962
	3963	! ----- INTERVAL = 6 ----- T = 275.0
	3964
	3965	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3966	! DATA (GA( 8,11,IC),IC=1,3) /
	3967	! S-0.37133165E+01, 0.44809588E+00, 0.00000000E+00/
	3968	! DATA (GB( 8,11,IC),IC=1,3) /
	3969	! S-0.37133165E+01,-0.81329826E+01, 0.10000000E+01/
	3970	! DATA (GA( 8,12,IC),IC=1,3) /
	3971	! S 0.19164038E+01, 0.68537352E+00, 0.00000000E+00/
	3972	! DATA (GB( 8,12,IC),IC=1,3) /
	3973	! S 0.19164038E+01, 0.49089917E+01, 0.10000000E+01/
	3974
	3975	! ----- INTERVAL = 6 ----- T = 287.5
	3976
	3977	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3978	! DATA (GA( 9,11,IC),IC=1,3) /
	3979	! S 0.18890836E+00, 0.46548918E+00, 0.00000000E+00/
	3980	! DATA (GB( 9,11,IC),IC=1,3) /
	3981	! S 0.18890836E+00, 0.90279822E+00, 0.10000000E+01/
	3982	! DATA (GA( 9,12,IC),IC=1,3) /
	3983	! S 0.23513199E+01, 0.89437630E+00, 0.00000000E+00/
	3984	! DATA (GB( 9,12,IC),IC=1,3) /
	3985	! S 0.23513199E+01, 0.59008712E+01, 0.10000000E+01/
	3986
	3987	! ----- INTERVAL = 6 ----- T = 300.0
	3988
	3989	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	3990	! DATA (GA(10,11,IC),IC=1,3) /
	3991	! S 0.14209226E+01, 0.59121475E+00, 0.00000000E+00/
	3992	! DATA (GB(10,11,IC),IC=1,3) /
	3993	! S 0.14209226E+01, 0.37532746E+01, 0.10000000E+01/
	3994	! DATA (GA(10,12,IC),IC=1,3) /
	3995	! S 0.25566644E+01, 0.11127003E+01, 0.00000000E+00/
	3996	! DATA (GB(10,12,IC),IC=1,3) /
	3997	! S 0.25566644E+01, 0.63532616E+01, 0.10000000E+01/
	3998
	3999	! ----- INTERVAL = 6 ----- T = 312.5
	4000
	4001	! -- INDICES FOR PADE APPROXIMATION 1 35 40 45
	4002	! DATA (GA(11,11,IC),IC=1,3) /
	4003	! S 0.19817679E+01, 0.74676119E+00, 0.00000000E+00/
	4004	! DATA (GB(11,11,IC),IC=1,3) /
	4005	! S 0.19817679E+01, 0.50437916E+01, 0.10000000E+01/
	4006	! DATA (GA(11,12,IC),IC=1,3) /
	4007	! S 0.26555181E+01, 0.13329782E+01, 0.00000000E+00/
	4008	! DATA (GB(11,12,IC),IC=1,3) /
	4009	! S 0.26555181E+01, 0.65558627E+01, 0.10000000E+01/
	4010
	4011
	4012
	4013
	4014
	4015	! -- END WATER VAPOR
	4016
	4017
	4018	! -- CO2 -- INT.2 -- 500-800 CM-1 --- FROM ABS225 ----------------------
	4019
	4020
	4021
	4022	! -- FIU = 0.8 + MAX(0.35,(7-IU)*0.9) , X/T, 9
	4023
	4024	! ----- INTERVAL = 2 ----- T = 187.5
	4025
	4026	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4027	! DATA (GA( 1,13,IC),IC=1,3) /
	4028	! S 0.87668459E-01, 0.13845511E+01, 0.00000000E+00/
	4029	! DATA (GB( 1,13,IC),IC=1,3) /
	4030	! S 0.87668459E-01, 0.23203798E+01, 0.10000000E+01/
	4031	! DATA (GA( 1,14,IC),IC=1,3) /
	4032	! S 0.74878820E-01, 0.11718758E+01, 0.00000000E+00/
	4033	! DATA (GB( 1,14,IC),IC=1,3) /
	4034	! S 0.74878820E-01, 0.20206726E+01, 0.10000000E+01/
	4035
	4036	! ----- INTERVAL = 2 ----- T = 200.0
	4037
	4038	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4039	! DATA (GA( 2,13,IC),IC=1,3) /
	4040	! S 0.83754276E-01, 0.13187042E+01, 0.00000000E+00/
	4041	! DATA (GB( 2,13,IC),IC=1,3) /
	4042	! S 0.83754276E-01, 0.22288925E+01, 0.10000000E+01/
	4043	! DATA (GA( 2,14,IC),IC=1,3) /
	4044	! S 0.71650966E-01, 0.11216131E+01, 0.00000000E+00/
	4045	! DATA (GB( 2,14,IC),IC=1,3) /
	4046	! S 0.71650966E-01, 0.19441824E+01, 0.10000000E+01/
	4047
	4048	! ----- INTERVAL = 2 ----- T = 212.5
	4049
	4050	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4051	! DATA (GA( 3,13,IC),IC=1,3) /
	4052	! S 0.80460283E-01, 0.12644396E+01, 0.00000000E+00/
	4053	! DATA (GB( 3,13,IC),IC=1,3) /
	4054	! S 0.80460283E-01, 0.21515593E+01, 0.10000000E+01/
	4055	! DATA (GA( 3,14,IC),IC=1,3) /
	4056	! S 0.68979615E-01, 0.10809473E+01, 0.00000000E+00/
	4057	! DATA (GB( 3,14,IC),IC=1,3) /
	4058	! S 0.68979615E-01, 0.18807257E+01, 0.10000000E+01/
	4059
	4060	! ----- INTERVAL = 2 ----- T = 225.0
	4061
	4062	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4063	! DATA (GA( 4,13,IC),IC=1,3) /
	4064	! S 0.77659686E-01, 0.12191543E+01, 0.00000000E+00/
	4065	! DATA (GB( 4,13,IC),IC=1,3) /
	4066	! S 0.77659686E-01, 0.20855896E+01, 0.10000000E+01/
	4067	! DATA (GA( 4,14,IC),IC=1,3) /
	4068	! S 0.66745345E-01, 0.10476396E+01, 0.00000000E+00/
	4069	! DATA (GB( 4,14,IC),IC=1,3) /
	4070	! S 0.66745345E-01, 0.18275618E+01, 0.10000000E+01/
	4071
	4072	! ----- INTERVAL = 2 ----- T = 237.5
	4073
	4074	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4075	! DATA (GA( 5,13,IC),IC=1,3) /
	4076	! S 0.75257056E-01, 0.11809511E+01, 0.00000000E+00/
	4077	! DATA (GB( 5,13,IC),IC=1,3) /
	4078	! S 0.75257056E-01, 0.20288489E+01, 0.10000000E+01/
	4079	! DATA (GA( 5,14,IC),IC=1,3) /
	4080	! S 0.64857571E-01, 0.10200373E+01, 0.00000000E+00/
	4081	! DATA (GB( 5,14,IC),IC=1,3) /
	4082	! S 0.64857571E-01, 0.17825910E+01, 0.10000000E+01/
	4083
	4084	! ----- INTERVAL = 2 ----- T = 250.0
	4085
	4086	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4087	! DATA (GA( 6,13,IC),IC=1,3) /
	4088	! S 0.73179175E-01, 0.11484154E+01, 0.00000000E+00/
	4089	! DATA (GB( 6,13,IC),IC=1,3) /
	4090	! S 0.73179175E-01, 0.19796791E+01, 0.10000000E+01/
	4091	! DATA (GA( 6,14,IC),IC=1,3) /
	4092	! S 0.63248495E-01, 0.99692726E+00, 0.00000000E+00/
	4093	! DATA (GB( 6,14,IC),IC=1,3) /
	4094	! S 0.63248495E-01, 0.17442308E+01, 0.10000000E+01/
	4095
	4096	! ----- INTERVAL = 2 ----- T = 262.5
	4097
	4098	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4099	! DATA (GA( 7,13,IC),IC=1,3) /
	4100	! S 0.71369063E-01, 0.11204723E+01, 0.00000000E+00/
	4101	! DATA (GB( 7,13,IC),IC=1,3) /
	4102	! S 0.71369063E-01, 0.19367778E+01, 0.10000000E+01/
	4103	! DATA (GA( 7,14,IC),IC=1,3) /
	4104	! S 0.61866970E-01, 0.97740923E+00, 0.00000000E+00/
	4105	! DATA (GB( 7,14,IC),IC=1,3) /
	4106	! S 0.61866970E-01, 0.17112809E+01, 0.10000000E+01/
	4107
	4108	! ----- INTERVAL = 2 ----- T = 275.0
	4109
	4110	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4111	! DATA (GA( 8,13,IC),IC=1,3) /
	4112	! S 0.69781812E-01, 0.10962918E+01, 0.00000000E+00/
	4113	! DATA (GB( 8,13,IC),IC=1,3) /
	4114	! S 0.69781812E-01, 0.18991112E+01, 0.10000000E+01/
	4115	! DATA (GA( 8,14,IC),IC=1,3) /
	4116	! S 0.60673632E-01, 0.96080188E+00, 0.00000000E+00/
	4117	! DATA (GB( 8,14,IC),IC=1,3) /
	4118	! S 0.60673632E-01, 0.16828137E+01, 0.10000000E+01/
	4119
	4120	! ----- INTERVAL = 2 ----- T = 287.5
	4121
	4122	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4123	! DATA (GA( 9,13,IC),IC=1,3) /
	4124	! S 0.68381606E-01, 0.10752229E+01, 0.00000000E+00/
	4125	! DATA (GB( 9,13,IC),IC=1,3) /
	4126	! S 0.68381606E-01, 0.18658501E+01, 0.10000000E+01/
	4127	! DATA (GA( 9,14,IC),IC=1,3) /
	4128	! S 0.59637277E-01, 0.94657562E+00, 0.00000000E+00/
	4129	! DATA (GB( 9,14,IC),IC=1,3) /
	4130	! S 0.59637277E-01, 0.16580908E+01, 0.10000000E+01/
	4131
	4132	! ----- INTERVAL = 2 ----- T = 300.0
	4133
	4134	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4135	! DATA (GA(10,13,IC),IC=1,3) /
	4136	! S 0.67139539E-01, 0.10567474E+01, 0.00000000E+00/
	4137	! DATA (GB(10,13,IC),IC=1,3) /
	4138	! S 0.67139539E-01, 0.18363226E+01, 0.10000000E+01/
	4139	! DATA (GA(10,14,IC),IC=1,3) /
	4140	! S 0.58732178E-01, 0.93430511E+00, 0.00000000E+00/
	4141	! DATA (GB(10,14,IC),IC=1,3) /
	4142	! S 0.58732178E-01, 0.16365014E+01, 0.10000000E+01/
	4143
	4144	! ----- INTERVAL = 2 ----- T = 312.5
	4145
	4146	! -- INDICES FOR PADE APPROXIMATION 1 30 38 45
	4147	! DATA (GA(11,13,IC),IC=1,3) /
	4148	! S 0.66032012E-01, 0.10404465E+01, 0.00000000E+00/
	4149	! DATA (GB(11,13,IC),IC=1,3) /
	4150	! S 0.66032012E-01, 0.18099779E+01, 0.10000000E+01/
	4151	! DATA (GA(11,14,IC),IC=1,3) /
	4152	! S 0.57936092E-01, 0.92363528E+00, 0.00000000E+00/
	4153	! DATA (GB(11,14,IC),IC=1,3) /
	4154	! S 0.57936092E-01, 0.16175164E+01, 0.10000000E+01/
	4155
	4156
	4157
	4158
	4159
	4160
	4161
	4162
	4163
	4164
	4165	! -- CARBON DIOXIDE LINES IN THE WINDOW REGION (800-1250 CM-1)
	4166
	4167
	4168	! -- G = 0.0
	4169
	4170
	4171	! ----- INTERVAL = 4 ----- T = 187.5
	4172
	4173	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4174	! DATA (GA( 1,15,IC),IC=1,3) /
	4175	! S 0.13230067E+02, 0.22042132E+02, 0.00000000E+00/
	4176	! DATA (GB( 1,15,IC),IC=1,3) /
	4177	! S 0.13230067E+02, 0.22051750E+02, 0.10000000E+01/
	4178	! DATA (GA( 1,16,IC),IC=1,3) /
	4179	! S 0.13183816E+02, 0.22169501E+02, 0.00000000E+00/
	4180	! DATA (GB( 1,16,IC),IC=1,3) /
	4181	! S 0.13183816E+02, 0.22178972E+02, 0.10000000E+01/
	4182
	4183	! ----- INTERVAL = 4 ----- T = 200.0
	4184
	4185	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4186	! DATA (GA( 2,15,IC),IC=1,3) /
	4187	! S 0.13213564E+02, 0.22107298E+02, 0.00000000E+00/
	4188	! DATA (GB( 2,15,IC),IC=1,3) /
	4189	! S 0.13213564E+02, 0.22116850E+02, 0.10000000E+01/
	4190	! DATA (GA( 2,16,IC),IC=1,3) /
	4191	! S 0.13189991E+02, 0.22270075E+02, 0.00000000E+00/
	4192	! DATA (GB( 2,16,IC),IC=1,3) /
	4193	! S 0.13189991E+02, 0.22279484E+02, 0.10000000E+01/
	4194
	4195	! ----- INTERVAL = 4 ----- T = 212.5
	4196
	4197	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4198	! DATA (GA( 3,15,IC),IC=1,3) /
	4199	! S 0.13209140E+02, 0.22180915E+02, 0.00000000E+00/
	4200	! DATA (GB( 3,15,IC),IC=1,3) /
	4201	! S 0.13209140E+02, 0.22190410E+02, 0.10000000E+01/
	4202	! DATA (GA( 3,16,IC),IC=1,3) /
	4203	! S 0.13209485E+02, 0.22379193E+02, 0.00000000E+00/
	4204	! DATA (GB( 3,16,IC),IC=1,3) /
	4205	! S 0.13209485E+02, 0.22388551E+02, 0.10000000E+01/
	4206
	4207	! ----- INTERVAL = 4 ----- T = 225.0
	4208
	4209	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4210	! DATA (GA( 4,15,IC),IC=1,3) /
	4211	! S 0.13213894E+02, 0.22259478E+02, 0.00000000E+00/
	4212	! DATA (GB( 4,15,IC),IC=1,3) /
	4213	! S 0.13213894E+02, 0.22268925E+02, 0.10000000E+01/
	4214	! DATA (GA( 4,16,IC),IC=1,3) /
	4215	! S 0.13238789E+02, 0.22492992E+02, 0.00000000E+00/
	4216	! DATA (GB( 4,16,IC),IC=1,3) /
	4217	! S 0.13238789E+02, 0.22502309E+02, 0.10000000E+01/
	4218
	4219	! ----- INTERVAL = 4 ----- T = 237.5
	4220
	4221	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4222	! DATA (GA( 5,15,IC),IC=1,3) /
	4223	! S 0.13225963E+02, 0.22341039E+02, 0.00000000E+00/
	4224	! DATA (GB( 5,15,IC),IC=1,3) /
	4225	! S 0.13225963E+02, 0.22350445E+02, 0.10000000E+01/
	4226	! DATA (GA( 5,16,IC),IC=1,3) /
	4227	! S 0.13275017E+02, 0.22608508E+02, 0.00000000E+00/
	4228	! DATA (GB( 5,16,IC),IC=1,3) /
	4229	! S 0.13275017E+02, 0.22617792E+02, 0.10000000E+01/
	4230
	4231	! ----- INTERVAL = 4 ----- T = 250.0
	4232
	4233	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4234	! DATA (GA( 6,15,IC),IC=1,3) /
	4235	! S 0.13243806E+02, 0.22424247E+02, 0.00000000E+00/
	4236	! DATA (GB( 6,15,IC),IC=1,3) /
	4237	! S 0.13243806E+02, 0.22433617E+02, 0.10000000E+01/
	4238	! DATA (GA( 6,16,IC),IC=1,3) /
	4239	! S 0.13316096E+02, 0.22723843E+02, 0.00000000E+00/
	4240	! DATA (GB( 6,16,IC),IC=1,3) /
	4241	! S 0.13316096E+02, 0.22733099E+02, 0.10000000E+01/
	4242
	4243	! ----- INTERVAL = 4 ----- T = 262.5
	4244
	4245	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4246	! DATA (GA( 7,15,IC),IC=1,3) /
	4247	! S 0.13266104E+02, 0.22508089E+02, 0.00000000E+00/
	4248	! DATA (GB( 7,15,IC),IC=1,3) /
	4249	! S 0.13266104E+02, 0.22517429E+02, 0.10000000E+01/
	4250	! DATA (GA( 7,16,IC),IC=1,3) /
	4251	! S 0.13360555E+02, 0.22837837E+02, 0.00000000E+00/
	4252	! DATA (GB( 7,16,IC),IC=1,3) /
	4253	! S 0.13360555E+02, 0.22847071E+02, 0.10000000E+01/
	4254
	4255	! ----- INTERVAL = 4 ----- T = 275.0
	4256
	4257	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4258	! DATA (GA( 8,15,IC),IC=1,3) /
	4259	! S 0.13291782E+02, 0.22591771E+02, 0.00000000E+00/
	4260	! DATA (GB( 8,15,IC),IC=1,3) /
	4261	! S 0.13291782E+02, 0.22601086E+02, 0.10000000E+01/
	4262	! DATA (GA( 8,16,IC),IC=1,3) /
	4263	! S 0.13407324E+02, 0.22949751E+02, 0.00000000E+00/
	4264	! DATA (GB( 8,16,IC),IC=1,3) /
	4265	! S 0.13407324E+02, 0.22958967E+02, 0.10000000E+01/
	4266
	4267	! ----- INTERVAL = 4 ----- T = 287.5
	4268
	4269	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4270	! DATA (GA( 9,15,IC),IC=1,3) /
	4271	! S 0.13319961E+02, 0.22674661E+02, 0.00000000E+00/
	4272	! DATA (GB( 9,15,IC),IC=1,3) /
	4273	! S 0.13319961E+02, 0.22683956E+02, 0.10000000E+01/
	4274	! DATA (GA( 9,16,IC),IC=1,3) /
	4275	! S 0.13455544E+02, 0.23059032E+02, 0.00000000E+00/
	4276	! DATA (GB( 9,16,IC),IC=1,3) /
	4277	! S 0.13455544E+02, 0.23068234E+02, 0.10000000E+01/
	4278
	4279	! ----- INTERVAL = 4 ----- T = 300.0
	4280
	4281	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4282	! DATA (GA(10,15,IC),IC=1,3) /
	4283	! S 0.13349927E+02, 0.22756246E+02, 0.00000000E+00/
	4284	! DATA (GB(10,15,IC),IC=1,3) /
	4285	! S 0.13349927E+02, 0.22765522E+02, 0.10000000E+01/
	4286	! DATA (GA(10,16,IC),IC=1,3) /
	4287	! S 0.13504450E+02, 0.23165146E+02, 0.00000000E+00/
	4288	! DATA (GB(10,16,IC),IC=1,3) /
	4289	! S 0.13504450E+02, 0.23174336E+02, 0.10000000E+01/
	4290
	4291	! ----- INTERVAL = 4 ----- T = 312.5
	4292
	4293	! -- INDICES FOR PADE APPROXIMATION 1 15 29 45
	4294	! DATA (GA(11,15,IC),IC=1,3) /
	4295	! S 0.13381108E+02, 0.22836093E+02, 0.00000000E+00/
	4296	! DATA (GB(11,15,IC),IC=1,3) /
	4297	! S 0.13381108E+02, 0.22845354E+02, 0.10000000E+01/
	4298	! DATA (GA(11,16,IC),IC=1,3) /
	4299	! S 0.13553282E+02, 0.23267456E+02, 0.00000000E+00/
	4300	! DATA (GB(11,16,IC),IC=1,3) /
	4301	! S 0.13553282E+02, 0.23276638E+02, 0.10000000E+01/
	4302
	4303	! ------------------------------------------------------------------
	4304	! DATA (( XP( J,K),J=1,6), K=1,6) /
	4305	! S 0.46430621E+02, 0.12928299E+03, 0.20732648E+03,
	4306	! S 0.31398411E+03, 0.18373177E+03,-0.11412303E+03,
	4307	! S 0.73604774E+02, 0.27887914E+03, 0.27076947E+03,
	4308	! S-0.57322111E+02,-0.64742459E+02, 0.87238280E+02,
	4309	! S 0.37050866E+02, 0.20498759E+03, 0.37558029E+03,
	4310	! S 0.17401171E+03,-0.13350302E+03,-0.37651795E+02,
	4311	! S 0.14930141E+02, 0.89161160E+02, 0.17793062E+03,
	4312	! S 0.93433860E+02,-0.70646020E+02,-0.26373150E+02,
	4313	! S 0.40386780E+02, 0.10855270E+03, 0.50755010E+02,
	4314	! S-0.31496190E+02, 0.12791300E+00, 0.18017770E+01,
	4315	! S 0.90811926E+01, 0.75073923E+02, 0.24654438E+03,
	4316	! S 0.39332612E+03, 0.29385281E+03, 0.89107921E+02 /
	4317
	4318
	4319
	4320	! * 1.0 PLANCK FUNCTIONS AND GRADIENTS
	4321	! ------------------------------
	4322
	4323
	4324	! cdir collapse
	4325	DO jk = 1, kflev + 1
	4326	DO jl = 1, kdlon
	4327	pbint(jl, jk) = 0.
	4328	END DO
	4329	END DO
	4330	DO jl = 1, kdlon
	4331	pbsuin(jl) = 0.
	4332	END DO
	4333
	4334	DO jnu = 1, ninter
	4335
	4336	! * 1.1 LEVELS FROM SURFACE TO KFLEV
	4337	! ----------------------------
	4338
	4339	DO jk = 1, kflev
	4340	DO jl = 1, kdlon
[5144]	4341	zti(jl) = (ptl(jl, jk) - tstand) / tstand
	4342	zres(jl) = xp(1, jnu) + zti(jl) * (xp(2, jnu) + zti(jl) * (xp(3, &
	4343	jnu) + zti(jl) * (xp(4, jnu) + zti(jl) * (xp(5, jnu) + zti(jl) * (xp(6, jnu))))))
[1992]	4344	pbint(jl, jk) = pbint(jl, jk) + zres(jl)
	4345	pb(jl, jnu, jk) = zres(jl)
	4346	zblev(jl, jk) = zres(jl)
[5144]	4347	zti2(jl) = (ptave(jl, jk) - tstand) / tstand
	4348	zres2(jl) = xp(1, jnu) + zti2(jl) * (xp(2, jnu) + zti2(jl) * (xp(3, &
	4349	jnu) + zti2(jl) * (xp(4, jnu) + zti2(jl) * (xp(5, jnu) + zti2(jl) * (xp(6, jnu)))) &
	4350	))
[1992]	4351	zblay(jl, jk) = zres2(jl)
	4352	END DO
	4353	END DO
	4354
	4355	! * 1.2 TOP OF THE ATMOSPHERE AND SURFACE
	4356	! ---------------------------------
	4357
	4358	DO jl = 1, kdlon
[5144]	4359	zti(jl) = (ptl(jl, kflev + 1) - tstand) / tstand
	4360	zti2(jl) = (ptl(jl, 1) + pdt0(jl) - tstand) / tstand
	4361	zres(jl) = xp(1, jnu) + zti(jl) * (xp(2, jnu) + zti(jl) * (xp(3, &
	4362	jnu) + zti(jl) * (xp(4, jnu) + zti(jl) * (xp(5, jnu) + zti(jl) * (xp(6, jnu))))))
	4363	zres2(jl) = xp(1, jnu) + zti2(jl) * (xp(2, jnu) + zti2(jl) * (xp(3, &
	4364	jnu) + zti2(jl) * (xp(4, jnu) + zti2(jl) * (xp(5, jnu) + zti2(jl) * (xp(6, jnu))))))
	4365	pbint(jl, kflev + 1) = pbint(jl, kflev + 1) + zres(jl)
	4366	pb(jl, jnu, kflev + 1) = zres(jl)
	4367	zblev(jl, kflev + 1) = zres(jl)
[1992]	4368	pbtop(jl, jnu) = zres(jl)
	4369	pbsur(jl, jnu) = zres2(jl)
	4370	pbsuin(jl) = pbsuin(jl) + zres2(jl)
	4371	END DO
	4372
	4373	! * 1.3 GRADIENTS IN SUB-LAYERS
	4374	! -----------------------
	4375
	4376	DO jk = 1, kflev
[5144]	4377	jk2 = 2 * jk
[1992]	4378	jk1 = jk2 - 1
	4379	DO jl = 1, kdlon
	4380	pdbsl(jl, jnu, jk1) = zblay(jl, jk) - zblev(jl, jk)
[5144]	4381	pdbsl(jl, jnu, jk2) = zblev(jl, jk + 1) - zblay(jl, jk)
[1992]	4382	END DO
	4383	END DO
	4384
	4385	END DO
	4386
	4387	! * 2.0 CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS
	4388	! ---------------------------------------------
	4389
	4390	DO jl = 1, kdlon
[5144]	4391	zdsto1 = (ptl(jl, kflev + 1) - tintp(1)) / tstp
	4392	ixtox = max(1, min(mxixt, int(zdsto1 + 1.)))
	4393	zdstox = (ptl(jl, kflev + 1) - tintp(ixtox)) / tstp
[1992]	4394	IF (zdstox<0.5) THEN
	4395	indto = ixtox
	4396	ELSE
	4397	indto = ixtox + 1
	4398	END IF
	4399	indb(jl) = indto
[5144]	4400	zdst1 = (ptl(jl, 1) - tintp(1)) / tstp
	4401	ixtx = max(1, min(mxixt, int(zdst1 + 1.)))
	4402	zdstx = (ptl(jl, 1) - tintp(ixtx)) / tstp
[1992]	4403	IF (zdstx<0.5) THEN
	4404	indt = ixtx
	4405	ELSE
	4406	indt = ixtx + 1
	4407	END IF
	4408	inds(jl) = indt
	4409	END DO
	4410
	4411	DO jf = 1, 2
	4412	DO jg = 1, 8
	4413	DO jl = 1, kdlon
	4414	indsu = inds(jl)
[5144]	4415	pgasur(jl, jg, jf) = ga(indsu, 2 * jg - 1, jf)
	4416	pgbsur(jl, jg, jf) = gb(indsu, 2 * jg - 1, jf)
[1992]	4417	indtp = indb(jl)
[5144]	4418	pgatop(jl, jg, jf) = ga(indtp, 2 * jg - 1, jf)
	4419	pgbtop(jl, jg, jf) = gb(indtp, 2 * jg - 1, jf)
[1992]	4420	END DO
	4421	END DO
	4422	END DO
	4423
	4424	DO jk = 1, kflev
	4425	DO jl = 1, kdlon
[5144]	4426	zdst1 = (ptave(jl, jk) - tintp(1)) / tstp
	4427	ixtx = max(1, min(mxixt, int(zdst1 + 1.)))
	4428	zdstx = (ptave(jl, jk) - tintp(ixtx)) / tstp
[1992]	4429	IF (zdstx<0.5) THEN
	4430	indt = ixtx
[998]	4431	ELSE
[1992]	4432	indt = ixtx + 1
[998]	4433	END IF
[1992]	4434	indb(jl) = indt
	4435	END DO
	4436
	4437	DO jf = 1, 2
	4438	DO jg = 1, 8
	4439	DO jl = 1, kdlon
	4440	indt = indb(jl)
[5144]	4441	pga(jl, jg, jf, jk) = ga(indt, 2 * jg, jf)
	4442	pgb(jl, jg, jf, jk) = gb(indt, 2 * jg, jf)
[1992]	4443	END DO
	4444	END DO
	4445	END DO
	4446	END DO
	4447
	4448	! ------------------------------------------------------------------
	4449
	4450	END SUBROUTINE lwb_lmdar4
	4451	SUBROUTINE lwv_lmdar4(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, &
[5144]	4452	pbtop, pdbsl, pemis, ppmb, ptave, pga, pgb, pgasur, pgbsur, pgatop, &
	4453	pgbtop, pcntrb, pcts, pfluc)
[1992]	4454	USE dimphy
[5144]	4455	USE lmdz_yomcst
	4456
[1992]	4457	IMPLICIT NONE
	4458	include "raddimlw.h"
	4459
	4460	! -----------------------------------------------------------------------
	4461	! PURPOSE.
	4462	! --------
	4463	! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
	4464	! FLUXES OR RADIANCES
	4465
	4466	! METHOD.
	4467	! -------
	4468
	4469	! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
	4470	! CONTRIBUTIONS BY - THE NEARBY LAYERS
	4471	! - THE DISTANT LAYERS
	4472	! - THE BOUNDARY TERMS
	4473	! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
	4474
	4475	! REFERENCE.
	4476	! ----------
	4477
	4478	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	4479	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	4480
	4481	! AUTHOR.
	4482	! -------
	4483	! JEAN-JACQUES MORCRETTE ECMWF
	4484
	4485	! MODIFICATIONS.
	4486	! --------------
	4487	! ORIGINAL : 89-07-14
	4488	! -----------------------------------------------------------------------
	4489
	4490	! * ARGUMENTS:
	4491	INTEGER kuaer, ktraer, klim
	4492
[5144]	4493	REAL (KIND = 8) pabcu(kdlon, nua, 3 * kflev + 1) ! EFFECTIVE ABSORBER AMOUNTS
	4494	REAL (KIND = 8) pb(kdlon, ninter, kflev + 1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
	4495	REAL (KIND = 8) pbint(kdlon, kflev + 1) ! HALF-LEVEL PLANCK FUNCTIONS
	4496	REAL (KIND = 8) pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
	4497	REAL (KIND = 8) pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
	4498	REAL (KIND = 8) pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
	4499	REAL (KIND = 8) pdbsl(kdlon, ninter, kflev * 2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
	4500	REAL (KIND = 8) pemis(kdlon) ! SURFACE EMISSIVITY
	4501	REAL (KIND = 8) ppmb(kdlon, kflev + 1) ! HALF-LEVEL PRESSURE (MB)
	4502	REAL (KIND = 8) ptave(kdlon, kflev) ! TEMPERATURE
	4503	REAL (KIND = 8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
	4504	REAL (KIND = 8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
	4505	REAL (KIND = 8) pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS
	4506	REAL (KIND = 8) pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS
	4507	REAL (KIND = 8) pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS
	4508	REAL (KIND = 8) pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS
[1992]	4509
[5144]	4510	REAL (KIND = 8) pcntrb(kdlon, kflev + 1, kflev + 1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
	4511	REAL (KIND = 8) pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
	4512	REAL (KIND = 8) pfluc(kdlon, 2, kflev + 1) ! CLEAR-SKY RADIATIVE FLUXES
[1992]	4513	! -----------------------------------------------------------------------
	4514	! LOCAL VARIABLES:
[5144]	4515	REAL (KIND = 8) zadjd(kdlon, kflev + 1)
	4516	REAL (KIND = 8) zadju(kdlon, kflev + 1)
	4517	REAL (KIND = 8) zdbdt(kdlon, ninter, kflev)
	4518	REAL (KIND = 8) zdisd(kdlon, kflev + 1)
	4519	REAL (KIND = 8) zdisu(kdlon, kflev + 1)
[1992]	4520
	4521	INTEGER jk, jl
	4522	! -----------------------------------------------------------------------
	4523
	4524	DO jk = 1, kflev + 1
	4525	DO jl = 1, kdlon
	4526	zadjd(jl, jk) = 0.
	4527	zadju(jl, jk) = 0.
	4528	zdisd(jl, jk) = 0.
	4529	zdisu(jl, jk) = 0.
	4530	END DO
	4531	END DO
	4532
	4533	DO jk = 1, kflev
	4534	DO jl = 1, kdlon
	4535	pcts(jl, jk) = 0.
	4536	END DO
	4537	END DO
	4538
	4539	! * CONTRIBUTION FROM ADJACENT LAYERS
	4540
	4541	CALL lwvn_lmdar4(kuaer, ktraer, pabcu, pdbsl, pga, pgb, zadjd, zadju, &
[5144]	4542	pcntrb, zdbdt)
[1992]	4543	! * CONTRIBUTION FROM DISTANT LAYERS
	4544
	4545	CALL lwvd_lmdar4(kuaer, ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, &
[5144]	4546	zdisu)
[1992]	4547
	4548	! * EXCHANGE WITH THE BOUNDARIES
	4549
	4550	CALL lwvb_lmdar4(kuaer, ktraer, klim, pabcu, zadjd, zadju, pb, pbint, &
[5144]	4551	pbsuin, pbsur, pbtop, zdisd, zdisu, pemis, ppmb, pga, pgb, pgasur, &
	4552	pgbsur, pgatop, pgbtop, pcts, pfluc)
[1992]	4553
	4554	END SUBROUTINE lwv_lmdar4
	4555	SUBROUTINE lwvb_lmdar4(kuaer, ktraer, klim, pabcu, padjd, padju, pb, pbint, &
[5144]	4556	pbsui, pbsur, pbtop, pdisd, pdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &
	4557	pgatop, pgbtop, pcts, pfluc)
[1992]	4558	USE dimphy
	4559	IMPLICIT NONE
	4560	include "raddimlw.h"
	4561	include "radopt.h"
	4562
	4563	! -----------------------------------------------------------------------
	4564	! PURPOSE.
	4565	! --------
	4566	! INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
	4567	! INTEGRATION
	4568
	4569	! METHOD.
	4570	! -------
	4571
	4572	! 1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
	4573	! ATMOSPHERE
	4574	! 2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
	4575	! TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
	4576	! 3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
	4577
	4578	! REFERENCE.
	4579	! ----------
	4580
	4581	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	4582	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	4583
	4584	! AUTHOR.
	4585	! -------
	4586	! JEAN-JACQUES MORCRETTE ECMWF
	4587
	4588	! MODIFICATIONS.
	4589	! --------------
	4590	! ORIGINAL : 89-07-14
	4591	! Voigt lines (loop 2413 to 2427) - JJM & PhD - 01/96
	4592	! -----------------------------------------------------------------------
	4593
	4594	! * 0.1 ARGUMENTS
	4595	! ---------
	4596
	4597	INTEGER kuaer, ktraer, klim
	4598
[5144]	4599	REAL (KIND = 8) pabcu(kdlon, nua, 3 * kflev + 1) ! ABSORBER AMOUNTS
	4600	REAL (KIND = 8) padjd(kdlon, kflev + 1) ! CONTRIBUTION BY ADJACENT LAYERS
	4601	REAL (KIND = 8) padju(kdlon, kflev + 1) ! CONTRIBUTION BY ADJACENT LAYERS
	4602	REAL (KIND = 8) pb(kdlon, ninter, kflev + 1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
	4603	REAL (KIND = 8) pbint(kdlon, kflev + 1) ! HALF-LEVEL PLANCK FUNCTIONS
	4604	REAL (KIND = 8) pbsur(kdlon, ninter) ! SPECTRAL SURFACE PLANCK FUNCTION
	4605	REAL (KIND = 8) pbsui(kdlon) ! SURFACE PLANCK FUNCTION
	4606	REAL (KIND = 8) pbtop(kdlon, ninter) ! SPECTRAL T.O.A. PLANCK FUNCTION
	4607	REAL (KIND = 8) pdisd(kdlon, kflev + 1) ! CONTRIBUTION BY DISTANT LAYERS
	4608	REAL (KIND = 8) pdisu(kdlon, kflev + 1) ! CONTRIBUTION BY DISTANT LAYERS
	4609	REAL (KIND = 8) pemis(kdlon) ! SURFACE EMISSIVITY
	4610	REAL (KIND = 8) ppmb(kdlon, kflev + 1) ! PRESSURE MB
	4611	REAL (KIND = 8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
	4612	REAL (KIND = 8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
	4613	REAL (KIND = 8) pgasur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
	4614	REAL (KIND = 8) pgbsur(kdlon, 8, 2) ! SURFACE PADE APPROXIMANTS
	4615	REAL (KIND = 8) pgatop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
	4616	REAL (KIND = 8) pgbtop(kdlon, 8, 2) ! T.O.A. PADE APPROXIMANTS
[1992]	4617
[5144]	4618	REAL (KIND = 8) pfluc(kdlon, 2, kflev + 1) ! CLEAR-SKY RADIATIVE FLUXES
	4619	REAL (KIND = 8) pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
[1992]	4620
	4621	! * LOCAL VARIABLES:
	4622
[5144]	4623	REAL (KIND = 8) zbgnd(kdlon)
	4624	REAL (KIND = 8) zfd(kdlon)
	4625	REAL (KIND = 8) zfn10(kdlon)
	4626	REAL (KIND = 8) zfu(kdlon)
	4627	REAL (KIND = 8) ztt(kdlon, ntra)
	4628	REAL (KIND = 8) ztt1(kdlon, ntra)
	4629	REAL (KIND = 8) ztt2(kdlon, ntra)
	4630	REAL (KIND = 8) zuu(kdlon, nua)
	4631	REAL (KIND = 8) zcnsol(kdlon)
	4632	REAL (KIND = 8) zcntop(kdlon)
[1992]	4633
	4634	INTEGER jk, jl, ja
	4635	INTEGER jstra, jstru
	4636	INTEGER ind1, ind2, ind3, ind4, in, jlim
[5144]	4637	REAL (KIND = 8) zctstr
[1992]	4638
	4639	! -----------------------------------------------------------------------
	4640
	4641	! * 1. INITIALIZATION
	4642	! --------------
	4643
	4644
	4645
	4646	! * 1.2 INITIALIZE TRANSMISSION FUNCTIONS
	4647	! ---------------------------------
	4648
	4649	DO ja = 1, ntra
	4650	DO jl = 1, kdlon
	4651	ztt(jl, ja) = 1.0
	4652	ztt1(jl, ja) = 1.0
	4653	ztt2(jl, ja) = 1.0
	4654	END DO
	4655	END DO
	4656
	4657	DO ja = 1, nua
	4658	DO jl = 1, kdlon
	4659	zuu(jl, ja) = 1.0
	4660	END DO
	4661	END DO
	4662
	4663	! ------------------------------------------------------------------
	4664
	4665	! * 2. VERTICAL INTEGRATION
	4666	! --------------------
	4667
	4668	ind1 = 0
	4669	ind3 = 0
	4670	ind4 = 1
	4671	ind2 = 1
	4672
	4673	! * 2.3 EXCHANGE WITH TOP OF THE ATMOSPHERE
	4674	! -----------------------------------
	4675
	4676	DO jk = 1, kflev
[5144]	4677	in = (jk - 1) * ng1p1 + 1
[1992]	4678
	4679	DO ja = 1, kuaer
	4680	DO jl = 1, kdlon
	4681	zuu(jl, ja) = pabcu(jl, ja, in)
	4682	END DO
	4683	END DO
	4684
[5144]	4685	CALL lwtt_lmdar4(pgatop(1, 1, 1), pgbtop(1, 1, 1), zuu, ztt)
[1992]	4686
	4687	DO jl = 1, kdlon
[5144]	4688	zcntop(jl) = pbtop(jl, 1) * ztt(jl, 1) * ztt(jl, 10) + &
	4689	pbtop(jl, 2) * ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11) + &
	4690	pbtop(jl, 3) * ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12) + &
	4691	pbtop(jl, 4) * ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13) + &
	4692	pbtop(jl, 5) * ztt(jl, 3) * ztt(jl, 14) + pbtop(jl, 6) * ztt(jl, 6) * ztt(jl, &
	4693	15)
[1992]	4694	zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
	4695	pfluc(jl, 2, jk) = zfd(jl)
	4696	END DO
	4697
	4698	END DO
	4699
	4700	jk = kflev + 1
[5144]	4701	in = (jk - 1) * ng1p1 + 1
[1992]	4702
	4703	DO jl = 1, kdlon
	4704	zcntop(jl) = pbtop(jl, 1) + pbtop(jl, 2) + pbtop(jl, 3) + pbtop(jl, 4) + &
[5144]	4705	pbtop(jl, 5) + pbtop(jl, 6)
[1992]	4706	zfd(jl) = zcntop(jl) - pbint(jl, jk) - pdisd(jl, jk) - padjd(jl, jk)
	4707	pfluc(jl, 2, jk) = zfd(jl)
	4708	END DO
	4709
	4710	! * 2.4 COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
	4711	! ---------------------------------------
	4712
	4713
	4714
	4715	! * 2.4.1 INITIALIZATION
	4716	! --------------
	4717
	4718	jlim = kflev
	4719
	4720	IF (.NOT. levoigt) THEN
	4721	DO jk = kflev, 1, -1
[5144]	4722	IF (ppmb(1, jk)<10.0) THEN
[1992]	4723	jlim = jk
[998]	4724	END IF
[1992]	4725	END DO
	4726	END IF
	4727	klim = jlim
	4728
	4729	IF (.NOT. levoigt) THEN
	4730	DO ja = 1, ktraer
	4731	DO jl = 1, kdlon
	4732	ztt1(jl, ja) = 1.0
	4733	END DO
	4734	END DO
	4735
	4736	! * 2.4.2 LOOP OVER LAYERS ABOVE 10 HPA
	4737	! -----------------------------
	4738
	4739	DO jstra = kflev, jlim, -1
[5144]	4740	jstru = (jstra - 1) * ng1p1 + 1
[1992]	4741
	4742	DO ja = 1, kuaer
	4743	DO jl = 1, kdlon
	4744	zuu(jl, ja) = pabcu(jl, ja, jstru)
	4745	END DO
	4746	END DO
	4747
[5144]	4748	CALL lwtt_lmdar4(pga(1, 1, 1, jstra), pgb(1, 1, 1, jstra), zuu, ztt)
[1992]	4749
	4750	DO jl = 1, kdlon
[5144]	4751	zctstr = (pb(jl, 1, jstra) + pb(jl, 1, jstra + 1)) * &
	4752	(ztt1(jl, 1) * ztt1(jl, 10) - ztt(jl, 1) * ztt(jl, 10)) + &
	4753	(pb(jl, 2, jstra) + pb(jl, 2, jstra + 1)) * (ztt1(jl, 2) * ztt1(jl, 7) * ztt1(jl, 11 &
	4754	) - ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11)) + (pb(jl, 3, jstra) + pb(jl, 3, jstra + 1 &
	4755	)) * (ztt1(jl, 4) * ztt1(jl, 8) * ztt1(jl, 12) - ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12 &
	4756	)) + (pb(jl, 4, jstra) + pb(jl, 4, jstra + 1)) * (ztt1(jl, 5) * ztt1(jl, 9) * ztt1(&
	4757	jl, 13) - ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13)) + (pb(jl, 5, jstra) + pb(jl, 5, &
	4758	jstra + 1)) * (ztt1(jl, 3) * ztt1(jl, 14) - ztt(jl, 3) * ztt(jl, 14)) + &
	4759	(pb(jl, 6, jstra) + pb(jl, 6, jstra + 1)) * (ztt1(jl, 6) * ztt1(jl, 15) - ztt(jl, 6) &
	4760	* ztt(jl, 15))
	4761	pcts(jl, jstra) = zctstr * 0.5
[1992]	4762	END DO
	4763	DO ja = 1, ktraer
	4764	DO jl = 1, kdlon
	4765	ztt1(jl, ja) = ztt(jl, ja)
	4766	END DO
	4767	END DO
	4768	END DO
	4769	END IF
	4770	! Mise a zero de securite pour PCTS en cas de LEVOIGT
	4771	IF (levoigt) THEN
	4772	DO jstra = 1, kflev
	4773	DO jl = 1, kdlon
	4774	pcts(jl, jstra) = 0.
	4775	END DO
	4776	END DO
	4777	END IF
	4778
	4779	! * 2.5 EXCHANGE WITH LOWER LIMIT
	4780	! -------------------------
	4781
	4782	DO jl = 1, kdlon
[5144]	4783	zbgnd(jl) = pbsui(jl) * pemis(jl) - (1. - pemis(jl)) * pfluc(jl, 2, 1) - &
	4784	pbint(jl, 1)
[1992]	4785	END DO
	4786
	4787	jk = 1
[5144]	4788	in = (jk - 1) * ng1p1 + 1
[1992]	4789
	4790	DO jl = 1, kdlon
	4791	zcnsol(jl) = pbsur(jl, 1) + pbsur(jl, 2) + pbsur(jl, 3) + pbsur(jl, 4) + &
[5144]	4792	pbsur(jl, 5) + pbsur(jl, 6)
	4793	zcnsol(jl) = zcnsol(jl) * zbgnd(jl) / pbsui(jl)
[1992]	4794	zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
	4795	pfluc(jl, 1, jk) = zfu(jl)
	4796	END DO
	4797
	4798	DO jk = 2, kflev + 1
[5144]	4799	in = (jk - 1) * ng1p1 + 1
[1992]	4800
	4801	DO ja = 1, kuaer
	4802	DO jl = 1, kdlon
	4803	zuu(jl, ja) = pabcu(jl, ja, 1) - pabcu(jl, ja, in)
	4804	END DO
	4805	END DO
	4806
[5144]	4807	CALL lwtt_lmdar4(pgasur(1, 1, 1), pgbsur(1, 1, 1), zuu, ztt)
[1992]	4808
	4809	DO jl = 1, kdlon
[5144]	4810	zcnsol(jl) = pbsur(jl, 1) * ztt(jl, 1) * ztt(jl, 10) + &
	4811	pbsur(jl, 2) * ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11) + &
	4812	pbsur(jl, 3) * ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12) + &
	4813	pbsur(jl, 4) * ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13) + &
	4814	pbsur(jl, 5) * ztt(jl, 3) * ztt(jl, 14) + pbsur(jl, 6) * ztt(jl, 6) * ztt(jl, &
	4815	15)
	4816	zcnsol(jl) = zcnsol(jl) * zbgnd(jl) / pbsui(jl)
[1992]	4817	zfu(jl) = zcnsol(jl) + pbint(jl, jk) - pdisu(jl, jk) - padju(jl, jk)
	4818	pfluc(jl, 1, jk) = zfu(jl)
	4819	END DO
	4820
	4821	END DO
	4822
	4823	! * 2.7 CLEAR-SKY FLUXES
	4824	! ----------------
	4825
	4826	IF (.NOT. levoigt) THEN
	4827	DO jl = 1, kdlon
	4828	zfn10(jl) = pfluc(jl, 1, jlim) + pfluc(jl, 2, jlim)
	4829	END DO
	4830	DO jk = jlim + 1, kflev + 1
	4831	DO jl = 1, kdlon
[5144]	4832	zfn10(jl) = zfn10(jl) + pcts(jl, jk - 1)
[1992]	4833	pfluc(jl, 1, jk) = zfn10(jl)
	4834	pfluc(jl, 2, jk) = 0.
	4835	END DO
	4836	END DO
	4837	END IF
	4838
	4839	! ------------------------------------------------------------------
	4840
	4841	END SUBROUTINE lwvb_lmdar4
	4842	SUBROUTINE lwvd_lmdar4(kuaer, ktraer, pabcu, pdbdt, pga, pgb, pcntrb, pdisd, &
[5144]	4843	pdisu)
[1992]	4844	USE dimphy
	4845	IMPLICIT NONE
	4846	include "raddimlw.h"
	4847
	4848	! -----------------------------------------------------------------------
	4849	! PURPOSE.
	4850	! --------
	4851	! CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS
	4852
	4853	! METHOD.
	4854	! -------
	4855
	4856	! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
	4857	! CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE
	4858
	4859	! REFERENCE.
	4860	! ----------
	4861
	4862	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	4863	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	4864
	4865	! AUTHOR.
	4866	! -------
	4867	! JEAN-JACQUES MORCRETTE ECMWF
	4868
	4869	! MODIFICATIONS.
	4870	! --------------
	4871	! ORIGINAL : 89-07-14
	4872	! -----------------------------------------------------------------------
	4873	! * ARGUMENTS:
	4874
	4875	INTEGER kuaer, ktraer
	4876
[5144]	4877	REAL (KIND = 8) pabcu(kdlon, nua, 3 * kflev + 1) ! ABSORBER AMOUNTS
	4878	REAL (KIND = 8) pdbdt(kdlon, ninter, kflev) ! LAYER PLANCK FUNCTION GRADIENT
	4879	REAL (KIND = 8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
	4880	REAL (KIND = 8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
[1992]	4881
[5144]	4882	REAL (KIND = 8) pcntrb(kdlon, kflev + 1, kflev + 1) ! ENERGY EXCHANGE MATRIX
	4883	REAL (KIND = 8) pdisd(kdlon, kflev + 1) ! CONTRIBUTION BY DISTANT LAYERS
	4884	REAL (KIND = 8) pdisu(kdlon, kflev + 1) ! CONTRIBUTION BY DISTANT LAYERS
[1992]	4885
	4886	! * LOCAL VARIABLES:
	4887
[5144]	4888	REAL (KIND = 8) zglayd(kdlon)
	4889	REAL (KIND = 8) zglayu(kdlon)
	4890	REAL (KIND = 8) ztt(kdlon, ntra)
	4891	REAL (KIND = 8) ztt1(kdlon, ntra)
	4892	REAL (KIND = 8) ztt2(kdlon, ntra)
[1992]	4893
	4894	INTEGER jl, jk, ja, ikp1, ikn, ikd1, jkj, ikd2
	4895	INTEGER ikjp1, ikm1, ikj, jlk, iku1, ijkl, iku2
	4896	INTEGER ind1, ind2, ind3, ind4, itt
[5144]	4897	REAL (KIND = 8) zww, zdzxdg, zdzxmg
[1992]	4898
	4899	! * 1. INITIALIZATION
	4900	! --------------
	4901
	4902
	4903	! * 1.1 INITIALIZE LAYER CONTRIBUTIONS
	4904	! ------------------------------
	4905
	4906	DO jk = 1, kflev + 1
	4907	DO jl = 1, kdlon
	4908	pdisd(jl, jk) = 0.
	4909	pdisu(jl, jk) = 0.
	4910	END DO
	4911	END DO
	4912
	4913	! * 1.2 INITIALIZE TRANSMISSION FUNCTIONS
	4914	! ---------------------------------
	4915
	4916	DO ja = 1, ntra
	4917	DO jl = 1, kdlon
	4918	ztt(jl, ja) = 1.0
	4919	ztt1(jl, ja) = 1.0
	4920	ztt2(jl, ja) = 1.0
	4921	END DO
	4922	END DO
	4923
	4924	! ------------------------------------------------------------------
	4925
	4926	! * 2. VERTICAL INTEGRATION
	4927	! --------------------
	4928
	4929	ind1 = 0
	4930	ind3 = 0
	4931	ind4 = 1
	4932	ind2 = 1
	4933
	4934	! * 2.2 CONTRIBUTION FROM DISTANT LAYERS
	4935	! ---------------------------------
	4936
	4937
	4938
	4939	! * 2.2.1 DISTANT AND ABOVE LAYERS
	4940	! ------------------------
	4941
	4942
	4943
	4944
	4945	! * 2.2.2 FIRST UPPER LEVEL
	4946	! -----------------
	4947
	4948	DO jk = 1, kflev - 1
	4949	ikp1 = jk + 1
[5144]	4950	ikn = (jk - 1) * ng1p1 + 1
	4951	ikd1 = jk * ng1p1 + 1
[1992]	4952
[5144]	4953	CALL lwttm_lmdar4(pga(1, 1, 1, jk), pgb(1, 1, 1, jk), pabcu(1, 1, ikn), &
	4954	pabcu(1, 1, ikd1), ztt1)
[1992]	4955
	4956	! * 2.2.3 HIGHER UP
	4957	! ---------
	4958
	4959	itt = 1
	4960	DO jkj = ikp1, kflev
	4961	IF (itt==1) THEN
	4962	itt = 2
	4963	ELSE
	4964	itt = 1
[998]	4965	END IF
[1992]	4966	ikjp1 = jkj + 1
[5144]	4967	ikd2 = jkj * ng1p1 + 1
[998]	4968
[1992]	4969	IF (itt==1) THEN
[5144]	4970	CALL lwttm_lmdar4(pga(1, 1, 1, jkj), pgb(1, 1, 1, jkj), pabcu(1, 1, ikn), &
	4971	pabcu(1, 1, ikd2), ztt1)
[998]	4972	ELSE
[5144]	4973	CALL lwttm_lmdar4(pga(1, 1, 1, jkj), pgb(1, 1, 1, jkj), pabcu(1, 1, ikn), &
	4974	pabcu(1, 1, ikd2), ztt2)
[998]	4975	END IF
[1992]	4976
	4977	DO ja = 1, ktraer
	4978	DO jl = 1, kdlon
[5144]	4979	ztt(jl, ja) = (ztt1(jl, ja) + ztt2(jl, ja)) * 0.5
[1992]	4980	END DO
	4981	END DO
	4982
	4983	DO jl = 1, kdlon
[5144]	4984	zww = pdbdt(jl, 1, jkj) * ztt(jl, 1) * ztt(jl, 10) + &
	4985	pdbdt(jl, 2, jkj) * ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11) + &
	4986	pdbdt(jl, 3, jkj) * ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12) + &
	4987	pdbdt(jl, 4, jkj) * ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13) + &
	4988	pdbdt(jl, 5, jkj) * ztt(jl, 3) * ztt(jl, 14) + &
	4989	pdbdt(jl, 6, jkj) * ztt(jl, 6) * ztt(jl, 15)
[1992]	4990	zglayd(jl) = zww
	4991	zdzxdg = zglayd(jl)
	4992	pdisd(jl, jk) = pdisd(jl, jk) + zdzxdg
	4993	pcntrb(jl, jk, ikjp1) = zdzxdg
	4994	END DO
	4995
	4996	END DO
	4997	END DO
	4998
	4999	! * 2.2.4 DISTANT AND BELOW LAYERS
	5000	! ------------------------
	5001
	5002
	5003
	5004
	5005	! * 2.2.5 FIRST LOWER LEVEL
	5006	! -----------------
	5007
	5008	DO jk = 3, kflev + 1
[5144]	5009	ikn = (jk - 1) * ng1p1 + 1
[1992]	5010	ikm1 = jk - 1
	5011	ikj = jk - 2
[5144]	5012	iku1 = ikj * ng1p1 + 1
[1992]	5013
[5144]	5014	CALL lwttm_lmdar4(pga(1, 1, 1, ikj), pgb(1, 1, 1, ikj), pabcu(1, 1, iku1), &
	5015	pabcu(1, 1, ikn), ztt1)
[1992]	5016
	5017	! * 2.2.6 DOWN BELOW
	5018	! ----------
	5019
	5020	itt = 1
	5021	DO jlk = 1, ikj
	5022	IF (itt==1) THEN
	5023	itt = 2
[998]	5024	ELSE
[1992]	5025	itt = 1
[998]	5026	END IF
[1992]	5027	ijkl = ikm1 - jlk
[5144]	5028	iku2 = (ijkl - 1) * ng1p1 + 1
[1992]	5029
	5030	IF (itt==1) THEN
[5144]	5031	CALL lwttm_lmdar4(pga(1, 1, 1, ijkl), pgb(1, 1, 1, ijkl), pabcu(1, 1, iku2), &
	5032	pabcu(1, 1, ikn), ztt1)
[998]	5033	ELSE
[5144]	5034	CALL lwttm_lmdar4(pga(1, 1, 1, ijkl), pgb(1, 1, 1, ijkl), pabcu(1, 1, iku2), &
	5035	pabcu(1, 1, ikn), ztt2)
[998]	5036	END IF
[1279]	5037
[1992]	5038	DO ja = 1, ktraer
	5039	DO jl = 1, kdlon
[5144]	5040	ztt(jl, ja) = (ztt1(jl, ja) + ztt2(jl, ja)) * 0.5
[1992]	5041	END DO
	5042	END DO
[1279]	5043
[1992]	5044	DO jl = 1, kdlon
[5144]	5045	zww = pdbdt(jl, 1, ijkl) * ztt(jl, 1) * ztt(jl, 10) + &
	5046	pdbdt(jl, 2, ijkl) * ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11) + &
	5047	pdbdt(jl, 3, ijkl) * ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12) + &
	5048	pdbdt(jl, 4, ijkl) * ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13) + &
	5049	pdbdt(jl, 5, ijkl) * ztt(jl, 3) * ztt(jl, 14) + &
	5050	pdbdt(jl, 6, ijkl) * ztt(jl, 6) * ztt(jl, 15)
[1992]	5051	zglayu(jl) = zww
	5052	zdzxmg = zglayu(jl)
	5053	pdisu(jl, jk) = pdisu(jl, jk) + zdzxmg
	5054	pcntrb(jl, jk, ijkl) = zdzxmg
	5055	END DO
	5056
	5057	END DO
	5058	END DO
	5059
	5060	END SUBROUTINE lwvd_lmdar4
	5061	SUBROUTINE lwvn_lmdar4(kuaer, ktraer, pabcu, pdbsl, pga, pgb, padjd, padju, &
[5144]	5062	pcntrb, pdbdt)
[1992]	5063	USE dimphy
	5064	USE radiation_ar4_param, ONLY: wg1
	5065	IMPLICIT NONE
	5066	include "raddimlw.h"
	5067
	5068	! -----------------------------------------------------------------------
	5069	! PURPOSE.
	5070	! --------
	5071	! CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
	5072	! TO GIVE LONGWAVE FLUXES OR RADIANCES
	5073
	5074	! METHOD.
	5075	! -------
	5076
	5077	! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
	5078	! CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
	5079
	5080	! REFERENCE.
	5081	! ----------
	5082
	5083	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5084	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5085
	5086	! AUTHOR.
	5087	! -------
	5088	! JEAN-JACQUES MORCRETTE ECMWF
	5089
	5090	! MODIFICATIONS.
	5091	! --------------
	5092	! ORIGINAL : 89-07-14
	5093	! -----------------------------------------------------------------------
	5094
	5095	! * ARGUMENTS:
	5096
	5097	INTEGER kuaer, ktraer
	5098
[5144]	5099	REAL (KIND = 8) pabcu(kdlon, nua, 3 * kflev + 1) ! ABSORBER AMOUNTS
	5100	REAL (KIND = 8) pdbsl(kdlon, ninter, kflev * 2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
	5101	REAL (KIND = 8) pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
	5102	REAL (KIND = 8) pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
[1992]	5103
[5144]	5104	REAL (KIND = 8) padjd(kdlon, kflev + 1) ! CONTRIBUTION OF ADJACENT LAYERS
	5105	REAL (KIND = 8) padju(kdlon, kflev + 1) ! CONTRIBUTION OF ADJACENT LAYERS
	5106	REAL (KIND = 8) pcntrb(kdlon, kflev + 1, kflev + 1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
	5107	REAL (KIND = 8) pdbdt(kdlon, ninter, kflev) ! LAYER PLANCK FUNCTION GRADIENT
[1992]	5108
	5109	! * LOCAL ARRAYS:
	5110
[5144]	5111	REAL (KIND = 8) zglayd(kdlon)
	5112	REAL (KIND = 8) zglayu(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)
[1992]	5117
	5118	INTEGER jk, jl, ja, im12, ind, inu, ixu, jg
	5119	INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu
[5144]	5120	REAL (KIND = 8) zwtr
[1992]	5121
	5122	! -----------------------------------------------------------------------
	5123
	5124	! * 1. INITIALIZATION
	5125	! --------------
	5126
	5127
	5128	! * 1.1 INITIALIZE LAYER CONTRIBUTIONS
	5129	! ------------------------------
	5130
	5131	DO jk = 1, kflev + 1
	5132	DO jl = 1, kdlon
	5133	padjd(jl, jk) = 0.
	5134	padju(jl, jk) = 0.
	5135	END DO
	5136	END DO
	5137
	5138	! * 1.2 INITIALIZE TRANSMISSION FUNCTIONS
	5139	! ---------------------------------
	5140
	5141	DO ja = 1, ntra
	5142	DO jl = 1, kdlon
	5143	ztt(jl, ja) = 1.0
	5144	ztt1(jl, ja) = 1.0
	5145	ztt2(jl, ja) = 1.0
	5146	END DO
	5147	END DO
	5148
	5149	DO ja = 1, nua
	5150	DO jl = 1, kdlon
	5151	zuu(jl, ja) = 0.
	5152	END DO
	5153	END DO
	5154
	5155	! ------------------------------------------------------------------
	5156
	5157	! * 2. VERTICAL INTEGRATION
	5158	! --------------------
	5159
	5160
	5161
	5162	! * 2.1 CONTRIBUTION FROM ADJACENT LAYERS
	5163	! ---------------------------------
	5164
	5165	DO jk = 1, kflev
	5166	! * 2.1.1 DOWNWARD LAYERS
	5167	! ---------------
	5168
[5144]	5169	im12 = 2 * (jk - 1)
	5170	ind = (jk - 1) * ng1p1 + 1
[1992]	5171	ixd = ind
[5144]	5172	inu = jk * ng1p1 + 1
[1992]	5173	ixu = ind
	5174
	5175	DO jl = 1, kdlon
	5176	zglayd(jl) = 0.
	5177	zglayu(jl) = 0.
	5178	END DO
	5179
	5180	DO jg = 1, ng1
	5181	ibs = im12 + jg
	5182	idd = ixd + jg
	5183	DO ja = 1, kuaer
	5184	DO jl = 1, kdlon
	5185	zuu(jl, ja) = pabcu(jl, ja, ind) - pabcu(jl, ja, idd)
	5186	END DO
	5187	END DO
	5188
[5144]	5189	CALL lwtt_lmdar4(pga(1, 1, 1, jk), pgb(1, 1, 1, jk), zuu, ztt)
[1992]	5190
	5191	DO jl = 1, kdlon
[5144]	5192	zwtr = pdbsl(jl, 1, ibs) * ztt(jl, 1) * ztt(jl, 10) + &
	5193	pdbsl(jl, 2, ibs) * ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11) + &
	5194	pdbsl(jl, 3, ibs) * ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12) + &
	5195	pdbsl(jl, 4, ibs) * ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13) + &
	5196	pdbsl(jl, 5, ibs) * ztt(jl, 3) * ztt(jl, 14) + &
	5197	pdbsl(jl, 6, ibs) * ztt(jl, 6) * ztt(jl, 15)
	5198	zglayd(jl) = zglayd(jl) + zwtr * wg1(jg)
[1992]	5199	END DO
	5200
	5201	! * 2.1.2 DOWNWARD LAYERS
	5202	! ---------------
	5203
	5204	imu = ixu + jg
	5205	DO ja = 1, kuaer
	5206	DO jl = 1, kdlon
	5207	zuu(jl, ja) = pabcu(jl, ja, imu) - pabcu(jl, ja, inu)
	5208	END DO
	5209	END DO
	5210
[5144]	5211	CALL lwtt_lmdar4(pga(1, 1, 1, jk), pgb(1, 1, 1, jk), zuu, ztt)
[1992]	5212
	5213	DO jl = 1, kdlon
[5144]	5214	zwtr = pdbsl(jl, 1, ibs) * ztt(jl, 1) * ztt(jl, 10) + &
	5215	pdbsl(jl, 2, ibs) * ztt(jl, 2) * ztt(jl, 7) * ztt(jl, 11) + &
	5216	pdbsl(jl, 3, ibs) * ztt(jl, 4) * ztt(jl, 8) * ztt(jl, 12) + &
	5217	pdbsl(jl, 4, ibs) * ztt(jl, 5) * ztt(jl, 9) * ztt(jl, 13) + &
	5218	pdbsl(jl, 5, ibs) * ztt(jl, 3) * ztt(jl, 14) + &
	5219	pdbsl(jl, 6, ibs) * ztt(jl, 6) * ztt(jl, 15)
	5220	zglayu(jl) = zglayu(jl) + zwtr * wg1(jg)
[1992]	5221	END DO
	5222
	5223	END DO
	5224
	5225	DO jl = 1, kdlon
	5226	padjd(jl, jk) = zglayd(jl)
[5144]	5227	pcntrb(jl, jk, jk + 1) = zglayd(jl)
	5228	padju(jl, jk + 1) = zglayu(jl)
	5229	pcntrb(jl, jk + 1, jk) = zglayu(jl)
[1992]	5230	pcntrb(jl, jk, jk) = 0.0
	5231	END DO
	5232
	5233	END DO
	5234
	5235	DO jk = 1, kflev
[5144]	5236	jk2 = 2 * jk
[1992]	5237	jk1 = jk2 - 1
	5238	DO jnu = 1, ninter
	5239	DO jl = 1, kdlon
	5240	pdbdt(jl, jnu, jk) = pdbsl(jl, jnu, jk1) + pdbsl(jl, jnu, jk2)
	5241	END DO
	5242	END DO
	5243	END DO
	5244
	5245	END SUBROUTINE lwvn_lmdar4
	5246	SUBROUTINE lwtt_lmdar4(pga, pgb, puu, ptt)
	5247	USE dimphy
	5248	IMPLICIT NONE
	5249	include "raddimlw.h"
	5250
	5251	! -----------------------------------------------------------------------
	5252	! PURPOSE.
	5253	! --------
	5254	! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	5255	! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
	5256	! INTERVALS.
	5257
	5258	! METHOD.
	5259	! -------
	5260
	5261	! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
	5262	! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
	5263	! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
	5264	! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
	5265	! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
	5266
	5267	! REFERENCE.
	5268	! ----------
	5269
	5270	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5271	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5272
	5273	! AUTHOR.
	5274	! -------
	5275	! JEAN-JACQUES MORCRETTE ECMWF
	5276
	5277	! MODIFICATIONS.
	5278	! --------------
	5279	! ORIGINAL : 88-12-15
	5280
	5281	! -----------------------------------------------------------------------
[5144]	5282	REAL (KIND = 8) o1h, o2h
	5283	PARAMETER (o1h = 2230.)
	5284	PARAMETER (o2h = 100.)
	5285	REAL (KIND = 8) rpialf0
	5286	PARAMETER (rpialf0 = 2.0)
[1992]	5287
	5288	! * ARGUMENTS:
	5289
[5144]	5290	REAL (KIND = 8) puu(kdlon, nua)
	5291	REAL (KIND = 8) ptt(kdlon, ntra)
	5292	REAL (KIND = 8) pga(kdlon, 8, 2)
	5293	REAL (KIND = 8) pgb(kdlon, 8, 2)
[1992]	5294
	5295	! * LOCAL VARIABLES:
	5296
[5144]	5297	REAL (KIND = 8) zz, zxd, zxn
	5298	REAL (KIND = 8) zpu, zpu10, zpu11, zpu12, zpu13
	5299	REAL (KIND = 8) zeu, zeu10, zeu11, zeu12, zeu13
	5300	REAL (KIND = 8) zx, zy, zsq1, zsq2, zvxy, zuxy
	5301	REAL (KIND = 8) zaercn, zto1, zto2, zxch4, zych4, zxn2o, zyn2o
	5302	REAL (KIND = 8) zsqn21, zodn21, zsqh42, zodh42
	5303	REAL (KIND = 8) zsqh41, zodh41, zsqn22, zodn22, zttf11, zttf12
	5304	REAL (KIND = 8) zuu11, zuu12, za11, za12
[1992]	5305	INTEGER jl, ja
	5306
	5307	! ------------------------------------------------------------------
	5308
	5309	! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
	5310	! -----------------------------------------------
	5311
	5312
	5313
	5314	! cdir collapse
	5315	DO ja = 1, 8
	5316	DO jl = 1, kdlon
[5144]	5317	zz = sqrt(puu(jl, ja))
[1992]	5318	! ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
	5319	! ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
	5320	! PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
[5144]	5321	zxd = pgb(jl, ja, 1) + zz * (pgb(jl, ja, 2) + zz)
	5322	zxn = pga(jl, ja, 1) + zz * (pga(jl, ja, 2))
	5323	ptt(jl, ja) = zxn / zxd
[1992]	5324	END DO
	5325	END DO
	5326
	5327	! ------------------------------------------------------------------
	5328
	5329	! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
	5330	! ---------------------------------------------------
	5331
	5332	DO jl = 1, kdlon
	5333	ptt(jl, 9) = ptt(jl, 8)
	5334
	5335	! - CONTINUUM ABSORPTION: E- AND P-TYPE
	5336
[5144]	5337	zpu = 0.002 * puu(jl, 10)
	5338	zpu10 = 112. * zpu
	5339	zpu11 = 6.25 * zpu
	5340	zpu12 = 5.00 * zpu
	5341	zpu13 = 80.0 * zpu
[1992]	5342	zeu = puu(jl, 11)
[5144]	5343	zeu10 = 12. * zeu
	5344	zeu11 = 6.25 * zeu
	5345	zeu12 = 5.00 * zeu
	5346	zeu13 = 80.0 * zeu
[1992]	5347
	5348	! - OZONE ABSORPTION
	5349
	5350	zx = puu(jl, 12)
	5351	zy = puu(jl, 13)
[5144]	5352	zuxy = 4. * zx * zx / (rpialf0 * zy)
	5353	zsq1 = sqrt(1. + o1h * zuxy) - 1.
	5354	zsq2 = sqrt(1. + o2h * zuxy) - 1.
	5355	zvxy = rpialf0 * zy / (2. * zx)
[1992]	5356	zaercn = puu(jl, 17) + zeu12 + zpu12
[5144]	5357	zto1 = exp(-zvxy * zsq1 - zaercn)
	5358	zto2 = exp(-zvxy * zsq2 - zaercn)
[1992]	5359
	5360	! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
	5361
	5362	! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
	5363
	5364	! NEXOTIC=1
	5365	! IF (NEXOTIC.EQ.1) THEN
	5366	zxch4 = puu(jl, 19)
	5367	zych4 = puu(jl, 20)
[5144]	5368	zuxy = 4. * zxch4 * zxch4 / (0.103 * zych4)
	5369	zsqh41 = sqrt(1. + 33.7 * zuxy) - 1.
	5370	zvxy = 0.103 * zych4 / (2. * zxch4)
	5371	zodh41 = zvxy * zsqh41
[1992]	5372
	5373	! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
	5374
	5375	zxn2o = puu(jl, 21)
	5376	zyn2o = puu(jl, 22)
[5144]	5377	zuxy = 4. * zxn2o * zxn2o / (0.416 * zyn2o)
	5378	zsqn21 = sqrt(1. + 21.3 * zuxy) - 1.
	5379	zvxy = 0.416 * zyn2o / (2. * zxn2o)
	5380	zodn21 = zvxy * zsqn21
[1992]	5381
	5382	! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
	5383
[5144]	5384	zuxy = 4. * zxch4 * zxch4 / (0.113 * zych4)
	5385	zsqh42 = sqrt(1. + 400. * zuxy) - 1.
	5386	zvxy = 0.113 * zych4 / (2. * zxch4)
	5387	zodh42 = zvxy * zsqh42
[1992]	5388
	5389	! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
	5390
[5144]	5391	zuxy = 4. * zxn2o * zxn2o / (0.197 * zyn2o)
	5392	zsqn22 = sqrt(1. + 2000. * zuxy) - 1.
	5393	zvxy = 0.197 * zyn2o / (2. * zxn2o)
	5394	zodn22 = zvxy * zsqn22
[1992]	5395
	5396	! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
	5397
[5144]	5398	za11 = 2. * puu(jl, 23) * 4.404E+05
	5399	zttf11 = 1. - za11 * 0.003225
[1992]	5400
	5401	! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
	5402
[5144]	5403	za12 = 2. * puu(jl, 24) * 6.7435E+05
	5404	zttf12 = 1. - za12 * 0.003225
[1992]	5405
	5406	zuu11 = -puu(jl, 15) - zeu10 - zpu10
	5407	zuu12 = -puu(jl, 16) - zeu11 - zpu11 - zodh41 - zodn21
[5144]	5408	ptt(jl, 10) = exp(-puu(jl, 14))
[1992]	5409	ptt(jl, 11) = exp(zuu11)
[5144]	5410	ptt(jl, 12) = exp(zuu12) * zttf11 * zttf12
	5411	ptt(jl, 13) = 0.7554 * zto1 + 0.2446 * zto2
	5412	ptt(jl, 14) = ptt(jl, 10) * exp(-zeu13 - zpu13)
	5413	ptt(jl, 15) = exp(-puu(jl, 14) - zodh42 - zodn22)
[1992]	5414	END DO
	5415
	5416	END SUBROUTINE lwtt_lmdar4
	5417	SUBROUTINE lwttm_lmdar4(pga, pgb, puu1, puu2, ptt)
	5418	USE dimphy
	5419	IMPLICIT NONE
	5420	include "raddimlw.h"
	5421
	5422	! ------------------------------------------------------------------
	5423	! PURPOSE.
	5424	! --------
	5425	! THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
	5426	! ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
	5427	! INTERVALS.
	5428
	5429	! METHOD.
	5430	! -------
	5431
	5432	! 1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
	5433	! COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
	5434	! 2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
	5435	! 3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
	5436	! A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
	5437
	5438	! REFERENCE.
	5439	! ----------
	5440
	5441	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
	5442	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
	5443
	5444	! AUTHOR.
	5445	! -------
	5446	! JEAN-JACQUES MORCRETTE ECMWF
	5447
	5448	! MODIFICATIONS.
	5449	! --------------
	5450	! ORIGINAL : 88-12-15
	5451
	5452	! -----------------------------------------------------------------------
[5144]	5453	REAL (KIND = 8) o1h, o2h
	5454	PARAMETER (o1h = 2230.)
	5455	PARAMETER (o2h = 100.)
	5456	REAL (KIND = 8) rpialf0
	5457	PARAMETER (rpialf0 = 2.0)
[1992]	5458
	5459	! * ARGUMENTS:
	5460
[5144]	5461	REAL (KIND = 8) pga(kdlon, 8, 2) ! PADE APPROXIMANTS
	5462	REAL (KIND = 8) pgb(kdlon, 8, 2) ! PADE APPROXIMANTS
	5463	REAL (KIND = 8) puu1(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 1
	5464	REAL (KIND = 8) puu2(kdlon, nua) ! ABSORBER AMOUNTS FROM TOP TO LEVEL 2
	5465	REAL (KIND = 8) ptt(kdlon, ntra) ! TRANSMISSION FUNCTIONS
[1992]	5466
	5467	! * LOCAL VARIABLES:
	5468
	5469	INTEGER ja, jl
[5144]	5470	REAL (KIND = 8) zz, zxd, zxn
	5471	REAL (KIND = 8) zpu, zpu10, zpu11, zpu12, zpu13
	5472	REAL (KIND = 8) zeu, zeu10, zeu11, zeu12, zeu13
	5473	REAL (KIND = 8) zx, zy, zuxy, zsq1, zsq2, zvxy, zaercn, zto1, zto2
	5474	REAL (KIND = 8) zxch4, zych4, zsqh41, zodh41
	5475	REAL (KIND = 8) zxn2o, zyn2o, zsqn21, zodn21, zsqh42, zodh42
	5476	REAL (KIND = 8) zsqn22, zodn22, za11, zttf11, za12, zttf12
	5477	REAL (KIND = 8) zuu11, zuu12
[1992]	5478
	5479	! ------------------------------------------------------------------
	5480
	5481	! * 1. HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
	5482	! -----------------------------------------------
	5483
	5484
	5485
	5486
	5487	! CDIR ON_ADB(PUU1)
	5488	! CDIR ON_ADB(PUU2)
	5489	! CDIR COLLAPSE
	5490	DO ja = 1, 8
	5491	DO jl = 1, kdlon
[5144]	5492	zz = sqrt(puu1(jl, ja) - puu2(jl, ja))
	5493	zxd = pgb(jl, ja, 1) + zz * (pgb(jl, ja, 2) + zz)
	5494	zxn = pga(jl, ja, 1) + zz * (pga(jl, ja, 2))
	5495	ptt(jl, ja) = zxn / zxd
[1992]	5496	END DO
	5497	END DO
	5498
	5499	! ------------------------------------------------------------------
	5500
	5501	! * 2. CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
	5502	! ---------------------------------------------------
	5503
	5504	DO jl = 1, kdlon
	5505	ptt(jl, 9) = ptt(jl, 8)
	5506
	5507	! - CONTINUUM ABSORPTION: E- AND P-TYPE
	5508
[5144]	5509	zpu = 0.002 * (puu1(jl, 10) - puu2(jl, 10))
	5510	zpu10 = 112. * zpu
	5511	zpu11 = 6.25 * zpu
	5512	zpu12 = 5.00 * zpu
	5513	zpu13 = 80.0 * zpu
	5514	zeu = (puu1(jl, 11) - puu2(jl, 11))
	5515	zeu10 = 12. * zeu
	5516	zeu11 = 6.25 * zeu
	5517	zeu12 = 5.00 * zeu
	5518	zeu13 = 80.0 * zeu
[1992]	5519
	5520	! - OZONE ABSORPTION
	5521
[5144]	5522	zx = (puu1(jl, 12) - puu2(jl, 12))
	5523	zy = (puu1(jl, 13) - puu2(jl, 13))
	5524	zuxy = 4. * zx * zx / (rpialf0 * zy)
	5525	zsq1 = sqrt(1. + o1h * zuxy) - 1.
	5526	zsq2 = sqrt(1. + o2h * zuxy) - 1.
	5527	zvxy = rpialf0 * zy / (2. * zx)
	5528	zaercn = (puu1(jl, 17) - puu2(jl, 17)) + zeu12 + zpu12
	5529	zto1 = exp(-zvxy * zsq1 - zaercn)
	5530	zto2 = exp(-zvxy * zsq2 - zaercn)
[1992]	5531
	5532	! -- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
	5533
	5534	! * CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
	5535
[5144]	5536	zxch4 = (puu1(jl, 19) - puu2(jl, 19))
	5537	zych4 = (puu1(jl, 20) - puu2(jl, 20))
	5538	zuxy = 4. * zxch4 * zxch4 / (0.103 * zych4)
	5539	zsqh41 = sqrt(1. + 33.7 * zuxy) - 1.
	5540	zvxy = 0.103 * zych4 / (2. * zxch4)
	5541	zodh41 = zvxy * zsqh41
[1992]	5542
	5543	! * N2O IN INTERVAL 800-970 + 1110-1250 CM-1
	5544
[5144]	5545	zxn2o = (puu1(jl, 21) - puu2(jl, 21))
	5546	zyn2o = (puu1(jl, 22) - puu2(jl, 22))
	5547	zuxy = 4. * zxn2o * zxn2o / (0.416 * zyn2o)
	5548	zsqn21 = sqrt(1. + 21.3 * zuxy) - 1.
	5549	zvxy = 0.416 * zyn2o / (2. * zxn2o)
	5550	zodn21 = zvxy * zsqn21
[1992]	5551
	5552	! * CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
	5553
[5144]	5554	zuxy = 4. * zxch4 * zxch4 / (0.113 * zych4)
	5555	zsqh42 = sqrt(1. + 400. * zuxy) - 1.
	5556	zvxy = 0.113 * zych4 / (2. * zxch4)
	5557	zodh42 = zvxy * zsqh42
[1992]	5558
	5559	! * N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
	5560
[5144]	5561	zuxy = 4. * zxn2o * zxn2o / (0.197 * zyn2o)
	5562	zsqn22 = sqrt(1. + 2000. * zuxy) - 1.
	5563	zvxy = 0.197 * zyn2o / (2. * zxn2o)
	5564	zodn22 = zvxy * zsqn22
[1992]	5565
	5566	! * CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
	5567
[5144]	5568	za11 = (puu1(jl, 23) - puu2(jl, 23)) * 4.404E+05
	5569	zttf11 = 1. - za11 * 0.003225
[1992]	5570
	5571	! * CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
	5572
[5144]	5573	za12 = (puu1(jl, 24) - puu2(jl, 24)) * 6.7435E+05
	5574	zttf12 = 1. - za12 * 0.003225
[1992]	5575
[5144]	5576	zuu11 = -(puu1(jl, 15) - puu2(jl, 15)) - zeu10 - zpu10
	5577	zuu12 = -(puu1(jl, 16) - puu2(jl, 16)) - zeu11 - zpu11 - zodh41 - zodn21
	5578	ptt(jl, 10) = exp(-(puu1(jl, 14) - puu2(jl, 14)))
[1992]	5579	ptt(jl, 11) = exp(zuu11)
[5144]	5580	ptt(jl, 12) = exp(zuu12) * zttf11 * zttf12
	5581	ptt(jl, 13) = 0.7554 * zto1 + 0.2446 * zto2
	5582	ptt(jl, 14) = ptt(jl, 10) * exp(-zeu13 - zpu13)
	5583	ptt(jl, 15) = exp(-(puu1(jl, 14) - puu2(jl, 14)) - zodh42 - zodn22)
[1992]	5584	END DO
	5585
	5586	END SUBROUTINE lwttm_lmdar4

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

Download in other formats:

Original Format