source: trunk/LMDZ.COMMON/libf/dyn3dpar/groupeun_p.F @ 3537

Last change on this file since 3537 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.2 KB
RevLine 
[1]1      SUBROUTINE groupeun_p(jjmax,llmax,jjb,jje,q)
[1019]2      USE parallel_lmdz
[1572]3      USE comconst_mod, ONLY: ngroup
[1]4      USE Write_Field_p
5      IMPLICIT NONE
6
7#include "dimensions.h"
8#include "paramet.h"
9#include "comgeom2.h"
10
11      INTEGER jjmax,llmax,jjb,jje
12      REAL q(iip1,jjmax,llmax)
13
[1572]14!      INTEGER ngroup
15!      PARAMETER (ngroup=3)
[1]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 à 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)
[1572]40!      INTEGER,SAVE :: i_index(iim,ngroup)
[1]41      INTEGER      :: offset
[1572]42!      REAL         :: qsum(iim/ngroup)
[1]43
44      IF (first) THEN
45         CALL INIT_GROUPEUN_P(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_P(airen_tab, aires_tab)
136
[1019]137      USE parallel_lmdz
[1572]138      USE comconst_mod, ONLY: ngroup
[1]139      IMPLICIT NONE
140
141#include "dimensions.h"
142#include "paramet.h"
143#include "comgeom2.h"
144
[1572]145!      INTEGER ngroup
146!      PARAMETER (ngroup=3)
[1]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.