Context Navigation

lwdiff.F @ 1246

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

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

Download in other formats:

Original Format