source: LMDZ4/trunk/libf/dyn3dpar/groupeun_p.F @ 1187

Last change on this file since 1187 was 1146, checked in by Laurent Fairhead, 16 years ago

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.3 KB
Line 
1      SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
2      USE parallel
3      IMPLICIT NONE
4
5#include "dimensions.h"
6#include "paramet.h"
7#include "comconst.h"
8#include "comgeom2.h"
9
10      INTEGER jjmax,llmax,jjb,jje
11      REAL q(iip1,jjmax,llmax)
12
13      INTEGER ngroup
14      PARAMETER (ngroup=3)
15
16      REAL airecn,qn
17      REAL airecs,qs
18
19      INTEGER i,j,l,ig,j1,j2,i0,jd
20
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
46      jd=jjp1-jjmax
47c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
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
123           
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 TracBrowser for help on using the repository browser.