Context Navigation

radlwsw.F90 @ 1664

Last change on this file since 1664 was 1664, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1575

Testing release based on r1575

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

File size: 18.2 KB

Rev	Line
[1263]	1	module radlwsw_m
	2
	3	IMPLICIT NONE
	4
	5	contains
	6
[1160]	7	SUBROUTINE radlwsw( &
[1159]	8	dist, rmu0, fract, &
	9	paprs, pplay,tsol,alb1, alb2, &
[1150]	10	t,q,wo,&
	11	cldfra, cldemi, cldtaupd,&
	12	ok_ade, ok_aie,&
	13	tau_aero, piz_aero, cg_aero,&
	14	cldtaupi, new_aod, &
[1159]	15	qsat, flwc, fiwc, &
[1150]	16	heat,heat0,cool,cool0,radsol,albpla,&
	17	topsw,toplw,solsw,sollw,&
	18	sollwdown,&
	19	topsw0,toplw0,solsw0,sollw0,&
	20	lwdn0, lwdn, lwup0, lwup,&
	21	swdn0, swdn, swup0, swup,&
	22	topswad_aero, solswad_aero,&
	23	topswai_aero, solswai_aero, &
	24	topswad0_aero, solswad0_aero,&
	25	topsw_aero, topsw0_aero,&
[1246]	26	solsw_aero, solsw0_aero, &
	27	topswcf_aero, solswcf_aero)
[524]	28
[1150]	29
	30
	31	USE DIMPHY
[1664]	32	USE assert_m, ONLY : assert
	33	USE infotrac, ONLY : type_trac
	34	#ifdef REPROBUS
	35	USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
	36	#endif
[1150]	37
	38	!======================================================================
	39	! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
	40	! Objet: interface entre le modele et les rayonnements
	41	! Arguments:
	42	! dist-----input-R- distance astronomique terre-soleil
	43	! rmu0-----input-R- cosinus de l'angle zenithal
	44	! fract----input-R- duree d'ensoleillement normalisee
	45	! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
	46	! paprs----input-R- pression a inter-couche (Pa)
	47	! pplay----input-R- pression au milieu de couche (Pa)
	48	! tsol-----input-R- temperature du sol (en K)
[1159]	49	! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible
	50	! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge
[1150]	51	! t--------input-R- temperature (K)
	52	! q--------input-R- vapeur d'eau (en kg/kg)
	53	! cldfra---input-R- fraction nuageuse (entre 0 et 1)
	54	! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
	55	! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
	56	! ok_ade---input-L- apply the Aerosol Direct Effect or not?
	57	! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
	58	! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
	59	! cldtaupi-input-R- epaisseur optique des nuages dans le visible
	60	! calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
	61	! droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
	62	! it is needed for the diagnostics of the aerosol indirect radiative forcing
	63	!
	64	! heat-----output-R- echauffement atmospherique (visible) (K/jour)
	65	! cool-----output-R- refroidissement dans l'IR (K/jour)
	66	! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
	67	! albpla---output-R- albedo planetaire (entre 0 et 1)
	68	! topsw----output-R- flux solaire net au sommet de l'atm.
	69	! toplw----output-R- ray. IR montant au sommet de l'atmosphere
	70	! solsw----output-R- flux solaire net a la surface
	71	! sollw----output-R- ray. IR montant a la surface
	72	! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
	73	! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
	74	! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
	75	! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
	76	!
	77	! ATTENTION: swai and swad have to be interpreted in the following manner:
	78	! ---------
	79	! ok_ade=F & ok_aie=F -both are zero
	80	! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
	81	! indirect is zero
	82	! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
	83	! direct is zero
	84	! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
	85	! aerosol direct forcing is F_{AD} = topswai-topswad
	86	!
	87
	88	!======================================================================
	89
	90	! ====================================================================
	91	! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009
	92	! 1 = ZERO
	93	! 2 = AER total
	94	! 3 = NAT
	95	! 4 = BC
	96	! 5 = SO4
	97	! 6 = POM
	98	! 7 = DUST
	99	! 8 = SS
	100	! 9 = NO3
	101	!
	102	! ====================================================================
	103	include "YOETHF.h"
	104	include "YOMCST.h"
[1159]	105	include "clesphys.h"
	106	include "iniprint.h"
