source: trunk/LMDZ.MARS/libf/phymars/param_slope.F90 @ 317

Last change on this file since 317 was 227, checked in by aslmd, 13 years ago

MESOSCALE and LMDZ.MARS: corrected the bug with readtesassim, now the GCM routine can be used. changed name for slope routines to drop the meso_ prefix

File size: 4.9 KB
RevLine 
[227]1SUBROUTINE param_slope( &
[42]2  !
3  ! INPUTS
4  !
5               &  csza, declin, rho, latitude &
6               &  ,taudust, albedo  &
7               &  ,theta_s, psi_s &
8               &  ,fdir_0, ftot_0  &
9  !
10  ! OUTPUTS
11  !
12               &  ,ftot &
13 )
14
15
16!!*****************************************************************************************
17!
18! SUBROUTINE:
19! param_slope
20!
21!
22! PURPOSE:
23! computes total solar irradiance on a given Martian slope
24!
25!
26! INPUTS:
27! csza          cosine solar zenith angle
28! declin        sun declination (rad)
29! rho           sun right ascension (rad)
30! latitude      latitude (deg)
31! taudust       dust optical depth at reference wavelength 0.67 mic.
32! albedo        spectrally integrated surface Lambertian reflection albedo
33! theta_s       slope inclination angle (deg)
34!                       0 is horizontal, 90 is vertical
35! phi_s         slope azimuth (deg)
36!                       0 >> Northward
37!                       90 >> Eastward
38!                       180 >> Southward
39!                       270 >> Westward
40! ftot_0        spectrally integrated total irradiance on an horizontal surface (W/m2)
41! fdir_0        spectrally integrated direct irradiance on an horizontal surface (W/m2)
42!
43!
44! OUTPUTS:
45! ftot          spectrally integrated total irradiance on the slope (W/m2)
46!
47! REFERENCE:
48! "Fast and accurate estimation of irradiance on Martian slopes"
49! A. Spiga & F. Forget
50! .....
51!
52! AUTHOR:
53! A. Spiga (spiga@lmd.jussieu.fr)
54! March 2008
55!
56!!*****************************************************************************************
57
58IMPLICIT NONE
59
60!!
61!! INPUT
62!!
63REAL, INTENT(IN) :: csza, declin, rho, latitude, taudust, theta_s, psi_s, albedo, ftot_0 , fdir_0
64
65!!
66!! LOCAL
67!!
68REAL :: pi, deg2rad
69REAL :: a
70REAL :: mu_s, sigma_s
71REAL :: fdir, fscat, fscat_0, fref
72REAL, DIMENSION(4,2) :: mat_M, mat_N, mat_T
73REAL, DIMENSION(2) :: g_vector
74REAL, DIMENSION(4) :: s_vector
75REAL :: ratio
76
77!!
78!! OUTPUT
79!!
80REAL, INTENT(OUT) :: ftot
81
82!!*****************************************************************************************
83
84!
85! Prerequisite
86!
87  pi = 2.*asin(1.)
88  deg2rad = pi/180.
89  if ((theta_s > 90.) .or. (theta_s < 0.)) then
[226]90        print *, 'please set theta_s between 0 and 90', theta_s
91        stop
[42]92  endif
93
94!
95! Solar Zenith angle (radian)
96!
97  if (csza .lt. 0.01) then
98      !print *, 'sun below horizon'
99      !fdir_0=0.
100      fdir=0.
101      fscat_0=0.
102      fscat=0.   
103      fref=0.
104  else
105
106!!
107!! Low incidence fix
108!!
109!  if (csza .lt. 0.15) csza = 0.15
110
111!
112! 'Slope vs Sun' azimuth (radian)
113!
114  if ( ( (cos(declin)*sin(rho)) .eq. 0.0 ) &
115               .and. &
116     ( ( sin(deg2rad*latitude)*cos(declin)*cos(rho) &
117              -cos(deg2rad*latitude)*sin(declin) ) .eq. 0.0 ) ) then
118    a = deg2rad*psi_s ! some compilator need specfying value for atan2(0,0) 
119  else
120    a = deg2rad*psi_s + atan2(cos(declin)*sin(rho), &
121               sin(deg2rad*latitude)*cos(declin)*cos(rho)-cos(deg2rad*latitude)*sin(declin))
122  end if
123 
124!
125! Cosine of slope-sun phase angle
126!
127  mu_s = csza*cos(deg2rad*theta_s) - cos(a)*sin(deg2rad*theta_s)*sqrt(1-csza**2)
128  if (mu_s .le. 0.) mu_s=0.
129
130!
131! Sky-view factor
132!
133  sigma_s=0.5*(1.+cos(deg2rad*theta_s))
134
135!
136! Direct flux on the slope
137!
138  fdir = fdir_0 * mu_s/csza
139
140!
141! Reflected flux on the slope
142!
143  fref = albedo * (1-sigma_s) * ftot_0
144
145!
146! Scattered flux on a flat surface
147!
148  fscat_0 = ftot_0 - fdir_0
149
150!
151! Scattering vector (slope vs sky)
152!
153  s_vector=(/ 1., exp(-taudust) , sin(deg2rad*theta_s), sin(deg2rad*theta_s)*exp(-taudust) /)
154
155!
156! Geometry vector (slope vs sun)
157!
158  g_vector=(/ mu_s/csza, 1. /)
159
160!
161! Coupling matrix
162!
163  if (csza .ge. 0.5) then
[226]164        mat_M(:,1) = (/ -0.264,  1.309,  0.208, -0.828 /)
165        mat_M(:,2) = (/  1.291*sigma_s, -1.371*sigma_s, -0.581,  1.641 /)
166        mat_N(:,1) = (/  0.911, -0.777, -0.223,  0.623 /)
167        mat_N(:,2) = (/ -0.933*sigma_s,  0.822*sigma_s,  0.514, -1.195 /)
[42]168
169  else
[226]170        mat_M(:,1) = (/ -0.373,  0.792, -0.095,  0.398 /)
171        mat_M(:,2) = (/  1.389*sigma_s, -0.794*sigma_s, -0.325,  0.183 /)
172        mat_N(:,1) = (/  1.079,  0.275,  0.419, -1.855 /)
173        mat_N(:,2) = (/ -1.076*sigma_s, -0.357*sigma_s, -0.075,  1.844 /)
[42]174  endif
175  !
176  mat_T = mat_M + csza*mat_N
177
178
179!
180! Scattered flux slope ratio
181!
182  if (deg2rad*theta_s <= 0.0872664626) then
183  !
184  ! low angles
185  !
[226]186        s_vector = (/ 1., exp(-taudust) , sin(0.0872664626), sin(0.0872664626)*exp(-taudust) /)
187        ratio = DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector )
[42]188        ratio = 1. + (ratio - 1.)*deg2rad*theta_s/0.0872664626
189  else
190  !
191  ! general case
192  !
[226]193        ratio= DOT_PRODUCT ( MATMUL( s_vector, mat_T), g_vector ) 
[42]194                  !
195                  ! NB: ratio= DOT_PRODUCT ( s_vector, MATMUL( mat_T, g_vector ) ) is equivalent
196  endif
197
198!
199! Scattered flux on the slope
200!
201  fscat = ratio * fscat_0
202
203
204endif !! if (csza < 0.01)
205
206!
207! Total flux on the slope
208!
209  ftot = fdir + fref + fscat
210
211!!
212!! Display results
213!!
214!  print *, 'sca component 0 ', ftot_0-fdir_0
215!  print *, 'dir component 0 ', fdir_0
216!  print *, 'scattered component ', fscat
217!  print *, 'direct component ', fdir
218!  print *, 'reflected component ', fref
219
[227]220END SUBROUTINE param_slope
Note: See TracBrowser for help on using the repository browser.