Context Navigation

radiation_AR4.F @ 1634

Last change on this file since 1634 was 1279, checked in by Laurent Fairhead, 15 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 182.0 KB

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

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

Download in other formats:

Original Format