[1150]	107
	108	! Input arguments
	109	REAL, INTENT(in) :: dist
	110	REAL, INTENT(in) :: rmu0(KLON), fract(KLON)
	111	REAL, INTENT(in) :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
[1159]	112	REAL, INTENT(in) :: alb1(KLON), alb2(KLON), tsol(KLON)
[1215]	113	REAL, INTENT(in) :: t(KLON,KLEV), q(KLON,KLEV)
	114
[1263]	115	REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2)
[1215]	116	! column-density of ozone in a layer, in kilo-Dobsons
[1263]	117	! "wo(:, :, 1)" is for the average day-night field,
	118	! "wo(:, :, 2)" is for daylight time.
[1215]	119
[1150]	120	LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not
	121	REAL, INTENT(in) :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
	122	REAL, INTENT(in) :: tau_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
	123	REAL, INTENT(in) :: piz_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
	124	REAL, INTENT(in) :: cg_aero(KLON,KLEV,9,2) ! aerosol optical properties (see aeropt.F)
	125	REAL, INTENT(in) :: cldtaupi(KLON,KLEV) ! cloud optical thickness for pre-industrial aerosol concentrations
	126	LOGICAL, INTENT(in) :: new_aod ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates
[1159]	127	REAL, INTENT(in) :: qsat(klon,klev) ! Variable pour iflag_rrtm=1
	128	REAL, INTENT(in) :: flwc(klon,klev) ! Variable pour iflag_rrtm=1
	129	REAL, INTENT(in) :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1
[1150]	130
	131	! Output arguments
	132	REAL, INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
	133	REAL, INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV)
	134	REAL, INTENT(out) :: radsol(KLON), topsw(KLON), toplw(KLON)
	135	REAL, INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
	136	REAL, INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
	137	REAL, INTENT(out) :: sollwdown(KLON)
	138	REAL, INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1)
	139	REAL, INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1)
	140	REAL, INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1)
	141	REAL, INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1)
	142	REAL, INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON) ! output: aerosol direct forcing at TOA and surface
	143	REAL, INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON) ! output: aerosol indirect forcing atTOA and surface
	144	REAL, DIMENSION(klon), INTENT(out) :: topswad0_aero
	145	REAL, DIMENSION(klon), INTENT(out) :: solswad0_aero
	146	REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero
	147	REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero
	148	REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero
	149	REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero
[1246]	150	REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero
	151	REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero
[1150]	152
	153	! Local variables
[1220]	154	REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
	155	REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
	156	REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
	157	REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
	158	REAL(KIND=8) ZFLUP(KDLON,KFLEV+1)
	159	REAL(KIND=8) ZFLDN(KDLON,KFLEV+1)
	160	REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1)
	161	REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1)
	162	REAL(KIND=8) zx_alpha1, zx_alpha2
[1150]	163	INTEGER k, kk, i, j, iof, nb_gr
[1220]	164	REAL(KIND=8) PSCT
	165	REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2)
	166	REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
	167	REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV)
	168	REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
	169	REAL(KIND=8) PTAVE(kdlon,kflev)
	170	REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
[1263]	171
	172	real(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
	173	! "POZON(:, :, 1)" is for the average day-night field,
	174	! "POZON(:, :, 2)" is for daylight time.
	175
[1220]	176	REAL(KIND=8) PAER(kdlon,kflev,5)
	177	REAL(KIND=8) PCLDLD(kdlon,kflev)
	178	REAL(KIND=8) PCLDLU(kdlon,kflev)
	179	REAL(KIND=8) PCLDSW(kdlon,kflev)
	180	REAL(KIND=8) PTAU(kdlon,2,kflev)
	181	REAL(KIND=8) POMEGA(kdlon,2,kflev)
	182	REAL(KIND=8) PCG(kdlon,2,kflev)
	183	REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist
	184	REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev)
	185	REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev)
	186	REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon)
	187	REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
	188	REAL(KIND=8) zsollwdown(kdlon)
	189	REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon)
	190	REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon)
	191	REAL(KIND=8) zznormcp
	192	REAL(KIND=8) tauaero(kdlon,kflev,9,2) ! aer opt properties
	193	REAL(KIND=8) pizaero(kdlon,kflev,9,2)
	194	REAL(KIND=8) cgaero(kdlon,kflev,9,2)
	195	REAL(KIND=8) PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
	196	REAL(KIND=8) POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo
	197	REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon) ! Aerosol direct forcing at TOAand surface
	198	REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon) ! Aerosol direct forcing at TOAand surface
	199	REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon) ! dito, indirect
	200	REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9)
	201	REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
