source: trunk/mars/libf/phymars/lwdiff.F @ 38

Last change on this file since 38 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"
16C-----------------------------------------------------------------------
17C
18c  ABSORPTION ET DIFUSION HORS DE LA BANDE A 15 MICRONS :
19c! 1) Dans la bande a 15 micron (CO2), les poussieres
20c! n'interviennent que comme un milieu gris non diffusif avec
21c!                      Q=Qext*(1-Omega)
22c! cette bande est decoupee en deux sous bandes (indices 1 et 2)
23c! pour lesquelles les parametres optiques des poussieres sont
24c! identiques
25c! 2)  le reste est decoupe en "nir-2" bandes : une bande qui recouvre toutes
26c! les longueurs d'onde inferieures a celles de la bande a 15 microns
27c! (indice 3) et nir-3 bandes pour les grandes longueurs d'onde
28c! (indices 4...nir) sur chacune de ces  bandes, les poussieres
29c! sont supposees diffusantes grises.
30c!
31C
32C-----------------------------------------------------------------------
33C
34C
35C-----------------------------------------------------------------------
36C
37C*       0.1   ARGUMENTS
38C              ---------
39C
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
48C
49C
50C-------------------------------------------------------------------------
51C
52C*       0.2   LOCAL ARRAYS
53C              ------------
54C
55C
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,NFLEV*2),ZGDD(NDLON,NFLEV*2)
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,NFLEV*2+1),ZFDHDD(NDLON,NFLEV*2+1)
68     S  ,  ZZFAHDD(NDLON,NFLEV*2+1),ZZFDHDD(NDLON,NFLEV*2+1)
69C
70C-----------------------------------------------------------------------
71C
72C*         1.    INITIALIZATION
73C                --------------
74C
75 100  CONTINUE
76C
77C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
78C                  ------------------------------
79C
80 110  CONTINUE
81C
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
98C
99C
100C     ------------------------------------------------------------------
101C
102C*         2.      VERTICAL INTEGRATION
103C                  --------------------
104C
105C     ------------------------------------------------------------------
106C
107C
108C  ==================================================================
109C*         2.0     contribution des bandes "hors co2"
110C  ==================================================================
111C
112 200  CONTINUE
113C
114C     ------------------------------------------------------------------
115C
116C*         2.0.1   preparation des Planck a chaque hauteur
117C                  ----------------------------------
118C
119c!
120c! le nombre de couche pour la diffusion sera le nombre de layer * 2
121c! soit NDD=nlaylte*2, donc la taille du vecteur des Planck sera
122c! nlaylte*2 + 1. la taille des vecteurs omega / g / tau sera
123c! par contre nlaylte*2 (voir dans FLUSV.F).
124c!
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
136c!
137c! boucle sur les  bandes hors CO2
138c!
139      DO 10001 iir=3,nir
140c!
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
154C
155C     ------------------------------------------------------------------
156C
157C*         2.0.2   preparation des coefficients de diffusion
158C                  -----------------------------------------
159C
160c! 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
187C
188C     ------------------------------------------------------------------
189C
190C*         2.0.3   calcul de la diffusion
191C                  ----------------------
192C
193
194c-----------------------------------------------------------------------
195        CALL flusv(KDLON,0
196     &  ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS
197     &  ,ZZBHDD,ZZBSDD
198     &  ,ZZFAHDD,ZZFDHDD)
199c!
200c!  Cumul des flux sur le spectre hors bande du CO2
201c!
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
20810001 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.