7 |
SUBROUTINE filtreg(champ, nlat, nbniv, ifiltre, iaire, griscal, iter) |
SUBROUTINE filtreg(champ, nlat, nbniv, ifiltre, iaire, griscal, iter) |
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écalculées |
12 |
! pour l'opérateur filtre. |
! pour l'opérateur filtre. |
13 |
|
|
14 |
USE dimens_m, ONLY : iim, jjm |
USE dimens_m, ONLY : iim, jjm |
15 |
USE parafilt, ONLY : nfilun, nfilus, nfilvn, nfilvs |
USE parafilt, ONLY: matriceun, matriceus, matricevn, matricevs, matrinvn, & |
16 |
|
matrinvs |
17 |
USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, & |
USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, & |
18 |
unsddu, unsddv |
unsddu, unsddv |
19 |
|
|
48 |
|
|
49 |
INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil |
INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil |
50 |
INTEGER i, j, l, k |
INTEGER i, j, l, k |
|
REAL matriceun, matriceus, matricevn, matricevs, matrinvn, matrinvs |
|
|
COMMON /matrfil/matriceun(iim, iim, nfilun), matriceus(iim, iim, nfilus), & |
|
|
matricevn(iim, iim, nfilvn), matricevs(iim, iim, nfilvs), & |
|
|
matrinvn(iim, iim, nfilun), matrinvs(iim, iim, nfilus) |
|
51 |
REAL eignq(iim), sdd1(iim), sdd2(iim) |
REAL eignq(iim), sdd1(iim), sdd2(iim) |
52 |
INTEGER hemisph |
INTEGER hemisph |
53 |
|
|
81 |
ELSE |
ELSE |
82 |
|
|
83 |
IF (iaire==1) THEN |
IF (iaire==1) THEN |
84 |
CALL scopy(iim, sddv, 1, sdd1, 1) |
sdd1 = sddv |
85 |
CALL scopy(iim, unsddv, 1, sdd2, 1) |
sdd2 = unsddv |
86 |
ELSE |
ELSE |
87 |
CALL scopy(iim, unsddv, 1, sdd1, 1) |
sdd1 = unsddv |
88 |
CALL scopy(iim, sddv, 1, sdd2, 1) |
sdd2 = sddv |
89 |
END IF |
END IF |
90 |
|
|
91 |
jdfil1 = 2 |
jdfil1 = 2 |
100 |
ELSE |
ELSE |
101 |
|
|
102 |
IF (iaire==1) THEN |
IF (iaire==1) THEN |
103 |
CALL scopy(iim, sddu, 1, sdd1, 1) |
sdd1 = sddu |
104 |
CALL scopy(iim, unsddu, 1, sdd2, 1) |
sdd2 = unsddu |
105 |
ELSE |
ELSE |
106 |
CALL scopy(iim, unsddu, 1, sdd1, 1) |
sdd1 = unsddu |
107 |
CALL scopy(iim, sddu, 1, sdd2, 1) |
sdd2 = sddu |
108 |
END IF |
END IF |
109 |
|
|
110 |
jdfil1 = 1 |
jdfil1 = 1 |
152 |
END DO |
END DO |
153 |
DO i = 1, iim |
DO i = 1, iim |
154 |
DO k = 1, iim |
DO k = 1, iim |
155 |
eignq(k) = eignq(k) + matriceun(k, i, j)*champ(i, j, l) |
eignq(k) = eignq(k) + matriceun(k, i, j) & |
156 |
|
* champ(i, j, l) |
157 |
END DO |
END DO |
158 |
END DO |
END DO |
159 |
ELSE |
ELSE |
162 |
END DO |
END DO |
163 |
DO i = 1, iim |
DO i = 1, iim |
164 |
DO k = 1, iim |
DO k = 1, iim |
165 |
eignq(k) = eignq(k) + matricevn(k, i, j)*champ(i, j, l) |
eignq(k) = eignq(k) + matricevn(k, i, j) & |
166 |
|
* champ(i, j, l) |
167 |
END DO |
END DO |
168 |
END DO |
END DO |
169 |
END IF |
END IF |