[1246]	202	REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3)
[1215]	203	real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
[1150]	204
[1263]	205	call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
[1150]	206	! initialisation
	207	tauaero(:,:,:,:)=0.
	208	pizaero(:,:,:,:)=0.
	209	cgaero(:,:,:,:)=0.
	210
	211	!
	212	!-------------------------------------------
	213	nb_gr = KLON / kdlon
	214	IF (nb_gr*kdlon .NE. KLON) THEN
	215	PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr
	216	CALL abort
	217	ENDIF
	218	IF (kflev .NE. KLEV) THEN
	219	PRINT*, "kflev differe de KLEV, kflev, KLEV"
	220	CALL abort
	221	ENDIF
	222	!-------------------------------------------
	223	DO k = 1, KLEV
	224	DO i = 1, KLON
	225	heat(i,k)=0.
	226	cool(i,k)=0.
	227	heat0(i,k)=0.
	228	cool0(i,k)=0.
	229	ENDDO
	230	ENDDO
	231	!
	232	zdist = dist
	233	!
	234	PSCT = solaire/zdist/zdist
[1664]	235
	236	IF (type_trac == 'repr') THEN
	237	#ifdef REPROBUS
	238	if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
	239	print,'Constante solaire: ',PSCTzdist*zdist
	240	#endif
	241	END IF
	242
[1150]	243	DO j = 1, nb_gr
	244	iof = kdlon*(j-1)
	245	DO i = 1, kdlon
	246	zfract(i) = fract(iof+i)
	247	zrmu0(i) = rmu0(iof+i)
[1159]	248	PALBD(i,1) = alb1(iof+i)
	249	PALBD(i,2) = alb2(iof+i)
	250	PALBP(i,1) = alb1(iof+i)
	251	PALBP(i,2) = alb2(iof+i)
[1150]	252	PEMIS(i) = 1.0
	253	PVIEW(i) = 1.66
	254	PPSOL(i) = paprs(iof+i,1)
	255	zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2))
	256	zx_alpha2 = 1.0 - zx_alpha1
	257	PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
	258	PTL(i,KLEV+1) = t(iof+i,KLEV)
	259	PDT0(i) = tsol(iof+i) - PTL(i,1)
	260	ENDDO
	261	DO k = 2, kflev
[524]	262	DO i = 1, kdlon
[1150]	263	PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
[524]	264	ENDDO
[1150]	265	ENDDO
	266	DO k = 1, kflev
[524]	267	DO i = 1, kdlon
[1150]	268	PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
	269	PTAVE(i,k) = t(iof+i,k)
	270	PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
	271	PQS(i,k) = PWV(i,k)
[1263]	272	POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 &
[1231]	273	/ (paprs(iof+i, k) - paprs(iof+i, k+1))
[1150]	274	PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
	275	PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
	276	PCLDSW(i,k) = cldfra(iof+i,k)
	277	PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
	278	PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
	279	POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
	280	POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
	281	PCG(i,1,k) = 0.865
	282	PCG(i,2,k) = 0.910
	283	!-
	284	! Introduced for aerosol indirect forcings.
	285	! The following values use the cloud optical thickness calculated from
	286	! present-day aerosol concentrations whereas the quantities without the
	287	! "A" at the end are for pre-industial (natural-only) aerosol concentrations
	288	!
	289	PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
	290	PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
	291	POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
	292	POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
[524]	293	ENDDO
[1150]	294	ENDDO
[1664]	295
	296	IF (type_trac == 'repr') THEN
	297	#ifdef REPROBUS
	298	ndimozon = size(wo, 3)
	299	CALL RAD_INTERACTIF(POZON,iof)
	300	#endif
	301	END IF
	302
[1150]	303	!
	304	DO k = 1, kflev+1
