source: LMDZ5/branches/LMDZ5-DOFOCO/libf/dyn3dmem/groupeun_loc.F @ 4785

Last change on this file since 4785 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 5.2 KB
Line 
1      SUBROUTINE groupeun_loc(jjmax,llmax,sb,se,jjb,jje,q)
2      USE parallel
3      USE Write_Field_p
4      IMPLICIT NONE
5
6#include "dimensions.h"
7#include "paramet.h"
8#include "comconst.h"
9#include "comgeom2.h"
10
11      INTEGER jjmax,llmax,sb,se,jjb,jje
12      REAL q(iip1,sb:se,llmax)
13
14      INTEGER ngroup
15      PARAMETER (ngroup=3)
16
17      REAL airecn,qn
18      REAL airecs,qs
19
20      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
21
22c--------------------------------------------------------------------c
23c Strategie d'optimisation                                           c
24c stocker les valeurs systematiquement recalculees                   c
25c et identiques d'un pas de temps sur l'autre. Il s'agit des         c
26c aires des cellules qui sont sommees. S'il n'y a pas de changement  c
27c de grille au cours de la simulation tout devrait bien se passer.   c
28c Autre optimisation : determination des bornes entre lesquelles "j" c
29c varie, au lieu de faire un test a chaque fois...
30c--------------------------------------------------------------------c
31
32      INTEGER j_start, j_finish
33
34      REAL, SAVE :: airen_tab(iip1,jjp1,0:1)
35      REAL, SAVE :: aires_tab(iip1,jjp1,0:1)
36!$OMP THREADPRIVATE(airen_tab, aires_tab)
37
38      LOGICAL, SAVE :: first = .TRUE.
39!$OMP THREADPRIVATE(first)
40      INTEGER,SAVE :: i_index(iim,ngroup)
41      INTEGER      :: offset
42      REAL         :: qsum(iim/ngroup)
43
44      IF (first) THEN
45         CALL init_groupeun_loc(airen_tab, aires_tab)
46         first = .FALSE.
47      ENDIF
48
49c Champs 3D
50      jd=jjp1-jjmax
51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
52      DO l=1,llm
53         j1=1+jd
54         j2=2
55         DO ig=1,ngroup
56
57c     Concerne le pole nord
58            j_start  = MAX(jjb, j1-jd)
59            j_finish = MIN(jje, j2-jd)
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)
84               ENDDO
85               q(iip1,j,l)=q(1,j,l)
86            ENDDO
87       
88!c     Concerne le pole sud
89            j_start  = MAX(1+jjp1-jje-jd, j1-jd)
90            j_finish = MIN(1+jjp1-jjb-jd, j2-jd)
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)
119               ENDDO
120               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
121            ENDDO
122
123       
124            j1=j2+1
125            j2=j2+2**ig
126         ENDDO
127      ENDDO
128!$OMP END DO NOWAIT
129
130      RETURN
131      END
132
133
134
135      SUBROUTINE init_groupeun_loc(airen_tab, aires_tab)
136
137      USE parallel
138      IMPLICIT NONE
139
140#include "dimensions.h"
141#include "paramet.h"
142#include "comconst.h"
143#include "comgeom2.h"
144
145      INTEGER ngroup
146      PARAMETER (ngroup=3)
147
148      REAL airen,airecn
149      REAL aires,airecs
150
151      INTEGER i,j,l,ig,j1,j2,i0,jd
152
153      INTEGER j_start, j_finish
154
155      REAL :: airen_tab(iip1,jjp1,0:1)
156      REAL :: aires_tab(iip1,jjp1,0:1)
157
158      DO jd=0, 1
159         j1=1+jd
160         j2=2
161         DO ig=1,ngroup
162           
163!     c     Concerne le pole nord
164            j_start = j1-jd
165            j_finish = j2-jd
166            DO j=j_start, j_finish
167               DO i0=1,iim,2**(ngroup-ig+1)
168                  airen=0.
169                  DO i=i0,i0+2**(ngroup-ig+1)-1
170                     airen = airen+aire(i,j)
171                  ENDDO
172                  DO i=i0,i0+2**(ngroup-ig+1)-1
173                     airen_tab(i,j,jd) =
174     &                    aire(i,j) / airen
175                  ENDDO
176               ENDDO
177            ENDDO
178           
179!     c     Concerne le pole sud
180            j_start = j1-jd
181            j_finish = j2-jd
182            DO j=j_start, j_finish
183               DO i0=1,iim,2**(ngroup-ig+1)
184                  aires=0.
185                  DO i=i0,i0+2**(ngroup-ig+1)-1
186                     aires=aires+aire(i,jjp1-j+1)
187                  ENDDO
188                  DO i=i0,i0+2**(ngroup-ig+1)-1
189                     aires_tab(i,jjp1-j+1,jd) =
190     &                    aire(i,jjp1-j+1) / aires
191                  ENDDO
192               ENDDO
193            ENDDO
194           
195            j1=j2+1
196            j2=j2+2**ig
197         ENDDO
198      ENDDO
199     
200      RETURN
201      END
Note: See TracBrowser for help on using the repository browser.