source: trunk/LMDZ.COMMON/libf/dyn3d/groupeun.F @ 3493

Last change on this file since 3493 was 1572, checked in by emillour, 8 years ago

All GCMs:
Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation (up to rev r2500 of LMDZ5)

  • arch:
  • remove ifort debug option '-check all', replace it with '-check bounds,format,output_conversion,pointers,uninit' (i.e. get it to stop complaining about copying into temporary arrays)
  • dyn3d_common:
  • comconst_mod.F90 : add ngroup
  • dyn3d:
  • gcm.F90 : minor bug fix (arguments to a call_abort())
  • leapfrog.F90 : recompute geopotential for bilan_dyn outputs
  • conf_gcm.F90 : read "ngroup" from run.def
  • groupe.F , groupeun.F : ngroup no longer a local parameter
  • dyn3d_par:
  • conf_gcm.F90 : read "ngroup" from run.def
  • groupe_p.F , groupeun_p.F : ngroup no longer a local parameter
  • misc:
  • regr1_step_av_m.F90 : removed (not used)
  • phy_common:
  • mod_phys_lmdz_mpi_transfert.F90 , mod_phys_lmdz_mpi_data.F90 : change is_north_pole and is_south_pole to is_north_pole_dyn and is_south_pole_dyn
  • mod_phys_lmdz_omp_data.F90 : introduce is_nort_pole_phy and is_south_pole_phy
  • dynphy_lonlat:
  • mod_interface_dyn_phys.F90 : use is_north_pole_dyn and is_south_pole_dyn
  • calfis_p.F : use is_north_pole_dyn and is_south_pole_dyn
  • phyvenus:
  • physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.
  • phytitan:
  • physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.

