--- trunk/Sources/filtrez/filtreg.f	2015/04/29 15:47:56	134
+++ trunk/filtrez/filtreg_scal.f	2018/03/20 09:35:59	265
@@ -1,23 +1,24 @@
-module filtreg_m
+module filtreg_scal_m
 
   IMPLICIT NONE
 
 contains
 
-  SUBROUTINE filtreg(champ, direct, intensive)
+  SUBROUTINE filtreg_scal(champ, direct, intensive)
 
     ! From filtrez/filtreg.F, version 1.1.1.1, 2004/05/19 12:53:09
     ! Author: P. Le Van
     ! Objet : filtre matriciel longitudinal, avec les matrices pr\'ecalcul\'ees
     ! pour l'op\'erateur filtre. 
 
-    USE coefils, ONLY: sddu, sddv, unsddu, unsddv
-    USE dimens_m, ONLY: iim, jjm
-    use inifilr_m, only: jfiltnu, jfiltnv, jfiltsu, jfiltsv, matriceun, &
-         matriceus, matricevn, matricevs, matrinvn, matrinvs
+    USE dimensions, ONLY: iim, jjm
+    use filtreg_hemisph_m, only: filtreg_hemisph
+    USE inifgn_m, ONLY: sddv, unsddv
+    use inifilr_m, only: jfiltnu, jfiltsu, matriceun, matriceus, matrinvn, &
+         matrinvs
     use nr_util, only: assert
 
-    REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv)
+    REAL, intent(inout):: champ(:, :, :) ! (iim + 1, jjm + 1, :)
     ! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e
 
     logical, intent(in):: direct ! filtre direct ou inverse 
@@ -26,150 +27,23 @@
     ! champ intensif ou extensif (pond\'er\'e par les aires)
 
     ! Local:
-    LOGICAL griscal
-    INTEGER nlat ! nombre de latitudes \`a filtrer
-    integer nbniv ! nombre de niveaux verticaux \`a filtrer 
-    INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil
-    INTEGER i, j, l, k
-    REAL eignq(iim), sdd1(iim), sdd2(iim)
-    INTEGER hemisph
+    REAL sdd(iim)
 
     !-----------------------------------------------------------
 
-    call assert(size(champ, 1) == iim + 1, "filtreg iim + 1")
-    nlat = size(champ, 2)
-    nbniv = size(champ, 3)
-    call assert(nlat == jjm .or. nlat == jjm + 1, "filtreg nlat")
-    griscal = nlat == jjm + 1
-
-    IF (.not. direct .AND. nlat == jjm) THEN
-       PRINT *, 'filtreg: inverse filter on scalar grid only'
-       STOP 1
-    END IF
-
-    IF (griscal) THEN
-       IF (intensive) THEN
-          sdd1 = sddv
-          sdd2 = unsddv
-       ELSE
-          sdd1 = unsddv
-          sdd2 = sddv
-       END IF
-
-       jdfil1 = 2
-       jffil1 = jfiltnu
-       jdfil2 = jfiltsu
-       jffil2 = jjm
-    ELSE
-       IF (intensive) THEN
-          sdd1 = sddu
-          sdd2 = unsddu
-       ELSE
-          sdd1 = unsddu
-          sdd2 = sddu
-       END IF
-
-       jdfil1 = 1
-       jffil1 = jfiltnv
-       jdfil2 = jfiltsv
-       jffil2 = jjm
-    END IF
-
-    loop_hemisph: DO hemisph = 1, 2
-       IF (hemisph==1) THEN
-          jdfil = jdfil1
-          jffil = jffil1
-       ELSE
-          jdfil = jdfil2
-          jffil = jffil2
-       END IF
-
-       loop_vertical: DO l = 1, nbniv
-          loop_latitude: DO j = jdfil, jffil
-             DO i = 1, iim
-                champ(i, j, l) = champ(i, j, l)*sdd1(i)
-             END DO
-
-             IF (hemisph==1) THEN
-                IF (.not. direct) THEN
-                   DO k = 1, iim
-                      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
-                ELSE IF (griscal) THEN
-                   DO k = 1, iim
-                      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
-                ELSE
-                   DO k = 1, iim
-                      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
-                END IF
-             ELSE
-                IF (.not. direct) THEN
-                   DO k = 1, iim
-                      eignq(k) = 0.
-                   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
-                ELSE IF (griscal) THEN
-                   DO k = 1, iim
-                      eignq(k) = 0.
-                   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
-                ELSE
-                   DO k = 1, iim
-                      eignq(k) = 0.
-                   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
-                END IF
-             END IF
-
-             IF (direct) THEN
-                DO i = 1, iim
-                   champ(i, j, l) = (champ(i, j, l)+eignq(i))*sdd2(i)
-                end DO
-             ELSE
-                DO i = 1, iim
-                   champ(i, j, l) = (champ(i, j, l)-eignq(i))*sdd2(i)
-                end DO
-             END IF
-
-             champ(iim + 1, j, l) = champ(1, j, l)
-          END DO loop_latitude
-       END DO loop_vertical
-    end DO loop_hemisph
+    call assert(size(champ, 1) == iim + 1, "filtreg_scal iim + 1")
+    call assert(size(champ, 2) == jjm + 1, "filtreg_scal jjm + 1")
 
-  END SUBROUTINE filtreg
+    sdd = merge(sddv, unsddv, intensive)
 
-end module filtreg_m
+    if (direct) then
+       call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd, matriceun)
+       call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd, matriceus)
+    else
+       call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd, - matrinvn)
+       call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd, - matrinvs)
+    end if
+
+  END SUBROUTINE filtreg_scal
+
+end module filtreg_scal_m