8 |
|
|
9 |
! From filtrez/filtreg.F, version 1.1.1.1, 2004/05/19 12:53:09 |
! From filtrez/filtreg.F, version 1.1.1.1, 2004/05/19 12:53:09 |
10 |
! Author: P. Le Van |
! Author: P. Le Van |
11 |
! Objet : filtre matriciel longitudinal, avec les matrices précalculées |
! Objet : filtre matriciel longitudinal, avec les matrices pr\'ecalcul\'ees |
12 |
! pour l'opérateur filtre. |
! pour l'op\'erateur filtre. |
13 |
|
|
14 |
USE coefils, ONLY: sddu, sddv, unsddu, unsddv |
USE coefils, ONLY: sddu, sddv, unsddu, unsddv |
15 |
USE dimens_m, ONLY: iim, jjm |
USE dimens_m, ONLY: iim, jjm |
18 |
use nr_util, only: assert |
use nr_util, only: assert |
19 |
|
|
20 |
REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv) |
REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv) |
21 |
! en entrée : champ à filtrer, en sortie : champ filtré |
! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e |
22 |
|
|
23 |
logical, intent(in):: direct ! filtre direct ou inverse |
logical, intent(in):: direct ! filtre direct ou inverse |
24 |
|
|
25 |
logical, intent(in):: intensive |
logical, intent(in):: intensive |
26 |
! champ intensif ou extensif (pondéré par les aires) |
! champ intensif ou extensif (pond\'er\'e par les aires) |
27 |
|
|
28 |
! Local: |
! Local: |
29 |
LOGICAL griscal |
LOGICAL griscal |
30 |
INTEGER nlat ! nombre de latitudes à filtrer |
INTEGER nlat ! nombre de latitudes \`a filtrer |
31 |
integer nbniv ! nombre de niveaux verticaux à filtrer |
integer nbniv ! nombre de niveaux verticaux \`a filtrer |
32 |
INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil |
INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil |
33 |
INTEGER i, j, l, k |
INTEGER j, l |
34 |
REAL eignq(iim), sdd1(iim), sdd2(iim) |
REAL eignq(iim), sdd1(iim), sdd2(iim) |
35 |
INTEGER hemisph |
INTEGER hemisph |
36 |
|
|
84 |
jffil = jffil2 |
jffil = jffil2 |
85 |
END IF |
END IF |
86 |
|
|
87 |
loop_vertical: DO l = 1, nbniv |
DO l = 1, nbniv |
88 |
loop_latitude: DO j = jdfil, jffil |
DO j = jdfil, jffil |
89 |
DO i = 1, iim |
champ(:iim, j, l) = champ(:iim, j, l) * sdd1 |
|
champ(i, j, l) = champ(i, j, l)*sdd1(i) |
|
|
END DO |
|
90 |
|
|
91 |
IF (hemisph==1) THEN |
IF (hemisph==1) THEN |
92 |
IF (.not. direct) THEN |
IF (.not. direct) THEN |
93 |
DO k = 1, iim |
eignq = matmul(matrinvn(:, :, j), champ(:iim, j, l)) |
|
eignq(k) = 0. |
|
|
END DO |
|
|
DO k = 1, iim |
|
|
DO i = 1, iim |
|
|
eignq(k) = eignq(k) + matrinvn(k, i, j)*champ(i, j, l) |
|
|
END DO |
|
|
END DO |
|
94 |
ELSE IF (griscal) THEN |
ELSE IF (griscal) THEN |
95 |
DO k = 1, iim |
eignq = matmul(matriceun(:, :, j), champ(:iim, j, l)) |
|
eignq(k) = 0. |
|
|
END DO |
|
|
DO i = 1, iim |
|
|
DO k = 1, iim |
|
|
eignq(k) = eignq(k) + matriceun(k, i, j) & |
|
|
* champ(i, j, l) |
|
|
END DO |
|
|
END DO |
|
96 |
ELSE |
ELSE |
97 |
DO k = 1, iim |
eignq = matmul(matricevn(:, :, j), champ(:iim, j, l)) |
|
eignq(k) = 0. |
|
|
END DO |
|
|
DO i = 1, iim |
|
|
DO k = 1, iim |
|
|
eignq(k) = eignq(k) + matricevn(k, i, j) & |
|
|
* champ(i, j, l) |
|
|
END DO |
|
|
END DO |
|
98 |
END IF |
END IF |
99 |
ELSE |
ELSE |
100 |
IF (.not. direct) THEN |
IF (.not. direct) THEN |
101 |
DO k = 1, iim |
eignq = matmul(matrinvs(:, :, j - jfiltsu + 1), & |
102 |
eignq(k) = 0. |
champ(:iim, j, l)) |
|
END DO |
|
|
DO i = 1, iim |
|
|
DO k = 1, iim |
|
|
eignq(k) = eignq(k) + matrinvs(k, i, j-jfiltsu+1) & |
|
|
*champ(i, j, l) |
|
|
END DO |
|
|
END DO |
|
103 |
ELSE IF (griscal) THEN |
ELSE IF (griscal) THEN |
104 |
DO k = 1, iim |
eignq = matmul(matriceus(:, :, j - jfiltsu + 1), & |
105 |
eignq(k) = 0. |
champ(:iim, j, l)) |
|
END DO |
|
|
DO i = 1, iim |
|
|
DO k = 1, iim |
|
|
eignq(k) = eignq(k) + matriceus(k, i, j-jfiltsu+1) & |
|
|
*champ(i, j , l) |
|
|
END DO |
|
|
END DO |
|
106 |
ELSE |
ELSE |
107 |
DO k = 1, iim |
eignq = matmul(matricevs(:, :, j - jfiltsv + 1), & |
108 |
eignq(k) = 0. |
champ(:iim, j, l)) |
|
END DO |
|
|
DO i = 1, iim |
|
|
DO k = 1, iim |
|
|
eignq(k) = eignq(k) + matricevs(k, i, j-jfiltsv+1) & |
|
|
*champ(i, j , l) |
|
|
END DO |
|
|
END DO |
|
109 |
END IF |
END IF |
110 |
END IF |
END IF |
111 |
|
|
112 |
IF (direct) THEN |
IF (direct) THEN |
113 |
DO i = 1, iim |
champ(:iim, j, l) = (champ(:iim, j, l) + eignq) * sdd2 |
|
champ(i, j, l) = (champ(i, j, l)+eignq(i))*sdd2(i) |
|
|
end DO |
|
114 |
ELSE |
ELSE |
115 |
DO i = 1, iim |
champ(:iim, j, l) = (champ(:iim, j, l) - eignq) * sdd2 |
|
champ(i, j, l) = (champ(i, j, l)-eignq(i))*sdd2(i) |
|
|
end DO |
|
116 |
END IF |
END IF |
117 |
|
|
118 |
champ(iim + 1, j, l) = champ(1, j, l) |
champ(iim + 1, j, l) = champ(1, j, l) |
119 |
END DO loop_latitude |
END DO |
120 |
END DO loop_vertical |
END DO |
121 |
end DO |
end DO |
122 |
|
|
123 |
END SUBROUTINE filtreg |
END SUBROUTINE filtreg |