Changeset 1250 for LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/groupeun_p.F

Timestamp:

Oct 29, 2009, 2:55:23 PM (15 years ago)

Author:

yann meurdesoif

Message:

Optimisations SX9

YM

File:

• LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/groupeun_p.F (modified) (4 diffs)

LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/groupeun_p.F

@@ -1 +1 @@
       SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
       USE parallel
+      USE Write_Field_p
       IMPLICIT NONE
 
@@ -17 +18 @@
       REAL airecs,qs
 
-      INTEGER i,j,l,ig,j1,j2,i0,jd
+      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
 
 c--------------------------------------------------------------------c 
@@ -37 +38 @@
       LOGICAL, SAVE :: first = .TRUE.
 !$OMP THREADPRIVATE(first)
+      INTEGER,SAVE :: i_index(iim,ngroup)
+      INTEGER      :: offset
+      REAL         :: qsum(iim/ngroup)
 
       IF (first) THEN
@@ -54 +58 @@
             j_start  = MAX(jjb, j1-jd)
             j_finish = MIN(jje, j2-jd)
-            DO j=j_start, j_finish
-               DO i0=1,iim,2**(ngroup-ig+1)
-                  qn=0.
-                  DO i=i0,i0+2**(ngroup-ig+1)-1
-                     qn=qn+q(i,j,l)
-                  ENDDO
-                  DO i=i0,i0+2**(ngroup-ig+1)-1
-                     q(i,j,l)=qn*airen_tab(i,j,jd)
-                  ENDDO
+            DO ig2=1,ngroup-ig+1
+              offset=2**(ig2-1)
+              DO j=j_start, j_finish
+!CDIR NODEP
+!CDIR ON_ADB(q)
+                 DO i0=1,iim,2**ig2
+                   q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l) 
+                 ENDDO
+              ENDDO
+            ENDDO
+            
+            DO j=j_start, j_finish
+!CDIR NODEP
+!CDIR ON_ADB(q)
+               DO i=1,iim
+                 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l)
+               ENDDO
+            ENDDO
+
+            DO j=j_start, j_finish
+!CDIR ON_ADB(airen_tab)
+!CDIR ON_ADB(q)
+               DO i=1,iim
+                 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd)
                ENDDO
                q(iip1,j,l)=q(1,j,l)
             ENDDO
-        
+       
 !c     Concerne le pole sud
             j_start  = MAX(1+jjp1-jje-jd, j1-jd)
             j_finish = MIN(1+jjp1-jjb-jd, j2-jd)
-            DO j=j_start, j_finish
-               DO i0=1,iim,2**(ngroup-ig+1)
-                  qs=0.
-                  DO i=i0,i0+2**(ngroup-ig+1)-1
-                     qs=qs+q(i,jjp1-j+1-jd,l)
-                  ENDDO
-                  DO i=i0,i0+2**(ngroup-ig+1)-1
-                     q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd)
-                  ENDDO
+            DO ig2=1,ngroup-ig+1
+              offset=2**(ig2-1)
+              DO j=j_start, j_finish
+!CDIR NODEP
+!CDIR ON_ADB(q)
+                 DO i0=1,iim,2**ig2
+                   q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l)
+     &                                 +q(i0+offset,jjp1-j+1-jd,l) 
+                 ENDDO
+              ENDDO
+            ENDDO
+
+
+            DO j=j_start, j_finish
+!CDIR NODEP
+!CDIR ON_ADB(q)
+               DO i=1,iim
+                 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),
+     &                                jjp1-j+1-jd,l)
+               ENDDO
+            ENDDO
+
+            DO j=j_start, j_finish
+!CDIR ON_ADB(aires_tab)
+!CDIR ON_ADB(q)
+               DO i=1,iim
+                 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)*  
+     &                              aires_tab(i,jjp1-j+1,jd)
                ENDDO
                q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
             ENDDO
+
         
             j1=j2+1