source: trunk/LMDZ.GENERIC/libf/phystd/aerave.F @ 1980

Last change on this file since 1980 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 5.1 KB
Line 
1      subroutine aerave( ndata,
2     &     longdata,epdata,omegdata,gdata,         
3     &     longref,epref,temp,nir,longir
4     &     ,epir,omegir,gir,qref )
5
6
7      implicit none
8
9!==================================================================
10!     
11!     Purpose
12!     -------
13!     Calculate mean values of aerosol quantities in each band.
14!     
15!     Authors
16!     -------
17!     R. Fournier (1996)
18!     F. Forget (1996)
19!     
20!     Called by
21!     ---------
22!     suaer_corrk.F90
23!     
24!     Calls
25!     -----
26!     blackl.F
27!     
28!==================================================================
29
30!     
31!     R.Fournier 02/1996
32!     (modif F.Forget 02/1996)
33!     le spectre est decoupe en "nir" bandes et cette routine calcule
34!     les donnees radiatives moyenne sur chaque bande : l'optimisation
35!     est faite pour une temperature au sol "temp" et une epaisseur
36!     optique de l'atmosphere "epref" a la longueur d'onde "longref"
37!     
38!     dans la version actuelle, les ponderations sont independantes de
39!     l'epaisseur optique : c'est a dire que "omegir", "gir"
40!     et "epir/epre" sont independants de "epref".
41!     en effet les ponderations sont choisies pour une solution exacte
42!     en couche mince et milieu isotherme.
43!     
44!     entree
45!     
46!     ndata : taille des champs data
47!     longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
48!     (longdata longueur d'onde en METRES)
49!     * longref : longueur d'onde a laquelle l'epaisseur optique
50!     est connue
51!     * epref : epaisseur optique a longref
52!     * temp : temperature choisie pour la ponderation (Planck)
53!     * nir : nombre d'intervals dans la discretisation spectrale
54!     du GCM
55!     * longir : longueurs d'onde definissant ces intervals
56!     
57!     sortie
58!     
59!     * epir : epaisseur optique moyenne pour chaque interval
60!     * omegir : "scattering albedo" moyen pour chaque interval
61!     * gir : "assymetry factor" moyen pour chaque interval
62!     * qref : extinction coefficient at reference wavelength
63
64!=======================================================================
65! output
66
67      REAL longref
68      REAL epref
69      REAL temp
70      INTEGER nir
71      REAL*8 longir(nir+1)
72      REAL epir(nir)
73      REAL omegir(nir)
74      REAL gir(nir)
75
76!=======================================================================
77
78      INTEGER iir,nirmx
79      PARAMETER (nirmx=100)
80      INTEGER idata,ndata
81
82      DOUBLE PRECISION tmp1
83      REAL tmp2,tmp3
84
85!=======================================================================
86! input
87
88      REAL emit
89      REAL totalemit(nirmx)
90      REAL longdata(ndata),epdata(ndata)
91     &     ,omegdata(ndata),gdata(ndata)
92      REAL qextcorrdata(ndata)
93      INTEGER ibande,nbande
94      PARAMETER (nbande=1000)
95
96      REAL long,deltalong
97      INTEGER ilong
98      INTEGER i1,i2
99      REAL c1,c2
100      REAL factep,qextcorr,omeg,g,qref
101
102      long=longref
103
104
105!=======================================================================
106!     pre-interpolation
107      ilong=1
108      DO idata=2,ndata
109         IF (long.gt.longdata(idata)) ilong=idata
110      ENDDO
111      i1=ilong
112      i2=ilong+1
113      IF (i2.gt.ndata) i2=ndata
114      IF (long.lt.longdata(1)) i2=1
115      IF (i1.eq.i2) THEN
116         c1=1.E+0
117         c2=0.E+0
118      ELSE
119         c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
120         c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
121      ENDIF
122
123      qref=c1*epdata(i1)+c2*epdata(i2)
124      factep=qref/epref
125      DO idata=1,ndata
126         qextcorrdata(idata)=epdata(idata)/factep
127      ENDDO
128!=======================================================================
129
130      DO iir=1,nir
131
132         deltalong=(longir(iir+1)-longir(iir)) / nbande
133         totalemit(iir)=0.E+0
134         epir(iir)=0.E+0
135         omegir(iir)=0.E+0
136         gir(iir)=0.E+0
137
138         DO ibande=1,nbande
139
140            long=longir(iir) + (ibande-0.5E+0) * deltalong
141            CALL blackl(DBLE(long),DBLE(temp),tmp1)
142            emit=REAL(tmp1)
143
144!=======================================================================
145!     interpolation
146            ilong=1
147            DO idata=2,ndata
148               IF (long.gt.longdata(idata)) ilong=idata
149            ENDDO
150            i1=ilong
151            i2=ilong+1
152
153            IF (i2.gt.ndata) i2=ndata
154            IF (long.lt.longdata(1)) i2=1
155            IF (i1.eq.i2) THEN
156               c1=1.E+0
157               c2=0.E+0
158            ELSE
159               c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
160               c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
161            ENDIF
162!=======================================================================
163
164            qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
165            omeg=c1*omegdata(i1)+c2*omegdata(i2)
166            g=c1*gdata(i1)+c2*gdata(i2)
167
168            totalemit(iir)=totalemit(iir)+deltalong*emit
169            epir(iir)=epir(iir)+deltalong*emit*qextcorr
170            omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
171            gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g
172
173         ENDDO
174
175         gir(iir)=gir(iir)/omegir(iir)
176         omegir(iir)=omegir(iir)/epir(iir)
177         epir(iir)=epir(iir)/totalemit(iir)
178
179      ENDDO
180
181      return
182      end
Note: See TracBrowser for help on using the repository browser.