Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

lwdiff.F @ 357

Last change on this file since 357 was 38, checked in by emillour, 14 years ago
Ajout du modè Martien (mon LMDZ.MARS.BETA, du 28/01/2011) dans le rértoire mars, pour pouvoir suivre plus facilement les modifs. EM
File size: 6.7 KB

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

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

Download in other formats:

Original Format