LMDZ
groupeun.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE groupeun(jjmax,llmax,q)
5  IMPLICIT NONE
6 
7 #include "dimensions.h"
8 #include "paramet.h"
9 #include "comconst.h"
10 #include "comgeom2.h"
11 
12  INTEGER jjmax,llmax
13  REAL q(iip1,jjmax,llmax)
14 
15  INTEGER ngroup
16  parameter(ngroup=3)
17 
18  REAL airecn,qn
19  REAL airecs,qs
20 
21  INTEGER i,j,l,ig,ig2,j1,j2,i0,jd
22 
23 c--------------------------------------------------------------------c
24 c Strategie d'optimisation c
25 c stocker les valeurs systematiquement recalculees c
26 c et identiques d'un pas de temps sur l'autre. Il s'agit des c
27 c aires des cellules qui sont sommees. S'il n'y a pas de changement c
28 c de grille au cours de la simulation tout devrait bien se passer. c
29 c Autre optimisation : determination des bornes entre lesquelles "j" c
30 c varie, au lieu de faire un test à chaque fois...
31 c--------------------------------------------------------------------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  INTEGER,SAVE :: i_index(iim,ngroup)
40  INTEGER :: offset
41  REAL :: qsum(iim/ngroup)
42 
43  IF (first) THEN
44  CALL init_groupeun(airen_tab, aires_tab)
45  first = .false.
46  ENDIF
47 
48 
49 c Champs 3D
50  jd=jjp1-jjmax
51 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
52  DO l=1,llm
53  j1=1+jd
54  j2=2
55  DO ig=1,ngroup
56 
57 c Concerne le pole nord
58  j_start = j1-jd
59  j_finish = 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 = j1-jd
90  j_finish = 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 
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 
144  INTEGER ngroup
145  parameter(ngroup=3)
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
init_groupeun
subroutine init_groupeun(airen_tab, aires_tab)
Definition: groupeun.F:137
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
aire
!$Header!CDK comgeom COMMON comgeom aire
Definition: comgeom.h:25
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
jjp1
!$Header jjp1
Definition: paramet.h:14
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
groupeun
subroutine groupeun(jjmax, llmax, q)
Definition: groupeun.F:5