Context Navigation

lwdiff.F @ 1233

Last change on this file since 1233 was 1226, checked in by aslmd, 11 years ago
LMDZ.MARS : Replaced comcstfi and planete includes by modules.
File size: 6.8 KB

Line
1	subroutine lwdiff (kdlon,kflev
2	. ,pbsur,pbtop,pdbsl
3	. ,tautotal,omegtotal,gtotal
4	. ,pemis,pfluc)
5
6	use dimradmars_mod, only: nir, npademx, nabsmx, nflev, ndlon,
7	& ndlo2
8	use yomlw_h, only: nlaylte
9	USE comcstfi_h
10	IMPLICIT NONE
11
12	!#include "dimensions.h"
13	!#include "dimphys.h"
14	!#include "dimradmars.h"
15	#include "callkeys.h"
16
17	!#include "yomaer.h"
18	!#include "yomlw.h"
19	C-----------------------------------------------------------------------
20	C
21	c ABSORPTION ET DIFUSION HORS DE LA BANDE A 15 MICRONS :
22	c! 1) Dans la bande a 15 micron (CO2), les poussieres
23	c! n'interviennent que comme un milieu gris non diffusif avec
24	c! Q=Qext*(1-Omega)
25	c! cette bande est decoupee en deux sous bandes (indices 1 et 2)
26	c! pour lesquelles les parametres optiques des poussieres sont
27	c! identiques
28	c! 2) le reste est decoupe en "nir-2" bandes : une bande qui recouvre toutes
29	c! les longueurs d'onde inferieures a celles de la bande a 15 microns
30	c! (indice 3) et nir-3 bandes pour les grandes longueurs d'onde
31	c! (indices 4...nir) sur chacune de ces bandes, les poussieres
32	c! sont supposees diffusantes grises.
33	c!
34	C
35	C-----------------------------------------------------------------------
36	C
37	C
38	C-----------------------------------------------------------------------
39	C
40	C* 0.1 ARGUMENTS
41	C ---------
42	C
43	integer kdlon,kflev
44	REAL PBSUR(NDLO2,nir), PBTOP(NDLO2,nir)
45	S , PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2)
46
47	real PFLUC(NDLO2,2,KFLEV+1)
48	real tautotal(ndlon,nflev,nir)
49	real omegtotal(ndlon,nflev,nir), gtotal(ndlon,nflev,nir)
50
51	C
52	C
53	C-------------------------------------------------------------------------
54	C
55	C* 0.2 LOCAL ARRAYS
56	C ------------
57	C
58	C
59	integer jl, jk, ndd, indd, iir, j1
60	integer j2, j2dd2, j2dd1,j2bot,j2top, j2dd
61	REAL ZADJD(NDLON,NFLEV+1), ZADJU(NDLON,NFLEV+1)
62	S , ZDBDT(NDLON,nir,NFLEV)
63	S , ZDISD(NDLON,NFLEV+1), ZDISU(NDLON,NFLEV+1)
64	S , ZFD(NDLON), ZFDN(NDLON,NFLEV+1), ZFU(NDLON)
65	S , ZFUP(NDLON,NFLEV+1),ZGLAYD(NDLON),ZGLAYU(NDLON)
66	S , ZOMEGADD(NDLON,NFLEV2),ZGDD(NDLON,NFLEV2)
67	S , ZTAUDD(NDLON,NFLEV*2)
68	S , ZBHDD(NDLON,NFLEV*2+1),ZBSDD(NDLON)
69	S , ZZBHDD(NDLON,NFLEV*2+1),ZZBSDD(NDLON)
70	S , ZFAHDD(NDLON,NFLEV2+1),ZFDHDD(NDLON,NFLEV2+1)
71	S , ZZFAHDD(NDLON,NFLEV2+1),ZZFDHDD(NDLON,NFLEV2+1)
72	C
73	C-----------------------------------------------------------------------
74	C
75	C* 1. INITIALIZATION
76	C --------------
77	C
78	100 CONTINUE
79	C
80	C* 1.1 INITIALIZE LAYER CONTRIBUTIONS
81	C ------------------------------
82	C
83	110 CONTINUE
84	C
85
86	do jl = 1 , kdlon
87	do jk = 1 , nlaylte
88	PFLUC(jl,1,jk) = 0.
89	PFLUC(jl,2,jk) = 0.
90	enddo
91	enddo
92
93	DO 112 JK = 1 , nlaylte+1
94	DO 111 JL = 1 , KDLON
95	ZADJD(JL,JK) = 0.
96	ZADJU(JL,JK) = 0.
97	ZDISD(JL,JK) = 0.
98	ZDISU(JL,JK) = 0.
99	111 CONTINUE
100	112 CONTINUE
101	C
102	C
103	C ------------------------------------------------------------------
104	C
105	C* 2. VERTICAL INTEGRATION
106	C --------------------
107	C
108	C ------------------------------------------------------------------
109	C
110	C
111	C ==================================================================
112	C* 2.0 contribution des bandes "hors co2"
113	C ==================================================================
114	C
115	200 CONTINUE
116	C
117	C ------------------------------------------------------------------
118	C
119	C* 2.0.1 preparation des Planck a chaque hauteur
120	C ----------------------------------
121	C
122	c!
123	c! le nombre de couche pour la diffusion sera le nombre de layer * 2
124	c! soit NDD=nlaylte*2, donc la taille du vecteur des Planck sera
125	c! nlaylte*2 + 1. la taille des vecteurs omega / g / tau sera
126	c! par contre nlaylte*2 (voir dans FLUSV.F).
127	c!
128	NDD=nlaylte*2
129	DO indd=1,ndd+1
130	do jl=1,kdlon
131	ZFAHDD(jl,indd)=0.
132	ZFDHDD(jl,indd)=0.
133	ZBHDD(jl,indd)=0.
134	enddo
135	ENDDO
136	do jl=1,kdlon
137	ZBSDD(jl)=0.
138	enddo
139	c!
140	c! boucle sur les bandes hors CO2
141	c!
142	DO 10001 iir=3,nir
143	c!
144	do jl=1,kdlon
145	ZZBHDD(JL,1)=PBTOP(JL,iir)/pi
146	enddo
147	DO J1=2,NDD+1
148	do jl=1,kdlon
149	ZZBHDD(JL,J1)=
150	& ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/pi
151	enddo
152	ENDDO
153	do jl=1,kdlon
154	ZZBSDD(JL)=PBSUR(JL,iir)/pi
155	enddo
156
157	C
158	C ------------------------------------------------------------------
159	C
160	C* 2.0.2 preparation des coefficients de diffusion
161	C -----------------------------------------
162	C
163	c! les omega, g, tau ... boucle de bas en haut
164	DO J2=1,nlaylte-1
165	J2DD2=(nlaylte-J2+1)*2
166	J2DD1=J2DD2-1
167	J2BOT=3*J2-2
168	J2TOP=3*J2+1
169	do jl=1,kdlon
170	ZTAUDD(JL,J2DD1)=tautotal(jl,J2,iir)*0.5
171	ZTAUDD(JL,J2DD2)=ZTAUDD(JL,J2DD1)
172	ZOMEGADD(JL,J2DD1)=omegtotal(jl,J2,iir)
173	ZOMEGADD(JL,J2DD2)=omegtotal(jl,J2,iir)
174	ZGDD(JL,J2DD1)=gtotal(jl,J2,iir)
175	ZGDD(JL,J2DD2)=gtotal(jl,J2,iir)
176	enddo
177	ENDDO
178	J2=nlaylte
179	J2DD2=2
180	J2DD1=1
181	J2BOT=3*J2-2
182	do jl=1,kdlon
183	ZTAUDD(JL,J2DD1)= tautotal(jl,J2,iir)*0.5
184	ZTAUDD(JL,J2DD2)= tautotal(jl,J2,iir)*0.5
185	ZOMEGADD(JL,J2DD1)= omegtotal(jl,J2,iir)
186	ZOMEGADD(JL,J2DD2)= omegtotal(jl,J2,iir)
187	ZGDD(JL,J2DD1)= gtotal(jl,J2,iir)
188	ZGDD(JL,J2DD2)= gtotal(jl,J2,iir)
189	enddo
190	C
191	C ------------------------------------------------------------------
192	C
193	C* 2.0.3 calcul de la diffusion
194	C ----------------------
195	C
196
197	c-----------------------------------------------------------------------
198	CALL flusv(KDLON,0
199	& ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS
200	& ,ZZBHDD,ZZBSDD
201	& ,ZZFAHDD,ZZFDHDD)
202	c!
203	c! Cumul des flux sur le spectre hors bande du CO2
204	c!
205	DO indd=1,ndd+1
206	do jl=1,kdlon
207	ZFAHDD(jl,indd)=ZFAHDD(jl,indd)+ZZFAHDD(jl,indd)
208	ZFDHDD(jl,indd)=ZFDHDD(jl,indd)+ZZFDHDD(jl,indd)
209	enddo
210	ENDDO
211	10001 CONTINUE
212
213	DO J2=1,nlaylte+1
214	J2DD=(nlaylte-J2+1)*2+1
215	do jl=1,kdlon
216	PFLUC(JL,1,J2)=PFLUC(JL,1,J2)+ZFAHDD(JL,J2DD)
217	PFLUC(JL,2,J2)=PFLUC(JL,2,J2)-ZFDHDD(JL,J2DD)
218	enddo
219	ENDDO
220
221
222	END

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

Download in other formats:

Original Format