Changeset 1257 for LMDZ4/branches

Timestamp:

Nov 3, 2009, 10:44:11 AM (15 years ago)

Author:

yann meurdesoif

Message:

modif d'optimisation de dyn3dpar reportée dans dyn3d pour convergence numerique.

YM

File:

• LMDZ4/branches/LMDZ4-dev/libf/dyn3d/groupeun.F (modified) (5 diffs)

LMDZ4/branches/LMDZ4-dev/libf/dyn3d/groupeun.F

@@ -19 +19 @@
       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 +37 @@
 
       LOGICAL, SAVE :: first = .TRUE.
+      INTEGER,SAVE :: i_index(iim,ngroup)
+      INTEGER      :: offset
+      REAL         :: qsum(iim/ngroup)
 
       IF (first) THEN
@@ -43 +46 @@
       ENDIF
 
+
 c Champs 3D
       jd=jjp1-jjmax
-
+c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
       DO l=1,llm
          j1=1+jd
@@ -54 +58 @@
             j_start  = j1-jd
             j_finish = 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  = j1-jd
             j_finish = 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
@@ -87 +126 @@
          ENDDO
       ENDDO
+!$OMP END DO NOWAIT
 
       RETURN
       END
-
-
-
+      
+      
+      
+      
       SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
       IMPLICIT NONE