[524]	305	DO i = 1, kdlon
[1150]	306	PPMB(i,k) = paprs(iof+i,k)/100.0
[524]	307	ENDDO
[1150]	308	ENDDO
	309	!
	310	DO kk = 1, 5
[524]	311	DO k = 1, kflev
[1150]	312	DO i = 1, kdlon
	313	PAER(i,k,kk) = 1.0E-15
	314	ENDDO
[524]	315	ENDDO
[1150]	316	ENDDO
	317	DO k = 1, kflev
[524]	318	DO i = 1, kdlon
[1150]	319	tauaero(i,k,:,1)=tau_aero(iof+i,k,:,1)
	320	pizaero(i,k,:,1)=piz_aero(iof+i,k,:,1)
	321	cgaero(i,k,:,1) =cg_aero(iof+i,k,:,1)
	322	tauaero(i,k,:,2)=tau_aero(iof+i,k,:,2)
	323	pizaero(i,k,:,2)=piz_aero(iof+i,k,:,2)
	324	cgaero(i,k,:,2) =cg_aero(iof+i,k,:,2)
[524]	325	ENDDO
[1150]	326	ENDDO
	327
[1159]	328	!
	329	!===== iflag_rrtm ================================================
	330	!
	331	IF (iflag_rrtm == 0) THEN
	332	! Old radiation scheme, used for AR4 runs
