source: LMDZ5/trunk/libf/dyn3d/groupeun.F @ 2469

Last change on this file since 2469 was 2442, checked in by fhourdin, 9 years ago

ngroup passe du statut de paramètre à constante.

Pour pouvoir l'ajuster en fonction de la resolution
ngroup est maintenant lu dans les .def. ngroup=3 par défaut

ngroup changed from parameter to constant
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.0 KB
RevLine 
[524]1!
2! $Header$
3!
[1146]4      SUBROUTINE groupeun(jjmax,llmax,q)
5      IMPLICIT NONE
[524]6
7#include "dimensions.h"
8#include "paramet.h"
9#include "comconst.h"
10#include "comgeom2.h"
11
[1146]12      INTEGER jjmax,llmax
13      REAL q(iip1,jjmax,llmax)
[524]14
[2442]15!     INTEGER ngroup
16!     PARAMETER (ngroup=3)
[524]17
[1146]18      REAL airecn,qn
19      REAL airecs,qs
[524]20
[1279]21      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
[524]22
[1146]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.
[2442]39!     INTEGER,SAVE :: i_index(iim,ngroup)
[1279]40      INTEGER      :: offset
[2442]41!     REAL         :: qsum(iim/ngroup)
[1146]42
43      IF (first) THEN
44         CALL INIT_GROUPEUN(airen_tab, aires_tab)
45         first = .FALSE.
46      ENDIF
47
[1279]48
[1146]49c Champs 3D
[524]50      jd=jjp1-jjmax
[1279]51c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[1146]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  = j1-jd
59            j_finish = j2-jd
[1279]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           
[1146]71            DO j=j_start, j_finish
[1279]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)
[1146]76               ENDDO
[1279]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
[1146]85               q(iip1,j,l)=q(1,j,l)
86            ENDDO
[1279]87       
[1146]88!c     Concerne le pole sud
89            j_start  = j1-jd
90            j_finish = j2-jd
[1279]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
[1146]104            DO j=j_start, j_finish
[1279]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)
[1146]110               ENDDO
[1279]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
[1146]120               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
121            ENDDO
[1279]122
[1146]123       
124            j1=j2+1
125            j2=j2+2**ig
126         ENDDO
127      ENDDO
[1279]128!$OMP END DO NOWAIT
[1146]129
130      RETURN
131      END
[1279]132     
133     
134     
135     
[1146]136      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
137      IMPLICIT NONE
138
139#include "dimensions.h"
140#include "paramet.h"
141#include "comconst.h"
142#include "comgeom2.h"
143
[2442]144!     INTEGER ngroup
145!     PARAMETER (ngroup=3)
[1146]146
147      REAL airen,airecn
148      REAL aires,airecs
149
150      INTEGER i,j,l,ig,j1,j2,i0,jd
151
152      INTEGER j_start, j_finish
153
154      REAL :: airen_tab(iip1,jjp1,0:1)
155      REAL :: aires_tab(iip1,jjp1,0:1)
156
157      DO jd=0, 1
158         j1=1+jd
159         j2=2
160         DO ig=1,ngroup
161           
162!     c     Concerne le pole nord
163            j_start = j1-jd
164            j_finish = j2-jd
165            DO j=j_start, j_finish
166               DO i0=1,iim,2**(ngroup-ig+1)
167                  airen=0.
168                  DO i=i0,i0+2**(ngroup-ig+1)-1
169                     airen = airen+aire(i,j)
170                  ENDDO
171                  DO i=i0,i0+2**(ngroup-ig+1)-1
172                     airen_tab(i,j,jd) =
173     &                    aire(i,j) / airen
174                  ENDDO
175               ENDDO
176            ENDDO
177           
178!     c     Concerne le pole sud
179            j_start = j1-jd
180            j_finish = j2-jd
181            DO j=j_start, j_finish
182               DO i0=1,iim,2**(ngroup-ig+1)
183                  aires=0.
184                  DO i=i0,i0+2**(ngroup-ig+1)-1
185                     aires=aires+aire(i,jjp1-j+1)
186                  ENDDO
187                  DO i=i0,i0+2**(ngroup-ig+1)-1
188                     aires_tab(i,jjp1-j+1,jd) =
189     &                    aire(i,jjp1-j+1) / aires
190                  ENDDO
191               ENDDO
192            ENDDO
193           
194            j1=j2+1
195            j2=j2+2**ig
196         ENDDO
197      ENDDO
198     
199      RETURN
200      END
Note: See TracBrowser for help on using the repository browser.