29 |
! area. See "grid_noto.txt". |
! area. See "grid_noto.txt". |
30 |
|
|
31 |
use dimens_m, only: iim, jjm |
use dimens_m, only: iim, jjm |
|
use nr_util, only: assert, pi |
|
32 |
use mva9_m, only: mva9 |
use mva9_m, only: mva9 |
33 |
|
use nr_util, only: assert, pi |
34 |
|
|
35 |
REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field |
REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field |
36 |
REAL, intent(in):: zdata(:, :) ! input field |
REAL, intent(in):: zdata(:, :) ! input field |
37 |
REAL, intent(in):: x(:), y(:) ! ccordinates output field |
REAL, intent(in):: x(:), y(:) ! coordinates of output field |
38 |
|
|
39 |
! Correlations of US Navy orography gradients: |
! Correlations of US Navy orography gradients: |
40 |
REAL, intent(out):: zphi(:, :) |
REAL, intent(out):: zphi(:, :) ! orography not smoothed |
41 |
real, intent(out):: zmea(:, :) ! Mean orography |
real, intent(out):: zmea(:, :) ! smoothed orography |
42 |
real, intent(out):: zstd(:, :) ! Standard deviation |
real, intent(out):: zstd(:, :) ! Standard deviation |
43 |
REAL, intent(out):: zsig(:, :) ! Slope |
REAL, intent(out):: zsig(:, :) ! Slope |
44 |
real, intent(out):: zgam(:, :) ! Anisotropy |
real, intent(out):: zgam(:, :) ! Anisotropy |
58 |
REAL zusn(iusn + 2 * iext, jusn + 2) |
REAL zusn(iusn + 2 * iext, jusn + 2) |
59 |
|
|
60 |
! Intermediate fields (correlations of orography gradient) |
! Intermediate fields (correlations of orography gradient) |
61 |
|
REAL, dimension(iim + 1, jjm + 1):: ztz, zxtzx, zytzy, zxtzy, weight |
|
REAL ztz(iim + 1, jjm + 1), zxtzx(iim + 1, jjm + 1) |
|
|
REAL zytzy(iim + 1, jjm + 1), zxtzy(iim + 1, jjm + 1) |
|
|
REAL weight(iim + 1, jjm + 1) |
|
62 |
|
|
63 |
! Correlations of US Navy orography gradients: |
! Correlations of US Navy orography gradients: |
64 |
REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn |
REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn |
65 |
|
|
66 |
real mask_tmp(size(x), size(y)) |
real, dimension(iim + 1, jjm + 1):: mask_tmp, num_tot, num_lan, zmea0 |
|
real num_tot(iim + 1, jjm + 1), num_lan(iim + 1, jjm + 1) |
|
|
|
|
67 |
REAL a(iim + 1), b(iim + 1), c(jjm + 1), d(jjm + 1) |
REAL a(iim + 1), b(iim + 1), c(jjm + 1), d(jjm + 1) |
68 |
real weighx, weighy, xincr, xk, xp, xm, xw, xq, xl |
real weighx, weighy, xincr, xk, xp, xm, xw, xq, xl |
69 |
real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud |
real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud |
116 |
zusn(i + iusn / 2 + iext, jusn + 2) = zusn(i, jusn + 1) |
zusn(i + iusn / 2 + iext, jusn + 2) = zusn(i, jusn + 1) |
117 |
ENDDO |
ENDDO |
118 |
|
|
119 |
! COMPUTE LIMITS OF MODEL GRIDPOINT AREA (REGULAR GRID) |
! Compute limits of model gridpoint area (regular grid) |
120 |
|
|
121 |
a(1) = x(1) - (x(2) - x(1)) / 2.0 |
a(1) = x(1) - (x(2) - x(1)) / 2.0 |
122 |
b(1) = (x(1) + x(2)) / 2.0 |
b(1) = (x(1) + x(2)) / 2.0 |
162 |
ENDDO |
ENDDO |
163 |
ENDDO |
ENDDO |
164 |
|
|
165 |
! SUMMATION OVER GRIDPOINT AREA |
! Summation over gridpoint area |
166 |
|
|
167 |
zleny = pi / real(jusn) * rad |
zleny = pi / real(jusn) * rad |
168 |
xincr = pi / 2. / real(jusn) |
xincr = pi / 2. / real(jusn) |
213 |
stop 1 |
stop 1 |
214 |
end if |
end if |
215 |
|
|
216 |
! COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND |
! Compute parameters needed by the Lott & Miller (1997) and Lott |
217 |
! LOTT (1999) SSO SCHEME. |
! (1999) subgrid-scale orographic scheme. |
218 |
|
|
219 |
zllmmea = 0. |
zllmmea = 0. |
220 |
zllmstd = 0. |
zllmstd = 0. |
227 |
DO ii = 1, iim + 1 |
DO ii = 1, iim + 1 |
228 |
DO jj = 1, jjm + 1 |
DO jj = 1, jjm + 1 |
229 |
mask(ii, jj) = num_lan(ii, jj) / num_tot(ii, jj) |
mask(ii, jj) = num_lan(ii, jj) / num_tot(ii, jj) |
230 |
! Mean Orography: |
! Mean orography: |
231 |
zmea (ii, jj) = zmea (ii, jj) / weight(ii, jj) |
zmea (ii, jj) = zmea (ii, jj) / weight(ii, jj) |
232 |
zxtzx(ii, jj) = zxtzx(ii, jj) / weight(ii, jj) |
zxtzx(ii, jj) = zxtzx(ii, jj) / weight(ii, jj) |
233 |
zytzy(ii, jj) = zytzy(ii, jj) / weight(ii, jj) |
zytzy(ii, jj) = zytzy(ii, jj) / weight(ii, jj) |
238 |
ENDDO |
ENDDO |
239 |
ENDDO |
ENDDO |
240 |
|
|
241 |
! CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES: |
! Correct values of horizontal slope near the poles: |
242 |
DO ii = 1, iim + 1 |
DO ii = 1, iim + 1 |
243 |
zxtzx(ii, 1) = zxtzx(ii, 2) |
zxtzx(ii, 1) = zxtzx(ii, 2) |
244 |
zxtzx(ii, jjm + 1) = zxtzx(ii, jjm) |
zxtzx(ii, jjm + 1) = zxtzx(ii, jjm) |
248 |
zytzy(ii, jjm + 1) = zytzy(ii, jjm) |
zytzy(ii, jjm + 1) = zytzy(ii, jjm) |
249 |
ENDDO |
ENDDO |
250 |
|
|
251 |
! FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME. |
zmea0 = zmea ! not smoothed |
252 |
|
|
253 |
|
! Filters to smooth out fields for input into subgrid-scale |
254 |
|
! orographic scheme. |
255 |
|
|
256 |
! FIRST FILTER, MOVING AVERAGE OVER 9 POINTS. |
! First filter, moving average over 9 points. |
257 |
CALL MVA9(zmea) |
CALL MVA9(zmea) |
258 |
CALL MVA9(zstd) |
CALL MVA9(zstd) |
259 |
CALL MVA9(zpic) |
CALL MVA9(zpic) |
265 |
! Masque prenant en compte maximum de terre. On met un seuil à 10 |
! Masque prenant en compte maximum de terre. On met un seuil à 10 |
266 |
! % de terre car en dessous les paramètres de surface n'ont pas de |
! % de terre car en dessous les paramètres de surface n'ont pas de |
267 |
! sens. |
! sens. |
268 |
mask_tmp = 0. |
mask_tmp = merge(1., 0., mask >= 0.1) |
|
WHERE (mask >= 0.1) mask_tmp = 1. |
|
269 |
|
|
270 |
DO ii = 1, iim |
DO ii = 1, iim |
271 |
DO jj = 1, jjm + 1 |
DO jj = 1, jjm + 1 |
286 |
zgam(ii, jj) = xp / xq * mask_tmp(ii, jj) |
zgam(ii, jj) = xp / xq * mask_tmp(ii, jj) |
287 |
! angle theta: |
! angle theta: |
288 |
zthe(ii, jj) = 57.29577951 * atan2(xm, xl) / 2. * mask_tmp(ii, jj) |
zthe(ii, jj) = 57.29577951 * atan2(xm, xl) / 2. * mask_tmp(ii, jj) |
289 |
zphi(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj) |
zphi(ii, jj) = zmea0(ii, jj) * mask_tmp(ii, jj) |
290 |
zmea(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj) |
zmea(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj) |
291 |
zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj) |
zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj) |
292 |
zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj) |
zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj) |