1 |
module conf_dat3d_m |
2 |
|
3 |
IMPLICIT NONE |
4 |
|
5 |
contains |
6 |
|
7 |
SUBROUTINE conf_dat3d(xd, yd, zd, xf, yf, zf, champd) |
8 |
|
9 |
! From dyn3d/conf_dat3d.F, version 1.1.1.1 2004/05/19 12:53:05 |
10 |
|
11 |
! Author : P. Le Van |
12 |
|
13 |
! Ce sous-programme configure le champ de données 3D 'champd' pour |
14 |
! que la longitude varie de - pi à pi, la latitude de pi/2 à |
15 |
! - pi/2 et pour que la coordonnée pression soit décroissante. |
16 |
|
17 |
use comconst, only: pi |
18 |
use nr_util, only: assert_eq |
19 |
|
20 |
REAL, intent(in):: xd(:), yd(:) ! longitudes et latitudes initiales, en rad |
21 |
REAL, intent(in):: zd(:) ! pressure levels, in Pa or hPa |
22 |
|
23 |
REAL, intent(out):: xf(:) ! longitude, in rad, - pi to pi |
24 |
REAL, intent(out):: yf(:) ! latitude, in rad, pi/2 to -pi/2 |
25 |
REAL, intent(out):: zf(:) ! pressure levels, in decreasing order, in Pa |
26 |
REAL, intent(inout):: champd(:, :, :) |
27 |
|
28 |
! Variables locales : |
29 |
|
30 |
INTEGER lons, lats, levs |
31 |
LOGICAL invlon |
32 |
REAL rlatmin, rlatmax, oldxd1 |
33 |
INTEGER i |
34 |
|
35 |
!-------------------------------------- |
36 |
|
37 |
lons = assert_eq(size(xd), size(xf), size(champd, 1), "conf_dat3d lons") |
38 |
lats = assert_eq(size(yd), size(yf), size(champd, 2), "conf_dat3d lats") |
39 |
levs = assert_eq(size(zd), size(zf), size(champd, 3), "conf_dat3d levs") |
40 |
|
41 |
IF (xd(1) >= - pi - 0.5 .AND. xd(lons) <= pi + 0.5) THEN |
42 |
invlon = .FALSE. |
43 |
ELSE IF (xd(1) >= -0.5 .AND. xd(lons) <= 2 * pi+0.5) THEN |
44 |
invlon = .TRUE. |
45 |
ELSE |
46 |
print *, 'Problème sur les longitudes des données' |
47 |
stop 1 |
48 |
ENDIF |
49 |
|
50 |
rlatmin = MIN(yd(1), yd(lats)) |
51 |
rlatmax = MAX(yd(1), yd(lats)) |
52 |
|
53 |
IF (rlatmin < -pi / 2 - 0.5 .or. rlatmax > pi / 2 + 0.5) THEN |
54 |
print *, ' Problème sur les latitudes des données' |
55 |
stop 1 |
56 |
ENDIF |
57 |
|
58 |
xf(:) = xd(:) |
59 |
yf(:) = yd(:) |
60 |
|
61 |
IF (invlon) THEN |
62 |
! On tourne les longitudes pour avoir - pi à pi |
63 |
DO i=1, lons |
64 |
IF (xf(i) > pi) exit |
65 |
ENDDO |
66 |
|
67 |
where (xf > pi) xf = xf - 2 * pi |
68 |
xf = cshift(xf, i - 1) |
69 |
! On tourne les longitudes pour "champd": |
70 |
champd = cshift(champd, i - 1) |
71 |
ENDIF |
72 |
|
73 |
IF (yd(1) < yd(lats)) THEN |
74 |
yf = yf(lats:1:-1) |
75 |
champd = champd(:, lats:1:-1, :) |
76 |
ENDIF |
77 |
|
78 |
oldxd1 = xf(1) |
79 |
forall (i = 1: lons-1) xf(i) = 0.5 * (xf(i) + xf(i+1)) |
80 |
xf(lons) = 0.5 * (xf(lons) + oldxd1 + 2 * pi) |
81 |
forall (i = 1: lats-1) yf(i) = 0.5 * (yf(i) + yf(i+1)) |
82 |
|
83 |
IF (MAX(zd(1), zd(levs)) < 1200.) THEN |
84 |
zf(:) = zd(:) * 100. ! convert from hPa to Pa |
85 |
else |
86 |
zf(:) = zd(:) |
87 |
ENDIF |
88 |
|
89 |
IF (zd(1) < zd(levs)) THEN |
90 |
zf(:) = zf(levs:1:-1) |
91 |
champd(:, :, :) = champd(:, :, levs:1:-1) |
92 |
ENDIF |
93 |
|
94 |
END SUBROUTINE conf_dat3d |
95 |
|
96 |
end module conf_dat3d_m |