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

Contents of /trunk/libf/phylmd/aeropt.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (show annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
File size: 4829 byte(s) 
Split "flincom.f90" into "flinclo.f90", "flinfindcood.f90",
"flininfo.f90" and "flinopen_nozoom.f90", in directory
"IOIPSL/Flincom".

Renamed "etat0_lim" to "ce0l", as in LMDZ.

Split "readsulfate.f" into "readsulfate.f90", "readsulfate_preind.f90"
and "getso4fromfile.f90".

In etat0, renamed variable q3d to q, as in "dynredem1". Replaced calls
to Flicom procedures by calls to NetCDF95.

In leapfrog, added call to writehist.

Extracted ASCII art from "grid_noro" into a file
"grid_noro.txt". Transformed explicit-shape local arrays into
automatic arrays, so that test on values of iim and jjm is no longer
needed. Test on weight:
          IF (weight(ii, jj) /= 0.) THEN
is useless. There is already a test before:
    if (any(weight == 0.)) stop "zero weight in grid_noro"

In "aeropt", replaced duplicated lines with different values of inu by
a loop on inu.

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