Ignore:
Timestamp:
Feb 3, 2009, 11:00:25 AM (16 years ago)
Author:
yann meurdesoif
Message:

Optimisation Othman Bouizi : groupeun

YM

Location:
LMDZ4/branches/LMDZ4-dev/libf
Files:
2 edited

Legend:

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

    r524 r1087  
    22! $Header$
    33!
    4       subroutine groupeun(jjmax,llmax,q)
    5       implicit none
     4      SUBROUTINE groupeun(jjmax,llmax,q)
     5      IMPLICIT NONE
    66
    77#include "dimensions.h"
     
    1010#include "comgeom2.h"
    1111
    12       integer jjmax,llmax
    13       real q(iip1,jjmax,llmax)
     12      INTEGER jjmax,llmax
     13      REAL q(iip1,jjmax,llmax)
    1414
    15       integer ngroup
    16       parameter (ngroup=3)
     15      INTEGER ngroup
     16      PARAMETER (ngroup=3)
    1717
    18       real airen,airecn,qn
    19       real aires,airecs,qs
     18      REAL airecn,qn
     19      REAL airecs,qs
    2020
    21       integer i,j,l,ig,j1,j2,i0,jd
     21      INTEGER i,j,l,ig,j1,j2,i0,jd
    2222
    23 Champs 3D
     23c--------------------------------------------------------------------c
     24c Strategie d'optimisation                                           c
     25c stocker les valeurs systematiquement recalculees                   c
     26c et identiques d'un pas de temps sur l'autre. Il s'agit des         c
     27c aires des cellules qui sont sommees. S'il n'y a pas de changement  c
     28c de grille au cours de la simulation tout devrait bien se passer.   c
     29c Autre optimisation : determination des bornes entre lesquelles "j" c
     30c varie, au lieu de faire un test à chaque fois...
     31c--------------------------------------------------------------------c
     32
     33      INTEGER j_start, j_finish
     34
     35      REAL, SAVE :: airen_tab(iip1,jjp1,0:1)
     36      REAL, SAVE :: aires_tab(iip1,jjp1,0:1)
     37
     38      LOGICAL, SAVE :: first = .TRUE.
     39
     40      IF (first) THEN
     41         CALL INIT_GROUPEUN(airen_tab, aires_tab)
     42         first = .FALSE.
     43      ENDIF
     44
     45c Champs 3D
    2446      jd=jjp1-jjmax
    25       do l=1,llm
    26       j1=1+jd
    27       j2=2
    28       do ig=1,ngroup
    29          do j=j1-jd,j2-jd
    30 c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
    31             do i0=1,iim,2**(ngroup-ig+1)
    32                airen=0.
    33                airecn=0.
    34                qn=0.
    35                aires=0.
    36                airecs=0.
    37                qs=0.
    38                do i=i0,i0+2**(ngroup-ig+1)-1
    39                   airen=airen+aire(i,j)
    40                   aires=aires+aire(i,jjp1-j+1)
    41                   qn=qn+q(i,j,l)
    42                   qs=qs+q(i,jjp1-j+1-jd,l)
    43                enddo
    44                airecn=0.
    45                airecs=0.
    46                do i=i0,i0+2**(ngroup-ig+1)-1
    47                   q(i,j,l)=qn*aire(i,j)/airen
    48                   q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
    49                enddo
    50             enddo
    51             q(iip1,j,l)=q(1,j,l)
    52             q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    53          enddo
    54          j1=j2+1
    55          j2=j2+2**ig
    56       enddo
    57       enddo
    5847
    59       return
    60       end
     48      DO l=1,llm
     49         j1=1+jd
     50         j2=2
     51         DO ig=1,ngroup
     52
     53c     Concerne le pole nord
     54            j_start  = j1-jd
     55            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
     65               ENDDO
     66               q(iip1,j,l)=q(1,j,l)
     67            ENDDO
     68       
     69!c     Concerne le pole sud
     70            j_start  = j1-jd
     71            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
     81               ENDDO
     82               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
     83            ENDDO
     84       
     85            j1=j2+1
     86            j2=j2+2**ig
     87         ENDDO
     88      ENDDO
     89
     90      RETURN
     91      END
     92
     93
     94
     95      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
     96      IMPLICIT NONE
     97
     98#include "dimensions.h"
     99#include "paramet.h"
     100#include "comconst.h"
     101#include "comgeom2.h"
     102
     103      INTEGER ngroup
     104      PARAMETER (ngroup=3)
     105
     106      REAL airen,airecn
     107      REAL aires,airecs
     108
     109      INTEGER i,j,l,ig,j1,j2,i0,jd
     110
     111      INTEGER j_start, j_finish
     112
     113      REAL :: airen_tab(iip1,jjp1,0:1)
     114      REAL :: aires_tab(iip1,jjp1,0:1)
     115
     116      DO jd=0, 1
     117         j1=1+jd
     118         j2=2
     119         DO ig=1,ngroup
     120           
     121!     c     Concerne le pole nord
     122            j_start = j1-jd
     123            j_finish = j2-jd
     124            DO j=j_start, j_finish
     125               DO i0=1,iim,2**(ngroup-ig+1)
     126                  airen=0.
     127                  DO i=i0,i0+2**(ngroup-ig+1)-1
     128                     airen = airen+aire(i,j)
     129                  ENDDO
     130                  DO i=i0,i0+2**(ngroup-ig+1)-1
     131                     airen_tab(i,j,jd) =
     132     &                    aire(i,j) / airen
     133                  ENDDO
     134               ENDDO
     135            ENDDO
     136           
     137!     c     Concerne le pole sud
     138            j_start = j1-jd
     139            j_finish = j2-jd
     140            DO j=j_start, j_finish
     141               DO i0=1,iim,2**(ngroup-ig+1)
     142                  aires=0.
     143                  DO i=i0,i0+2**(ngroup-ig+1)-1
     144                     aires=aires+aire(i,jjp1-j+1)
     145                  ENDDO
     146                  DO i=i0,i0+2**(ngroup-ig+1)-1
     147                     aires_tab(i,jjp1-j+1,jd) =
     148     &                    aire(i,jjp1-j+1) / aires
     149                  ENDDO
     150               ENDDO
     151            ENDDO
     152           
     153            j1=j2+1
     154            j2=j2+2**ig
     155         ENDDO
     156      ENDDO
     157     
     158      RETURN
     159      END
  • LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/groupeun_p.F

    r764 r1087  
    1       subroutine groupeun_p(jjmax,llmax,jjb,jje,q)
     1      SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
    22      USE parallel
    3       implicit none
     3      IMPLICIT NONE
    44
    55#include "dimensions.h"
     
    88#include "comgeom2.h"
    99
    10       integer jjmax,llmax,jjb,jje
    11       real q(iip1,jjmax,llmax)
     10      INTEGER jjmax,llmax,jjb,jje
     11      REAL q(iip1,jjmax,llmax)
    1212
    13       integer ngroup
    14       parameter (ngroup=3)
     13      INTEGER ngroup
     14      PARAMETER (ngroup=3)
    1515
    16       real airen,airecn,qn
    17       real aires,airecs,qs
     16      REAL airecn,qn
     17      REAL airecs,qs
    1818
    19       integer i,j,l,ig,j1,j2,i0,jd
     19      INTEGER i,j,l,ig,j1,j2,i0,jd
    2020
    21 Champs 3D
     21c--------------------------------------------------------------------c
     22c Strategie d'optimisation                                           c
     23c stocker les valeurs systematiquement recalculees                   c
     24c et identiques d'un pas de temps sur l'autre. Il s'agit des         c
     25c aires des cellules qui sont sommees. S'il n'y a pas de changement  c
     26c de grille au cours de la simulation tout devrait bien se passer.   c
     27c Autre optimisation : determination des bornes entre lesquelles "j" c
     28c varie, au lieu de faire un test à chaque fois...
     29c--------------------------------------------------------------------c
     30
     31      INTEGER j_start, j_finish
     32
     33      REAL, SAVE :: airen_tab(iip1,jjp1,0:1)
     34      REAL, SAVE :: aires_tab(iip1,jjp1,0:1)
     35!$OMP THREADPRIVATE(airen_tab, aires_tab)
     36
     37      LOGICAL, SAVE :: first = .TRUE.
     38!$OMP THREADPRIVATE(first)
     39
     40      IF (first) THEN
     41         CALL INIT_GROUPEUN_P(airen_tab, aires_tab)
     42         first = .FALSE.
     43      ENDIF
     44
     45c Champs 3D
    2246      jd=jjp1-jjmax
    2347c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    24       do l=1,llm
    25       j1=1+jd
    26       j2=2
    27       do ig=1,ngroup
    28          do j=j1-jd,j2-jd
    29 c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
    30             if ( j >= jjb .AND. j <= jje) THEN
    31              
    32               do i0=1,iim,2**(ngroup-ig+1)
    33                  
    34                  airen=0.
    35                  airecn=0.
    36                  qn=0.
    37                  
    38                  do i=i0,i0+2**(ngroup-ig+1)-1
    39                     airen=airen+aire(i,j)
    40                     qn=qn+q(i,j,l)
    41                  enddo
    42                  airecn=0.
    43                  do i=i0,i0+2**(ngroup-ig+1)-1
    44                    q(i,j,l)=qn*aire(i,j)/airen
    45                  enddo
    46               enddo
    47               q(iip1,j,l)=q(1,j,l)
    48              
    49             endif
     48      DO l=1,llm
     49         j1=1+jd
     50         j2=2
     51         DO ig=1,ngroup
     52
     53c     Concerne le pole nord
     54            j_start  = MAX(jjb, j1-jd)
     55            j_finish = MIN(jje, 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
     65               ENDDO
     66               q(iip1,j,l)=q(1,j,l)
     67            ENDDO
     68       
     69!c     Concerne le pole sud
     70            j_start  = MAX(1+jjp1-jje-jd, j1-jd)
     71            j_finish = MIN(1+jjp1-jjb-jd, 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
     81               ENDDO
     82               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
     83            ENDDO
     84       
     85            j1=j2+1
     86            j2=j2+2**ig
     87         ENDDO
     88      ENDDO
     89!$OMP END DO NOWAIT
     90
     91      RETURN
     92      END
     93
     94
     95
     96      SUBROUTINE INIT_GROUPEUN_P(airen_tab, aires_tab)
     97
     98      USE parallel
     99      IMPLICIT NONE
     100
     101#include "dimensions.h"
     102#include "paramet.h"
     103#include "comconst.h"
     104#include "comgeom2.h"
     105
     106      INTEGER ngroup
     107      PARAMETER (ngroup=3)
     108
     109      REAL airen,airecn
     110      REAL aires,airecs
     111
     112      INTEGER i,j,l,ig,j1,j2,i0,jd
     113
     114      INTEGER j_start, j_finish
     115
     116      REAL :: airen_tab(iip1,jjp1,0:1)
     117      REAL :: aires_tab(iip1,jjp1,0:1)
     118
     119      DO jd=0, 1
     120         j1=1+jd
     121         j2=2
     122         DO ig=1,ngroup
    50123           
    51             if ( jjp1-j+1-jd >= jjb .AND. jjp1-j+1-jd <= jje) THEN
    52              
    53               do i0=1,iim,2**(ngroup-ig+1)
    54                  aires=0.
    55                  airecs=0.
    56                  qs=0.
    57                  do i=i0,i0+2**(ngroup-ig+1)-1
    58                     aires=aires+aire(i,jjp1-j+1)
    59                     qs=qs+q(i,jjp1-j+1-jd,l)
    60                  enddo
    61                  airecs=0.
    62                  do i=i0,i0+2**(ngroup-ig+1)-1
    63                    q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
    64                  enddo
    65               enddo
    66               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    67            
    68             endif
    69          enddo
    70              
    71            j1=j2+1
    72            j2=j2+2**ig
    73       enddo
    74       enddo
    75 c$OMP END DO NOWAIT
    76       return
    77       end
     124!     c     Concerne le pole nord
     125            j_start = j1-jd
     126            j_finish = j2-jd
     127            DO j=j_start, j_finish
     128               DO i0=1,iim,2**(ngroup-ig+1)
     129                  airen=0.
     130                  DO i=i0,i0+2**(ngroup-ig+1)-1
     131                     airen = airen+aire(i,j)
     132                  ENDDO
     133                  DO i=i0,i0+2**(ngroup-ig+1)-1
     134                     airen_tab(i,j,jd) =
     135     &                    aire(i,j) / airen
     136                  ENDDO
     137               ENDDO
     138            ENDDO
     139           
     140!     c     Concerne le pole sud
     141            j_start = j1-jd
     142            j_finish = j2-jd
     143            DO j=j_start, j_finish
     144               DO i0=1,iim,2**(ngroup-ig+1)
     145                  aires=0.
     146                  DO i=i0,i0+2**(ngroup-ig+1)-1
     147                     aires=aires+aire(i,jjp1-j+1)
     148                  ENDDO
     149                  DO i=i0,i0+2**(ngroup-ig+1)-1
     150                     aires_tab(i,jjp1-j+1,jd) =
     151     &                    aire(i,jjp1-j+1) / aires
     152                  ENDDO
     153               ENDDO
     154            ENDDO
     155           
     156            j1=j2+1
     157            j2=j2+2**ig
     158         ENDDO
     159      ENDDO
     160     
     161      RETURN
     162      END
Note: See TracChangeset for help on using the changeset viewer.