EM
File size: 5.1 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE groupeun(jjmax,llmax,q)
5     
6      USE comconst_mod, ONLY: ngroup
7      IMPLICIT NONE
8
9#include "dimensions.h"
10#include "paramet.h"
11#include "comgeom2.h"
12
13      INTEGER jjmax,llmax
14      REAL q(iip1,jjmax,llmax)
15
16!      INTEGER ngroup
17!      PARAMETER (ngroup=3)
18
19      REAL airecn,qn
20      REAL airecs,qs
21
22      INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
23
24c--------------------------------------------------------------------c
25c Strategie d'optimisation                                           c
26c stocker les valeurs systematiquement recalculees                   c
27c et identiques d'un pas de temps sur l'autre. Il s'agit des         c
28c aires des cellules qui sont sommees. S'il n'y a pas de changement  c
29c de grille au cours de la simulation tout devrait bien se passer.   c
30c Autre optimisation : determination des bornes entre lesquelles "j" c
31c varie, au lieu de faire un test à chaque fois...
32c--------------------------------------------------------------------c
33
34      INTEGER j_start, j_finish
35
36      REAL, SAVE :: airen_tab(iip1,jjp1,0:1)
37      REAL, SAVE :: aires_tab(iip1,jjp1,0:1)
38
39      LOGICAL, SAVE :: first = .TRUE.
40!      INTEGER,SAVE :: i_index(iim,ngroup)
41      INTEGER      :: offset
42!      REAL         :: qsum(iim/ngroup)
43
44      IF (first) THEN
45         CALL INIT_GROUPEUN(airen_tab, aires_tab)
46         first = .FALSE.
47      ENDIF
48
49
50c Champs 3D
51      jd=jjp1-jjmax
52c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
53      DO l=1,llm
54         j1=1+jd
55         j2=2
56         DO ig=1,ngroup
57
58c     Concerne le pole nord
59            j_start  = j1-jd
60            j_finish = j2-jd
61            DO ig2=1,ngroup-ig+1
62              offset=2**(ig2-1)
63              DO j=j_start, j_finish
64!CDIR NODEP
65!CDIR ON_ADB(q)
66                 DO i0=1,iim,2**ig2
67                   q(i0,j,l)=q(i0,j,l)+q(i0+offset,j,l)
68                 ENDDO
69              ENDDO
70            ENDDO
71           
72            DO j=j_start, j_finish
73!CDIR NODEP
74!CDIR ON_ADB(q)
75               DO i=1,iim
76                 q(i,j,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),j,l)
77               ENDDO
78            ENDDO
79
80            DO j=j_start, j_finish
81!CDIR ON_ADB(airen_tab)
82!CDIR ON_ADB(q)
83               DO i=1,iim
84                 q(i,j,l)=q(i,j,l)*airen_tab(i,j,jd)
85               ENDDO
86               q(iip1,j,l)=q(1,j,l)
87            ENDDO
88       
89!c     Concerne le pole sud
90            j_start  = j1-jd
91            j_finish = j2-jd
92            DO ig2=1,ngroup-ig+1
93              offset=2**(ig2-1)
94              DO j=j_start, j_finish
95!CDIR NODEP
96!CDIR ON_ADB(q)
97                 DO i0=1,iim,2**ig2
98                   q(i0,jjp1-j+1-jd,l)= q(i0,jjp1-j+1-jd,l)
99     &                                 +q(i0+offset,jjp1-j+1-jd,l)
100                 ENDDO
101              ENDDO
102            ENDDO
103
104
105            DO j=j_start, j_finish
106!CDIR NODEP
107!CDIR ON_ADB(q)
108               DO i=1,iim
109                 q(i,jjp1-j+1-jd,l)=q(i-MOD(i-1,2**(ngroup-ig+1)),
110     &                                jjp1-j+1-jd,l)
111               ENDDO
112            ENDDO
113
114            DO j=j_start, j_finish
115!CDIR ON_ADB(aires_tab)
116!CDIR ON_ADB(q)
117               DO i=1,iim
118                 q(i,jjp1-j+1-jd,l)=q(i,jjp1-j+1-jd,l)* 
119     &                              aires_tab(i,jjp1-j+1,jd)
120               ENDDO
121               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
122            ENDDO
123
124       
125            j1=j2+1
126            j2=j2+2**ig
127         ENDDO
128      ENDDO
129!$OMP END DO NOWAIT
130
131      RETURN
132      END
133     
134     
135     
136     
137      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
138
139      USE comconst_mod, ONLY: ngroup
140      IMPLICIT NONE
141
142#include "dimensions.h"
143#include "paramet.h"
144#include "comgeom2.h"
145
146!      INTEGER ngroup
147!      PARAMETER (ngroup=3)
148
149      REAL airen,airecn
150      REAL aires,airecs
151
152      INTEGER i,j,l,ig,j1,j2,i0,jd
153
154      INTEGER j_start, j_finish
155
156      REAL :: airen_tab(iip1,jjp1,0:1)
157      REAL :: aires_tab(iip1,jjp1,0:1)
158
159      DO jd=0, 1
160         j1=1+jd
161         j2=2
162         DO ig=1,ngroup
163           
164!     c     Concerne le pole nord
165            j_start = j1-jd
166            j_finish = j2-jd
167            DO j=j_start, j_finish
168               DO i0=1,iim,2**(ngroup-ig+1)
169                  airen=0.
170                  DO i=i0,i0+2**(ngroup-ig+1)-1
171                     airen = airen+aire(i,j)
172                  ENDDO
173                  DO i=i0,i0+2**(ngroup-ig+1)-1
174                     airen_tab(i,j,jd) =
175     &                    aire(i,j) / airen
176                  ENDDO
177               ENDDO
178            ENDDO
179           
180!     c     Concerne le pole sud
181            j_start = j1-jd
182            j_finish = j2-jd
183            DO j=j_start, j_finish
184               DO i0=1,iim,2**(ngroup-ig+1)
185                  aires=0.
186                  DO i=i0,i0+2**(ngroup-ig+1)-1
187                     aires=aires+aire(i,jjp1-j+1)
188                  ENDDO
189                  DO i=i0,i0+2**(ngroup-ig+1)-1
190                     aires_tab(i,jjp1-j+1,jd) =
191     &                    aire(i,jjp1-j+1) / aires
192                  ENDDO
193               ENDDO
194            ENDDO
195           
196            j1=j2+1
197            j2=j2+2**ig
198         ENDDO
199      ENDDO
200     
201      RETURN
202      END
Note: See TracBrowser for help on using the repository browser.