source: LMDZ5/branches/testing/libf/phylmd/rrtm/sustaonl_mod.F90 @ 1999

Last change on this file since 1999 was 1999, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r1920:1997 into testing branch
  • 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
File size: 10.8 KB
Line 
1MODULE SUSTAONL_MOD
2CONTAINS
3SUBROUTINE SUSTAONL(KMEDIAP,KRESTM)
4
5!**** *SUSTAONL * - Routine to initialize parallel environment
6
7!     Purpose.
8!     --------
9!           Initialize D%NSTA and D%NONL.
10!           Calculation of distribution of grid points to processors :
11!           Splitting of grid in B direction
12
13!**   Interface.
14!     ----------
15!        *CALL* *SUSTAONL *
16
17!        Explicit arguments : KMEDIAP - mean number of grid points per PE
18!        -------------------- KRESTM  - number of PEs with one extra point
19
20!        Implicit arguments :
21!        --------------------
22
23
24!     Method.
25!     -------
26!        See documentation
27
28!     Externals.   NONE.
29!     ----------
30
31!     Reference.
32!     ----------
33!        ECMWF Research Department documentation of the IFS
34
35!     Author.
36!     -------
37!        MPP Group *ECMWF*
38
39!     Modifications.
40!     --------------
41!        Original : 95-10-01
42!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
43!          - removal of LRPOLE in YOMCT0.
44!          - removal of code under LRPOLE.
45!        Modified 98-12-04 C. Fischer: merge with SUESTAONL (Aladin)
46!     ------------------------------------------------------------------
47
48USE PARKIND1  ,ONLY : JPIM     ,JPRB
49!USE MPL_MODULE      ! MPL 4.12.08
50
51USE TPM_GEN
52USE TPM_DIM
53USE TPM_GEOMETRY
54USE TPM_DISTR
55
56USE SET2PE_MOD
57USE ABORT_TRANS_MOD
58USE EQ_REGIONS_MOD
59
60IMPLICIT NONE
61
62
63!     DUMMY
64INTEGER(KIND=JPIM),INTENT(IN) :: KMEDIAP
65INTEGER(KIND=JPIM),INTENT(IN) :: KRESTM
66
67!     LOCAL
68
69INTEGER(KIND=JPIM) :: IXPTLAT(R%NDGL), ILSTPTLAT(R%NDGL)
70INTEGER(KIND=JPIM) :: ICHK(R%NDLON,R%NDGL), ICOMBUF(R%NDGL*N_REGIONS_EW*2)
71INTEGER(KIND=JPIM) :: I1, I2, IBUFLEN, IDGLG, IDWIDE,&
72             &IGL, IGL1, IGL2, IGLOFF, IGPTA, IGPTOT, &
73             &IGPTPRSETS, IGPTS, IGPTSP, ILEN, ILRECV, &
74             &ILSEND, INPLAT, INXLAT, IPART,  IPOS, &
75             &IPROCB, IPTSRE, IRECV, IPE, &
76             &IREST, ISEND, ITAG, JA, JB, JGL, JL, JNPTSRE
77
78LOGICAL :: LLABORT, LLALLAT
79LOGICAL :: LLP1,LLP2
80
81REAL(KIND=JPRB) ::  ZLAT, ZLAT1
82REAL(KIND=JPRB) :: ZDIVID(R%NDGL),ZXPTLAT(R%NDGL)
83
84!      -----------------------------------------------------------------
85
86LLP1 = NPRINTLEV>0
87LLP2 = NPRINTLEV>1
88
89IDWIDE  = R%NDGL/2
90IBUFLEN = R%NDGL*N_REGIONS_EW*2
91IDGLG   = R%NDGL
92
93I1 = MAX(   1,D%NFRSTLAT(MY_REGION_NS)-D%NFRSTLOFF)
94I2 = MIN(IDGLG,D%NLSTLAT (MY_REGION_NS)-D%NFRSTLOFF)
95
96ILEN = D%NLSTLAT(MY_REGION_NS) - D%NFRSTLAT(MY_REGION_NS)+1
97
98IGPTPRSETS = SUM(G%NLOEN(1:D%NFRSTLAT(MY_REGION_NS)-1))
99
100IGPTOT = SUM(G%NLOEN(1:R%NDGL))
101
102IF (D%LSPLIT) THEN
103  IF( LEQ_REGIONS )THEN
104    IPE=0
105    IGPTA=0
106    DO JA=1,MY_REGION_NS-1
107      DO JB=1,N_REGIONS(JA)
108        IPE=IPE+1
109        IF( IPE <= KRESTM .OR. KRESTM  ==  0)THEN
110          IGPTA  = IGPTA + KMEDIAP
111        ELSE
112          IGPTA  = IGPTA + (KMEDIAP-1)
113        ENDIF
114      ENDDO
115    ENDDO
116    IGPTS=0
117    DO JB=1,N_REGIONS(MY_REGION_NS)
118      IPE=IPE+1
119      IF( IPE <= KRESTM .OR. KRESTM  ==  0 )THEN
120        IGPTS = IGPTS + KMEDIAP
121      ELSE
122        IGPTS = IGPTS + (KMEDIAP-1)
123      ENDIF
124    ENDDO
125  ELSE
126    IF (MY_REGION_NS <= KRESTM.OR.KRESTM == 0) THEN
127      IGPTS = KMEDIAP
128      IGPTA = KMEDIAP*(MY_REGION_NS-1)
129    ELSE
130      IGPTS = KMEDIAP-1
131      IGPTA = KMEDIAP*KRESTM+IGPTS*(MY_REGION_NS-1-KRESTM)
132    ENDIF
133  ENDIF
134ELSE
135  IGPTA = IGPTPRSETS
136  IGPTS = SUM(G%NLOEN(D%NFRSTLAT(MY_REGION_NS):D%NLSTLAT(MY_REGION_NS)))
137ENDIF
138
139IGPTSP = IGPTS/N_REGIONS(MY_REGION_NS)
140IREST = IGPTS-N_REGIONS(MY_REGION_NS)*IGPTSP
141IXPTLAT(1) = IGPTA-IGPTPRSETS+1
142ZXPTLAT(1) = REAL(IXPTLAT(1))
143ILSTPTLAT(1) = G%NLOEN(D%NFRSTLAT(MY_REGION_NS))
144INPLAT = G%NLOEN(D%NFRSTLAT(MY_REGION_NS))-IXPTLAT(1)+1
145DO JGL=2,ILEN
146  IXPTLAT(JGL) = 1
147  ZXPTLAT(JGL) = 1.0_JPRB
148  ILSTPTLAT(JGL) =  G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1)
149  INPLAT = INPLAT+G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1)
150ENDDO
151ILSTPTLAT(ILEN) = G%NLOEN(D%NLSTLAT(MY_REGION_NS))-INPLAT+IGPTS
152
153DO JB=1,N_REGIONS_EW
154  DO JGL=1,R%NDGL+N_REGIONS_NS-1
155    D%NSTA(JGL,JB) = 0
156    D%NONL(JGL,JB) = 0
157  ENDDO
158ENDDO
159
160
161!  grid point decomposition
162!  ---------------------------------------
163LLALLAT = (N_REGIONS_NS == 1)
164DO JGL=1,ILEN
165  ZDIVID(JGL)=REAL(G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1),JPRB)
166ENDDO
167DO JB=1,N_REGIONS(MY_REGION_NS)
168
169  IF (JB <= IREST) THEN
170    IPTSRE = IGPTSP+1
171  ELSE
172    IPTSRE = IGPTSP
173  ENDIF
174
175  IPART=0
176  DO JNPTSRE=1,IPTSRE
177    ZLAT  = 1._JPRB
178    ZLAT1 = 1._JPRB
179    IF (MY_REGION_NS <= D%NAPSETS .AND.(IPART /= 2.OR.LLALLAT)) THEN
180!cdir novector
181      DO JGL=1,ILEN
182        IF (IXPTLAT(JGL)  <=  ILSTPTLAT(JGL)) THEN
183          ZLAT1  = (ZXPTLAT(JGL)-1.0_JPRB)/ZDIVID(JGL)
184          ZLAT   = MIN(ZLAT1,ZLAT)
185          INXLAT = JGL
186          IPART  = 1
187          EXIT
188        ENDIF
189      ENDDO
190    ELSEIF (MY_REGION_NS > N_REGIONS_NS-D%NAPSETS.AND.(IPART /= 1.OR.LLALLAT)) THEN
191!cdir novector
192      DO JGL=1,ILEN
193        IF (IXPTLAT(JGL)  <=  ILSTPTLAT(JGL)) THEN
194          ZLAT1  = (ZXPTLAT(JGL)-1.0_JPRB)/ZDIVID(JGL)
195          ZLAT   = MIN(ZLAT1,ZLAT)
196          INXLAT = JGL
197          IPART  = 2
198          EXIT
199        ENDIF
200      ENDDO
201    ELSE
202!cdir novector
203      DO JGL=1,ILEN
204        IF (IXPTLAT(JGL)  <=  ILSTPTLAT(JGL)) THEN
205          ZLAT1 = (ZXPTLAT(JGL)-1.0_JPRB)/ZDIVID(JGL)
206          IF (ZLAT1 < ZLAT) THEN
207            ZLAT   = ZLAT1
208            INXLAT = JGL
209          ENDIF
210        ENDIF
211      ENDDO
212    ENDIF
213
214    IF (INXLAT >= I1 .AND. INXLAT <= I2) THEN
215      IF (D%NSTA(D%NPTRFLOFF+INXLAT,JB) == 0) THEN
216        D%NSTA(D%NPTRFLOFF+INXLAT,JB) = IXPTLAT(INXLAT)
217      ENDIF
218      D%NONL(D%NPTRFLOFF+INXLAT,JB) = D%NONL(D%NPTRFLOFF+INXLAT,JB)+1
219    ENDIF
220    IXPTLAT(INXLAT) = IXPTLAT(INXLAT)+1
221    ZXPTLAT(INXLAT) = REAL(IXPTLAT(INXLAT),JPRB)
222  ENDDO
223ENDDO
224
225
226! Exchange local partitioning info to produce global view
227!
228
229IF( NPROC > 1 )THEN
230
231  IF( LEQ_REGIONS )THEN
232
233    ITAG = MTAGPART
234    IPOS = 0
235    DO JGL=1,D%NLSTLAT(MY_REGION_NS)-D%NFRSTLAT(MY_REGION_NS)+1
236      IPOS = IPOS+1
237      ICOMBUF(IPOS) = D%NSTA(D%NPTRFLOFF+JGL,MY_REGION_EW)
238      IPOS = IPOS+1
239      ICOMBUF(IPOS) = D%NONL(D%NPTRFLOFF+JGL,MY_REGION_EW)
240    ENDDO
241    IF( IPOS > IBUFLEN )THEN
242      CALL ABORT_TRANS(' SUSTAONL: SEND BUFFER TOO SMALL FOR GLOBAL INFO')
243    ENDIF
244    ILSEND = IPOS
245
246    DO JA=1,N_REGIONS_NS
247      DO JB=1,N_REGIONS(JA)
248        CALL SET2PE(ISEND,JA,JB,0,0)
249        IF(ISEND /= MYPROC) THEN
250!         CALL MPL_SEND(ICOMBUF(1:ILSEND),KDEST=NPRCIDS(ISEND),KTAG=ITAG, &
251!          &   CDSTRING='SUSTAONL:')
252!         MPL 4.12.08
253          CALL ABOR1(' SUSTAONL: JUSTE APRES MPL_SEND')
254        ENDIF
255      ENDDO
256    ENDDO
257
258    DO JA=1,N_REGIONS_NS
259      IGL1 = D%NFRSTLAT(JA)
260      IGL2 = D%NLSTLAT(JA)
261      DO JB=1,N_REGIONS(JA)
262        CALL SET2PE(IRECV,JA,JB,0,0)
263        IF(IRECV /= MYPROC) THEN
264          ILEN = (D%NLSTLAT(JA)-D%NFRSTLAT(JA)+1)*2
265!         CALL MPL_RECV(ICOMBUF(1:ILEN),KSOURCE=NPRCIDS(IRECV),KTAG=ITAG, &
266!          & KOUNT=ILRECV,CDSTRING='SUSTAONL:')
267!         MPL 4.12.08
268          CALL ABOR1(' SUSTAONL: JUSTE APRES MPL_RCV')
269          IPOS = 0
270          DO JGL=IGL1,IGL2
271            IGL = D%NPTRFRSTLAT(JA)+JGL-IGL1
272            IPOS = IPOS+1
273            D%NSTA(IGL,JB) = ICOMBUF(IPOS)
274            IPOS = IPOS+1
275            D%NONL(IGL,JB) = ICOMBUF(IPOS)
276          ENDDO
277        ENDIF
278      ENDDO
279    ENDDO
280
281  ELSE
282
283    ITAG = MTAGPART
284    IPOS = 0
285    DO JB=1,N_REGIONS(MY_REGION_NS)
286      DO JGL=1,D%NLSTLAT(MY_REGION_NS)-D%NFRSTLAT(MY_REGION_NS)+1
287        IPOS = IPOS+1
288        ICOMBUF(IPOS) = D%NSTA(D%NPTRFLOFF+JGL,JB)
289        IPOS = IPOS+1
290        ICOMBUF(IPOS) = D%NONL(D%NPTRFLOFF+JGL,JB)
291      ENDDO
292    ENDDO
293    IF( IPOS > IBUFLEN )THEN
294      CALL ABORT_TRANS(' SUSTAONL: SEND BUFFER TOO SMALL FOR GLOBAL INFO')
295    ENDIF
296    ILSEND = IPOS
297    DO JA=1,N_REGIONS_NS
298      CALL SET2PE(ISEND,JA,MY_REGION_EW,0,0)
299      IF(ISEND /= MYPROC) THEN
300!       CALL MPL_SEND(ICOMBUF(1:ILSEND),KDEST=NPRCIDS(ISEND),KTAG=ITAG, &
301!        &   CDSTRING='SUSTAONL:')
302!         MPL 4.12.08
303          CALL ABOR1(' SUSTAONL: JUSTE APRES MPL_SEND')
304      ENDIF
305    ENDDO
306
307    DO JA=1,N_REGIONS_NS
308      CALL SET2PE(IRECV,JA,MY_REGION_EW,0,0)
309      IF(IRECV /= MYPROC) THEN
310        ILEN = (D%NLSTLAT(JA)-D%NFRSTLAT(JA)+1)*N_REGIONS(JA)*2
311!       CALL MPL_RECV(ICOMBUF(1:ILEN),KSOURCE=NPRCIDS(IRECV),KTAG=ITAG, &
312!        & KOUNT=ILRECV,CDSTRING='SUSTAONL:')
313!         MPL 4.12.08
314          CALL ABOR1(' SUSTAONL: JUSTE APRES MPL_RCV')
315        IGL1 = D%NFRSTLAT(JA)
316        IGL2 = D%NLSTLAT(JA)
317        IPOS = 0
318        DO JB=1,N_REGIONS(JA)
319          DO JGL=IGL1,IGL2
320            IGL = D%NPTRFRSTLAT(JA)+JGL-IGL1
321            IPOS = IPOS+1
322            D%NSTA(IGL,JB) = ICOMBUF(IPOS)
323            IPOS = IPOS+1
324            D%NONL(IGL,JB) = ICOMBUF(IPOS)
325          ENDDO
326        ENDDO
327      ENDIF
328    ENDDO
329
330  ENDIF
331
332ENDIF
333
334! Confirm consistency of global partitioning, specifically testing for
335! multiple assignments of same grid point and unassigned grid points
336
337LLABORT = .FALSE.
338DO JGL=1,R%NDGL
339  DO JL=1,G%NLOEN(JGL)
340    ICHK(JL,JGL) = 1
341  ENDDO
342ENDDO
343DO JA=1,N_REGIONS_NS
344  IGLOFF = D%NPTRFRSTLAT(JA)
345  DO JB=1,N_REGIONS(JA)
346    IGL1 = D%NFRSTLAT(JA)
347    IGL2 = D%NLSTLAT(JA)
348    DO JGL=IGL1,IGL2
349      IGL = IGLOFF+JGL-IGL1
350      DO JL=D%NSTA(IGL,JB),D%NSTA(IGL,JB)+D%NONL(IGL,JB)-1
351        IF( ICHK(JL,JGL) /= 1 )THEN
352          WRITE(NOUT,'(" SUSTAONL : seta=",i4," setb=",i4,&
353           &" row=",I4," sta=",I4," INVALID GRID POINT")')&
354           &JA,JB,JGL,JL
355          WRITE(0,'(" SUSTAONL : seta=",i4," setb=",i4,&
356           &" ROW=",I4," sta=",I4," INVALID GRID POINT")')&
357           &JA,JB,JGL,JL
358          LLABORT = .TRUE.
359        ENDIF
360        ICHK(JL,JGL) = 2
361      ENDDO
362    ENDDO
363  ENDDO
364ENDDO
365DO JGL=1,R%NDGL
366  DO JL=1,G%NLOEN(JGL)
367    IF( ICHK(JL,JGL) /= 2 )THEN
368      WRITE(NOUT,'(" SUSTAONL : row=",i4," sta=",i4,&
369       &" GRID POINT NOT ASSIGNED")') JGL,JL
370      LLABORT = .TRUE.
371    ENDIF
372  ENDDO
373ENDDO
374IF( LLABORT )THEN
375  WRITE(NOUT,'(" SUSTAONL : inconsistent partitioning")')
376  CALL ABORT_TRANS(' SUSTAONL: inconsistent partitioning')
377ENDIF
378
379
380IF (LLP1) THEN
381  WRITE(UNIT=NOUT,FMT='('' OUTPUT FROM ROUTINE SUSTAONL '')')
382  WRITE(UNIT=NOUT,FMT='('' '')')
383  WRITE(UNIT=NOUT,FMT='('' PARTITIONING INFORMATION '')')
384  WRITE(UNIT=NOUT,FMT='('' '')')
385  IPROCB = MIN(32,N_REGIONS_EW)
386  WRITE(UNIT=NOUT,FMT='(17X," SETB=",32(1X,I3))') (JB,JB=1,IPROCB)
387  DO JA=1,N_REGIONS_NS
388    IPROCB = MIN(32,N_REGIONS(JA))
389    WRITE(UNIT=NOUT,FMT='('' '')')
390    IGLOFF = D%NPTRFRSTLAT(JA)
391    IGL1 = D%NFRSTLAT(JA)
392    IGL2 = D%NLSTLAT(JA)
393    DO JGL=IGL1,IGL2
394      IGL=IGLOFF+JGL-IGL1
395      WRITE(UNIT=NOUT,FMT='(" SETA=",I3," LAT=",I3," NSTA=",&
396       &32(1X,I3))') JA,JGL,(D%NSTA(IGL,JB),JB=1,IPROCB)
397      WRITE(UNIT=NOUT,FMT='(" SETA=",I3," LAT=",I3," D%NONL=",&
398       &32(1X,I3))') JA,JGL,(D%NONL(IGL,JB),JB=1,IPROCB)
399      WRITE(UNIT=NOUT,FMT='('' '')')
400    ENDDO
401    WRITE(UNIT=NOUT,FMT='('' '')')
402  ENDDO
403  WRITE(UNIT=NOUT,FMT='('' '')')
404  WRITE(UNIT=NOUT,FMT='('' '')')
405ENDIF
406
407!     ------------------------------------------------------------------
408
409END SUBROUTINE SUSTAONL
410END MODULE SUSTAONL_MOD
411
Note: See TracBrowser for help on using the repository browser.