LMDZ
groupeun_loc.F
Go to the documentation of this file.
1  SUBROUTINE groupeun_loc(jjmax,llmax,sb,se,jjb,jje,q)
2  USE parallel_lmdz
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 
22 c--------------------------------------------------------------------c
23 c Strategie d'optimisation c
24 c stocker les valeurs systematiquement recalculees c
25 c et identiques d'un pas de temps sur l'autre. Il s'agit des c
26 c aires des cellules qui sont sommees. S'il n'y a pas de changement c
27 c de grille au cours de la simulation tout devrait bien se passer. c
28 c Autre optimisation : determination des bornes entre lesquelles "j" c
29 c varie, au lieu de faire un test a chaque fois...
30 c--------------------------------------------------------------------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 
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 = 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_lmdz
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
init_groupeun_loc
subroutine init_groupeun_loc(airen_tab, aires_tab)
Definition: groupeun_loc.F:136
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
write_field_p
Definition: write_field_p.F90:1
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
groupeun_loc
subroutine groupeun_loc(jjmax, llmax, sb, se, jjb, jje, q)
Definition: groupeun_loc.F:2
parallel_lmdz
Definition: parallel_lmdz.F90:4
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