/[lmdze]/trunk/libf/phylmd/aeropt.f
ViewVC logotype

Annotation of /trunk/libf/phylmd/aeropt.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 10 - (hide annotations)
Fri Apr 18 14:45:53 2008 UTC (16 years, 1 month ago) by guez
File size: 5008 byte(s) 
Added NetCDF directory "/home/guez/include" in "g95.mk" and
"nag_tools.mk".

Added some "intent" attributes in "PVtheta", "advtrac", "caladvtrac",
"calfis", "diagedyn", "dissip", "vlspltqs", "aeropt", "ajsec",
"calltherm", "clmain", "cltrac", "cltracrn", "concvl", "conema3",
"conflx", "fisrtilp", "newmicro", "nuage", "diagcld1", "diagcld2",
"drag_noro", "lift_noro", "SUGWD", "physiq", "phytrac", "radlwsw", "thermcell".

Removed the case "ierr == 0" in "abort_gcm"; moved call to "histclo"
and messages for end of run from "abort_gcm" to "gcm"; replaced call
to "abort_gcm" in "leapfrog" by exit from outer loop.

In "calfis": removed argument "pp" and variable "unskap"; changed
"pksurcp" from scalar to rank 2; use "pressure_var"; rewrote
computation of "zplev", "zplay", "ztfi", "pcvgt" using "dyn_phy";
added computation of "pls".

Removed unused variable in "dynredem0".

In "exner_hyb": changed "dellta" from scalar to rank 1; replaced call
to "ssum" by call to "sum"; removed variables "xpn" and "xps";
replaced some loops by array expressions.

In "leapfrog": use "pressure_var"; deleted variables "p", "longcles".

Converted common blocks "YOECUMF", "YOEGWD" to modules.

Removed argument "pplay" in "cvltr", "diagetpq", "nflxtr".

Created module "raddimlw" from include file "raddimlw.h".

