Context Navigation

radlwsw.F @ 1356

Last change on this file since 1356 was 1356, checked in by slebonnois, 10 years ago
SL: update to newstart/start2archive tools in Venus+Titan / additional diagnostics in radiative fluxes for Titan
File size: 6.2 KB

Line
1	SUBROUTINE radlwsw(dist, rmu0, fract, zzlev,
2	. paprs, pplay,tsol, pt, nq, nmicro, pq,qaer)
3	c
4	c======================================================================
5	c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
6	c Objet: interface entre le modele et les rayonnements
7	c Arguments:
8	c dist-----input-R- distance astronomique terre-soleil
9	c rmu0-----input-R- cosinus de l'angle zenithal
10	c fract----input-R- duree d'ensoleillement normalisee
11	c falbe----input-R- surface albedo
12	c zzlev----input-R- altitudes des inter-couches (m)
13	c paprs----input-R- pression a inter-couche (Pa)
14	c pplay----input-R- pression au milieu de couche (Pa)
15	c tsol-----input-R- temperature du sol (en K)
16	c t--------input-R- temperature (K)
17	c nq-------input-R- nombre de traceurs
18	c nmicro---input-R- nombre de traceurs microphysiques
19	c pq-------input-R- traceurs (rapports de melange)
20	c heat-----output-R- echauffement atmospherique (visible) (K/s)
21	c cool-----output-R- refroidissement dans l'IR (K/s)
22	c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
23	c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
24	c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
25	c solsw----output-R- flux solaire net a la surface (+ vers le bas)
26	c sollw----output-R- ray. IR net a la surface (+ vers le bas)
27	c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
28	c lwnet____output-R- flux IR net (+ vers le haut)
29	c swnet____output-R- flux solaire net (+ vers le bas)
30	c
31
32	c S. Lebonnois 05/2008
33	c VERSION TITAN
34
35	c======================================================================
36	use dimphy
37	USE comgeomphy
38	USE phys_state_var_mod, only: falbe,heat,cool,radsol,
39	. topsw,toplw,solsw,sollw,sollwdown,lwnet,swnet,
40	. lwup,lwdn,swup,swdn
41	USE write_field_phy
42	IMPLICIT none
43	#include "dimensions.h"
44	#include "YOMCST.h"
45	#include "clesphys.h"
46	c
47	c ARGUMENTS
48	INTEGER nq,nmicro
49	real rmu0(klon), fract(klon), dist
50	c
51	real zzlev(klon,klev+1),paprs(klon,klev+1), pplay(klon,klev)
52	real tsol(klon)
53	real pt(klon,klev)
54	real pq(klon,klev,nq)
55	REAL qaer(klon,klev,nq)
56	c
57	c LOCAL VARIABLES
58	integer i,k,l,iq
59	real zp(klon,klev+1),zt(klon,klev+1),zz(klon,klev+1)
60	real zq(klon,klev,nq)
61	real zheatc(klon,klev), zcoolc(klon,klev)
62	real zheatp(klon,klev), zcoolp(klon,klev)
63	REAL zswupc(klon,klev+1),zlwupc(klon,klev+1)
64	REAL zswupp(klon,klev+1),zlwupp(klon,klev+1)
65	REAL zswdnc(klon,klev+1),zlwdnc(klon,klev+1)
66	REAL zswdnp(klon,klev+1),zlwdnp(klon,klev+1)
67	REAL zsollwdownc(klon),zsollwdownp(klon)
68	INTEGER icld
69
70
71	c =======================================
72	c INITIALISATIONS
73	c =======================================
74
75	c passage au pressions en bar avec indice 1 au sommet.
76	do l=2,klev+1
77	do i=1,klon
78	zp(i,l)=paprs(i,klev+2-l)*1.e-5
79	enddo
80	enddo
81	do i=1,klon
82	zp(i,1)=zp(i,2)*.001
83	enddo
84
85	c call WriteField_phy('radlwsw_zp',zp,klev+1)
86
87	c =======================================
88	c altitudes (m) avec indice 1 en haut
89	do l=1,klev+1
90	do i=1,klon
91	zz(i,l)=zzlev(i,klev+2-l)
92	enddo
93	enddo
94
95	c temperatures avec indice 1 en haut
96	do l=1,klev
97	do i=1,klon
98	zt(i,l)=pt(i,klev+1-l)
99	enddo
100	enddo
101	do i=1,klon
102	zt(i,klev+1)=tsol(i)
103	enddo
104
105	c traceurs avec indice 1 en haut
106	do l=1,klev
107	do i=1,klon
108	do iq=1,nq
109	zq(i,l,iq)=pq(i,klev+1-l,iq)
110	enddo
111	enddo
112	enddo
113
114	c =======================================
115	c CALCUL DES TAU V+IR (dans des common...)
116	c =======================================
117
118	print*,'On calcule les opacites'
119
120	CALL radtitan(zp,nq,nmicro,zq,qaer)
121
122	c CALCUL DU SW
123	c =======================================
124
125	print*,'On calcule le rayonnement SW'
126
127	IF (clouds.eq.1) THEN
128	ICLD = 1 ! colonne avec nuages
129	CALL heating(dist,rmu0,fract,falbe,zheatc,zswupc,zswdnc,icld)
130	ELSE
131	zheatc = 0.
132	zswupc = 0.
133	zswdnc = 0.
134	ENDIF
135	ICLD = 0 ! colonne sans nuages
136	CALL heating(dist,rmu0,fract,falbe,zheatp,zswupp,zswdnp,icld)
137
138	c inversion de l'axe vertical
139	do l=1,klev
140	do i=1,klon
141	heat(i,l)=zheatc(i,klev+1-l)*xnuf +
142	& zheatp(i,klev+1-l)*(1.-xnuf)
143	enddo
144	enddo
145	do l=1,klev+1
146	do i=1,klon
147	swup(i,l) =zswupc(i,klev+2-l)*xnuf +
148	& zswupp(i,klev+2-l)*(1.-xnuf)
149	swdn(i,l) =zswdnc(i,klev+2-l)*xnuf +
150	& zswdnp(i,klev+2-l)*(1.-xnuf)
151	swnet(i,l)=swdn(i,l)-swup(i,l)
152	enddo
153	enddo
154
155	solsw = swnet(:,1)
156	topsw = swnet(:,klev+1)
157
158	c =======================================
159	c CALCUL DU LW
160	c =======================================
161
162	print*,'On calcule le rayonnement LW'
163
164	IF (clouds.eq.1) THEN
165	ICLD = 1
166	CALL cooling(klon,klev+1,zp,zt,zz,zcoolc,zlwupc,zlwdnc,
167	& zsollwdownc,icld)
168	ELSE
169	zcoolc = 0.
170	zlwupc = 0.
171	zlwdnc = 0.
172	zsollwdownc = 0.
173	ENDIF
174	ICLD = 0
175	CALL cooling(klon,klev+1,zp,zt,zz,zcoolp,zlwupp,zlwdnp,
176	& zsollwdownp,icld)
177
178	c inversion de l'axe vertical
179	do l=1,klev
180	do i=1,klon
181	cool(i,l)=zcoolc(i,klev+1-l)*xnuf +
182	& zcoolp(i,klev+1-l)*(1.-xnuf)
183	enddo
184	enddo
185	do l=1,klev+1
186	do i=1,klon
187	lwup(i,l) =zlwupc(i,klev+2-l)*xnuf +
188	& zlwupp(i,klev+2-l)*(1.-xnuf)
189	lwdn(i,l) =zlwdnc(i,klev+2-l)*xnuf +
190	& zlwdnp(i,klev+2-l)*(1.-xnuf)
191	lwnet(i,l)=lwup(i,l)-lwdn(i,l)
192	enddo
193	enddo
194
195	do i=1,klon
196	sollwdown(i)=zsollwdownc(i)*xnuf +
197	& zsollwdownp(i)*(1.-xnuf)
198	enddo
199
200	sollw = -lwnet(:,1)
201	toplw = lwnet(:,klev+1)
202	radsol = solsw+sollw
203
204	RETURN
205	END

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

Download in other formats:

Original Format