Changeset 1257


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ4/branches/LMDZ4-dev/libf/dyn3d/groupeun.F

    r1087 r1257  
    1919      REAL airecs,qs
    2020
    21       INTEGER i,j,l,ig,j1,j2,i0,jd
     21      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
    2222
    2323c--------------------------------------------------------------------c
     
    3737
    3838      LOGICAL, SAVE :: first = .TRUE.
     39      INTEGER,SAVE :: i_index(iim,ngroup)
     40      INTEGER      :: offset
     41      REAL         :: qsum(iim/ngroup)
    3942
    4043      IF (first) THEN
     
    4346      ENDIF
    4447
     48
    4549c Champs 3D
    4650      jd=jjp1-jjmax
    47 
     51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    4852      DO l=1,llm
    4953         j1=1+jd
     
    5458            j_start  = j1-jd
    5559            j_finish = j2-jd
    56             DO j=j_start, j_finish
    57                DO i0=1,iim,2**(ngroup-ig+1)
    58                   qn=0.
    59                   DO i=i0,i0+2**(ngroup-ig+1)-1
    60                      qn=qn+q(i,j,l)
    61                   ENDDO
    62                   DO i=i0,i0+2**(ngroup-ig+1)-1
    63                      q(i,j,l)=qn*airen_tab(i,j,jd)
    64                   ENDDO
     60            DO ig2=1,ngroup-ig+1
     61              offset=2**(ig2-1)
     62              DO j=j_start, j_finish
     63!CDIR NODEP
     64!CDIR ON_ADB(q)
     65                 DO i0=1,iim,2**ig2
     66                   q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l)
     67                 ENDDO
     68              ENDDO
     69            ENDDO
     70           
     71            DO j=j_start, j_finish
     72!CDIR NODEP
     73!CDIR ON_ADB(q)
     74               DO i=1,iim
     75                 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l)
     76               ENDDO
     77            ENDDO
     78
     79            DO j=j_start, j_finish
     80!CDIR ON_ADB(airen_tab)
     81!CDIR ON_ADB(q)
     82               DO i=1,iim
     83                 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd)
    6584               ENDDO
    6685               q(iip1,j,l)=q(1,j,l)
    6786            ENDDO
    68         
     87       
    6988!c     Concerne le pole sud
    7089            j_start  = j1-jd
    7190            j_finish = j2-jd
    72             DO j=j_start, j_finish
    73                DO i0=1,iim,2**(ngroup-ig+1)
    74                   qs=0.
    75                   DO i=i0,i0+2**(ngroup-ig+1)-1
    76                      qs=qs+q(i,jjp1-j+1-jd,l)
    77                   ENDDO
    78                   DO i=i0,i0+2**(ngroup-ig+1)-1
    79                      q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd)
    80                   ENDDO
     91            DO ig2=1,ngroup-ig+1
     92              offset=2**(ig2-1)
     93              DO j=j_start, j_finish
     94!CDIR NODEP
     95!CDIR ON_ADB(q)
     96                 DO i0=1,iim,2**ig2
     97                   q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l)
     98     &                                 +q(i0+offset,jjp1-j+1-jd,l)
     99                 ENDDO
     100              ENDDO
     101            ENDDO
     102
     103
     104            DO j=j_start, j_finish
     105!CDIR NODEP
     106!CDIR ON_ADB(q)
     107               DO i=1,iim
     108                 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),
     109     &                                jjp1-j+1-jd,l)
     110               ENDDO
     111            ENDDO
     112
     113            DO j=j_start, j_finish
     114!CDIR ON_ADB(aires_tab)
     115!CDIR ON_ADB(q)
     116               DO i=1,iim
     117                 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)* 
     118     &                              aires_tab(i,jjp1-j+1,jd)
    81119               ENDDO
    82120               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    83121            ENDDO
     122
    84123       
    85124            j1=j2+1
     
    87126         ENDDO
    88127      ENDDO
     128!$OMP END DO NOWAIT
    89129
    90130      RETURN
    91131      END
    92 
    93 
    94 
     132     
     133     
     134     
     135     
    95136      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
    96137      IMPLICIT NONE
Note: See TracChangeset for help on using the changeset viewer.