Changeset 2125 for LMDZ5/trunk/libf/dyn3dmem

Timestamp:

Sep 24, 2014, 1:14:19 PM (10 years ago)

Author:

Ehouarn Millour

Message:

Bug fix: wrong (implicit) bounds for matmul operations, in the non-FFT filteringcase.
EM

File:

• LMDZ5/trunk/libf/dyn3dmem/mod_filtreg_p.F (modified) (10 diffs)

LMDZ5/trunk/libf/dyn3dmem/mod_filtreg_p.F

@@ -6 +6 @@
      &     ifiltre, iaire, griscal ,iter)
       USE parallel_lmdz, only : OMP_CHUNK
-      USE mod_filtre_fft_loc
-      USE timer_filtre
-      
-      USE filtreg_mod
+      USE mod_filtre_fft_loc, ONLY: use_filtre_fft, filtre_u_fft,
+     &                              filtre_v_fft, filtre_inv_fft
+      USE timer_filtre, ONLY: init_timer, start_timer, stop_timer
+      
+      USE filtreg_mod, ONLY: matrinvn, matrinvs, matriceun, matriceus,
+     &                       matricevn, matricevs
       
       IMPLICIT NONE
@@ -57 +59 @@
 #include "coefils.h"
 c
-      INTEGER jjb,jje,ibeg,iend,nlat,nbniv,ifiltre,iter
+      INTEGER,INTENT(IN) :: jjb,jje,ibeg,iend,nlat,nbniv,ifiltre,iter
+      INTEGER,INTENT(IN) :: iaire
+      LOGICAL,INTENT(IN) :: griscal
+      REAL,INTENT(INOUT) ::  champ( iip1,jjb:jje,nbniv)
+      
       INTEGER i,j,l,k
       INTEGER iim2,immjm
       INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
-      
-      REAL  champ( iip1,jjb:jje,nbniv)
-      
-      LOGICAL    griscal
-      INTEGER    hemisph, iaire
-      
+      INTEGER    hemisph
       REAL :: champ_fft(iip1,jjb:jje,nbniv)
-      REAL :: champ_in(iip1,jjb:jje,nbniv)
+!      REAL :: champ_in(iip1,jjb:jje,nbniv)
       
       LOGICAL,SAVE     :: first=.TRUE.
@@ -216 +217 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matrinvn(:,:,j),
-     &                    champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matrinvn(1:iim,1:iim,j),
+     &                    champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -230 +231 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matriceun(:,:,j),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matriceun(1:iim,1:iim,j),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -244 +245 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matricevn(:,:,j),           
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matricevn(1:iim,1:iim,j),           
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -262 +263 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matrinvs(:,:,j-jfiltsu+1),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matrinvs(1:iim,1:iim,j-jfiltsu+1),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -277 +278 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matriceus(:,:,j-jfiltsu+1),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matriceus(1:iim,1:iim,j-jfiltsu+1),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -292 +293 @@
      &                    champ_fft(1,j,1), iip1*(jje-jjb+1))
 #else
-                     champ_fft(:,j,1:nbniv_loc)=
-     &                    matmul(matricevs(:,:,j-jfiltsv+1),
-     &                           champ_loc(:iim,j,1:nbniv_loc))
+                     champ_fft(1:iim,j,1:nbniv_loc)=
+     &                    matmul(matricevs(1:iim,1:iim,j-jfiltsv+1),
+     &                           champ_loc(1:iim,j,1:nbniv_loc))
 #endif
                   ENDDO
@@ -344 +345 @@
             DO l = 1, nbniv
                DO j = jdfil,jffil
+                  ! add redundant longitude
                   champ( iip1,j,l ) = champ( 1,j,l )
                ENDDO
@@ -406 +408 @@
                DO j=jdfil,jffil
 !            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
+                  ! add redundant longitude
                   champ( iip1,j,l ) = champ( 1,j,l )
                ENDDO