[1263]	333	! average day-night ozone for longwave
[1159]	334	CALL LW_LMDAR4(&
	335	PPMB, PDP,&
	336	PPSOL,PDT0,PEMIS,&
[1263]	337	PTL, PTAVE, PWV, POZON(:, :, 1), PAER,&
[1159]	338	PCLDLD,PCLDLU,&
	339	PVIEW,&
	340	zcool, zcool0,&
	341	ztoplw,zsollw,ztoplw0,zsollw0,&
	342	zsollwdown,&
	343	ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
[1150]	344
[1263]	345	! daylight ozone, if we have it, for short wave
[1159]	346	IF (.NOT. new_aod) THEN
	347	! use old version
	348	CALL SW_LMDAR4(PSCT, zrmu0, zfract,&
	349	PPMB, PDP, &
	350	PPSOL, PALBD, PALBP,&
[1263]	351	PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
[1159]	352	PCLDSW, PTAU, POMEGA, PCG,&
	353	zheat, zheat0,&
	354	zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
	355	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
	356	tau_aero(:,:,5,:), piz_aero(:,:,5,:), cg_aero(:,:,5,:),&
	357	PTAUA, POMEGAA,&
	358	ztopswadaero,zsolswadaero,&
	359	ztopswaiaero,zsolswaiaero,&
	360	ok_ade, ok_aie)
	361
	362	ELSE ! new_aod=T
	363	CALL SW_AEROAR4(PSCT, zrmu0, zfract,&
	364	PPMB, PDP,&
	365	PPSOL, PALBD, PALBP,&
[1263]	366	PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
[1159]	367	PCLDSW, PTAU, POMEGA, PCG,&
	368	zheat, zheat0,&
	369	zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
	370	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
	371	tauaero, pizaero, cgaero, &
	372	PTAUA, POMEGAA,&
	373	ztopswadaero,zsolswadaero,&
	374	ztopswad0aero,zsolswad0aero,&
	375	ztopswaiaero,zsolswaiaero, &
	376	ztopsw_aero,ztopsw0_aero,&
	377	zsolsw_aero,zsolsw0_aero,&
[1246]	378	ztopswcf_aero,zsolswcf_aero, &
[1159]	379	ok_ade, ok_aie)
	380
	381	ENDIF
	382
	383	ELSE
	384	!===== iflag_rrtm=1, on passe dans SW via RECMWFL ===============
	385	WRITE(lunout,*) "Option iflag_rrtm=T ne fonctionne pas encore !!!"
[1160]	386	CALL abort_gcm('radlwsw','iflag_rrtm=T not valid',1)
[1159]	387
	388	ENDIF ! iflag_rrtm
	389	!======================================================================
	390
[1150]	391	DO i = 1, kdlon
	392	radsol(iof+i) = zsolsw(i) + zsollw(i)
	393	topsw(iof+i) = ztopsw(i)
	394	toplw(iof+i) = ztoplw(i)
	395	solsw(iof+i) = zsolsw(i)
	396	sollw(iof+i) = zsollw(i)
	397	sollwdown(iof+i) = zsollwdown(i)
	398	DO k = 1, kflev+1
	399	lwdn0 ( iof+i,k) = ZFLDN0 ( i,k)
	400	lwdn ( iof+i,k) = ZFLDN ( i,k)
	401	lwup0 ( iof+i,k) = ZFLUP0 ( i,k)
	402	lwup ( iof+i,k) = ZFLUP ( i,k)
[524]	403	ENDDO
[1150]	404	topsw0(iof+i) = ztopsw0(i)
	405	toplw0(iof+i) = ztoplw0(i)
	406	solsw0(iof+i) = zsolsw0(i)
	407	sollw0(iof+i) = zsollw0(i)
	408	albpla(iof+i) = zalbpla(i)
[524]	409
[1150]	410	DO k = 1, kflev+1
	411	swdn0 ( iof+i,k) = ZFSDN0 ( i,k)
	412	swdn ( iof+i,k) = ZFSDN ( i,k)
	413	swup0 ( iof+i,k) = ZFSUP0 ( i,k)
	414	swup ( iof+i,k) = ZFSUP ( i,k)
[524]	415	ENDDO
[1150]	416	ENDDO
	417	!-transform the aerosol forcings, if they have
	418	! to be calculated
	419	IF (ok_ade) THEN
	420	DO i = 1, kdlon
	421	topswad_aero(iof+i) = ztopswadaero(i)
	422	topswad0_aero(iof+i) = ztopswad0aero(i)
	423	solswad_aero(iof+i) = zsolswadaero(i)
	424	solswad0_aero(iof+i) = zsolswad0aero(i)
[1246]	425	! MS the following lines seem to be wrong, why is iof on right hand side???
	426	! topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
	427	! topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
	428	! solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
	429	! solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
	430	topsw_aero(iof+i,:) = ztopsw_aero(i,:)
	431	topsw0_aero(iof+i,:) = ztopsw0_aero(i,:)
	432	solsw_aero(iof+i,:) = zsolsw_aero(i,:)
	433	solsw0_aero(iof+i,:) = zsolsw0_aero(i,:)
	434	topswcf_aero(iof+i,:) = ztopswcf_aero(i,:)
	435	solswcf_aero(iof+i,:) = zsolswcf_aero(i,:)
[1150]	436	ENDDO
	437	ELSE
	438	DO i = 1, kdlon
	439	topswad_aero(iof+i) = 0.0
	440	solswad_aero(iof+i) = 0.0
	441	topswad0_aero(iof+i) = 0.0
	442	solswad0_aero(iof+i) = 0.0
	443	topsw_aero(iof+i,:) = 0.
	444	topsw0_aero(iof+i,:) =0.
	445	solsw_aero(iof+i,:) = 0.
	446	solsw0_aero(iof+i,:) = 0.
	447	ENDDO
	448	ENDIF
	449	IF (ok_aie) THEN
	450	DO i = 1, kdlon
	451	topswai_aero(iof+i) = ztopswaiaero(i)
	452	solswai_aero(iof+i) = zsolswaiaero(i)
	453	ENDDO
	454	ELSE
	455	DO i = 1, kdlon
	456	topswai_aero(iof+i) = 0.0
	457	solswai_aero(iof+i) = 0.0
	458	ENDDO
	459	ENDIF
	460	DO k = 1, kflev
[524]	461	DO i = 1, kdlon
[1150]	462	! scale factor to take into account the difference between
	463	! dry air and watter vapour scpecifi! heat capacity
	464	zznormcp=1.0+RVTMP2*PWV(i,k)
	465	heat(iof+i,k) = zheat(i,k)/zznormcp
	466	cool(iof+i,k) = zcool(i,k)/zznormcp
	467	heat0(iof+i,k) = zheat0(i,k)/zznormcp
	468	cool0(iof+i,k) = zcool0(i,k)/zznormcp
[524]	469	ENDDO
[1150]	470	ENDDO
	471
[1159]	472	ENDDO ! j = 1, nb_gr
[1150]	473
[1160]	474	END SUBROUTINE radlwsw
[1150]	475
[1263]	476	end module radlwsw_m

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

Download in other formats:

Original Format