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

Annotation of /trunk/phylmd/aeropt.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 68 - (hide annotations)
Wed Nov 14 16:59:30 2012 UTC (11 years, 6 months ago) by guez
Original Path: trunk/libf/phylmd/aeropt.f90
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 guez 68 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