Corrected call to "new_unit" in "test_disvert".
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/aeropt.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
3     !
4     SUBROUTINE aeropt(pplay, paprs, t_seri, msulfate, RHcl,
5     . tau_ae, piz_ae, cg_ae, ai )
6     c
7     use dimens_m
8     use dimphy
9     use YOMCST
10     IMPLICIT none
11     c
12     c
13     c
14     c
15     c Arguments:
16     c
17     REAL, intent(in):: paprs(klon,klev+1)
18 guez 10 REAL, intent(in):: pplay(klon,klev), t_seri(klon,klev)
19 guez 3 REAL msulfate(klon,klev) ! masse sulfate ug SO4/m3 [ug/m^3]
20     REAL RHcl(klon,klev) ! humidite relative ciel clair
21     REAL tau_ae(klon,klev,2) ! epaisseur optique aerosol
22     REAL piz_ae(klon,klev,2) ! single scattering albedo aerosol
23     REAL cg_ae(klon,klev,2) ! asymmetry parameter aerosol
24     REAL ai(klon) ! POLDER aerosol index
25     c
26     c Local
27     c
28     INTEGER i, k, inu
29     INTEGER RH_num, nbre_RH
30     PARAMETER (nbre_RH=12)
31     REAL RH_tab(nbre_RH)
32     REAL RH_MAX, DELTA, rh
33     PARAMETER (RH_MAX=95.)
34     DATA RH_tab/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./
35     REAL zrho, zdz
36     REAL taue670(klon) ! epaisseur optique aerosol absorption 550 nm
37     REAL taue865(klon) ! epaisseur optique aerosol extinction 865 nm
38     REAL alpha_aer_sulfate(nbre_RH,5) !--unit m2/g SO4
39     REAL alphasulfate
40     c
41     c Proprietes optiques
42     c
43     REAL alpha_aer(nbre_RH,2) !--unit m2/g SO4
44     REAL cg_aer(nbre_RH,2)
45     DATA alpha_aer/.500130E+01, .500130E+01, .500130E+01,
46     . .500130E+01, .500130E+01, .616710E+01,
47     . .826850E+01, .107687E+02, .136976E+02,
48     . .162972E+02, .211690E+02, .354833E+02,
49     . .139460E+01, .139460E+01, .139460E+01,
50     . .139460E+01, .139460E+01, .173910E+01,
51     . .244380E+01, .332320E+01, .440120E+01,
52     . .539570E+01, .734580E+01, .136038E+02 /
53     DATA cg_aer/.619800E+00, .619800E+00, .619800E+00,
54     . .619800E+00, .619800E+00, .662700E+00,
55     . .682100E+00, .698500E+00, .712500E+00,
56     . .721800E+00, .734600E+00, .755800E+00,
57     . .545600E+00, .545600E+00, .545600E+00,
58     . .545600E+00, .545600E+00, .583700E+00,
59     . .607100E+00, .627700E+00, .645800E+00,
60     . .658400E+00, .676500E+00, .708500E+00 /
61     DATA alpha_aer_sulfate/
62     . 4.910,4.910,4.910,4.910,6.547,7.373,
63     . 8.373,9.788,12.167,14.256,17.924,28.433,
64     . 1.453,1.453,1.453,1.453,2.003,2.321,
65     . 2.711,3.282,4.287,5.210,6.914,12.305,
66     . 4.308,4.308,4.308,4.308,5.753,6.521,
67     . 7.449,8.772,11.014,12.999,16.518,26.772,
68     . 3.265,3.265,3.265,3.265,4.388,5.016,
69     . 5.775,6.868,8.745,10.429,13.457,22.538,
70     . 2.116,2.116,2.116,2.116,2.882,3.330,
71     . 3.876,4.670,6.059,7.327,9.650,16.883/
72     c
73     DO i=1, klon
74     taue670(i)=0.0
75     taue865(i)=0.0
76     ENDDO
77     c
78     DO k=1, klev
79     DO i=1, klon
80     if (t_seri(i,k).eq.0) write (*,*) 'aeropt T ',i,k,t_seri(i,k)
81     if (pplay(i,k).eq.0) write (*,*) 'aeropt p ',i,k,pplay(i,k)
82     zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3
83     zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG ! m
84     rh=MIN(RHcl(i,k)*100.,RH_MAX)
85     RH_num = INT( rh/10. + 1.)
86     IF (rh.LT.0.) STOP 'aeropt: RH < 0 not possible'
87     IF (rh.gt.85.) RH_num=10
88     IF (rh.gt.90.) RH_num=11
89     DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num))
90     c
91     inu=1
92     tau_ae(i,k,inu)=alpha_aer(RH_num,inu) +
93     . DELTA*(alpha_aer(RH_num+1,inu)-alpha_aer(RH_num,inu))
94     tau_ae(i,k,inu)=tau_ae(i,k,inu)*msulfate(i,k)*zdz*1.e-6
95     piz_ae(i,k,inu)=1.0
96     cg_ae(i,k,inu)=cg_aer(RH_num,inu) +
97     . DELTA*(cg_aer(RH_num+1,inu)-cg_aer(RH_num,inu))
98     c
99     inu=2
100     tau_ae(i,k,inu)=alpha_aer(RH_num,inu) +
101     . DELTA*(alpha_aer(RH_num+1,inu)-alpha_aer(RH_num,inu))
102     tau_ae(i,k,inu)=tau_ae(i,k,inu)*msulfate(i,k)*zdz*1.e-6
103     piz_ae(i,k,inu)=1.0
104     cg_ae(i,k,inu)=cg_aer(RH_num,inu) +
105     . DELTA*(cg_aer(RH_num+1,inu)-cg_aer(RH_num,inu))
106     cjq
107     cjq for aerosol index
108     c
109     alphasulfate=alpha_aer_sulfate(RH_num,4) +
110     . DELTA*(alpha_aer_sulfate(RH_num+1,4)-
111     . alpha_aer_sulfate(RH_num,4)) !--m2/g
112     c
113     taue670(i)=taue670(i)+
114     . alphasulfate*msulfate(i,k)*zdz*1.e-6
115     c
116     alphasulfate=alpha_aer_sulfate(RH_num,5) +
117     . DELTA*(alpha_aer_sulfate(RH_num+1,5)-
118     . alpha_aer_sulfate(RH_num,5)) !--m2/g
119     c
120     taue865(i)=taue865(i)+
121     . alphasulfate*msulfate(i,k)*zdz*1.e-6
122    
123     ENDDO
124     ENDDO
125     c
126     DO i=1, klon
127     ai(i)=(-log(MAX(taue670(i),0.0001)/
128     . MAX(taue865(i),0.0001))/log(670./865.)) *
129     . taue865(i)
130     ENDDO
131     c
132     RETURN
133     END
  ViewVC Help
Powered by ViewVC 1.1.21