Context Navigation

radiation_AR4.f90 @ 5409

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

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

Download in other formats:

Original Format