GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/sustaonl_mod.F90 Lines: 0 166 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 146 0.0 %

Line Branch Exec Source
1
MODULE SUSTAONL_MOD
2
CONTAINS
3
SUBROUTINE 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
48
USE PARKIND1  ,ONLY : JPIM     ,JPRB
49
!USE MPL_MODULE      ! MPL 4.12.08
50
51
USE TPM_GEN
52
USE TPM_DIM
53
USE TPM_GEOMETRY
54
USE TPM_DISTR
55
56
USE SET2PE_MOD
57
USE ABORT_TRANS_MOD
58
USE EQ_REGIONS_MOD
59
60
IMPLICIT NONE
61
62
63
!     DUMMY
64
INTEGER(KIND=JPIM),INTENT(IN) :: KMEDIAP
65
INTEGER(KIND=JPIM),INTENT(IN) :: KRESTM
66
67
!     LOCAL
68
69
INTEGER(KIND=JPIM) :: IXPTLAT(R%NDGL), ILSTPTLAT(R%NDGL)
70
INTEGER(KIND=JPIM) :: ICHK(R%NDLON,R%NDGL), ICOMBUF(R%NDGL*N_REGIONS_EW*2)
71
INTEGER(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
78
LOGICAL :: LLABORT, LLALLAT
79
LOGICAL :: LLP1,LLP2
80
81
REAL(KIND=JPRB) ::  ZLAT, ZLAT1
82
REAL(KIND=JPRB) :: ZDIVID(R%NDGL),ZXPTLAT(R%NDGL)
83
84
!      -----------------------------------------------------------------
85
86
LLP1 = NPRINTLEV>0
87
LLP2 = NPRINTLEV>1
88
89
IDWIDE  = R%NDGL/2
90
IBUFLEN = R%NDGL*N_REGIONS_EW*2
91
IDGLG   = R%NDGL
92
93
I1 = MAX(   1,D%NFRSTLAT(MY_REGION_NS)-D%NFRSTLOFF)
94
I2 = MIN(IDGLG,D%NLSTLAT (MY_REGION_NS)-D%NFRSTLOFF)
95
96
ILEN = D%NLSTLAT(MY_REGION_NS) - D%NFRSTLAT(MY_REGION_NS)+1
97
98
IGPTPRSETS = SUM(G%NLOEN(1:D%NFRSTLAT(MY_REGION_NS)-1))
99
100
IGPTOT = SUM(G%NLOEN(1:R%NDGL))
101
102
IF (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
134
ELSE
135
  IGPTA = IGPTPRSETS
136
  IGPTS = SUM(G%NLOEN(D%NFRSTLAT(MY_REGION_NS):D%NLSTLAT(MY_REGION_NS)))
137
ENDIF
138
139
IGPTSP = IGPTS/N_REGIONS(MY_REGION_NS)
140
IREST = IGPTS-N_REGIONS(MY_REGION_NS)*IGPTSP
141
IXPTLAT(1) = IGPTA-IGPTPRSETS+1
142
ZXPTLAT(1) = REAL(IXPTLAT(1))
143
ILSTPTLAT(1) = G%NLOEN(D%NFRSTLAT(MY_REGION_NS))
144
INPLAT = G%NLOEN(D%NFRSTLAT(MY_REGION_NS))-IXPTLAT(1)+1
145
DO 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)
150
ENDDO
151
ILSTPTLAT(ILEN) = G%NLOEN(D%NLSTLAT(MY_REGION_NS))-INPLAT+IGPTS
152
153
DO 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
158
ENDDO
159
160
161
!  grid point decomposition
162
!  ---------------------------------------
163
LLALLAT = (N_REGIONS_NS == 1)
164
DO JGL=1,ILEN
165
  ZDIVID(JGL)=REAL(G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1),JPRB)
166
ENDDO
167
DO 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
223
ENDDO
224
225
226
! Exchange local partitioning info to produce global view
227
!
228
229
IF( 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
332
ENDIF
333
334
! Confirm consistency of global partitioning, specifically testing for
335
! multiple assignments of same grid point and unassigned grid points
336
337
LLABORT = .FALSE.
338
DO JGL=1,R%NDGL
339
  DO JL=1,G%NLOEN(JGL)
340
    ICHK(JL,JGL) = 1
341
  ENDDO
342
ENDDO
343
DO 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
364
ENDDO
365
DO 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
373
ENDDO
374
IF( LLABORT )THEN
375
  WRITE(NOUT,'(" SUSTAONL : inconsistent partitioning")')
376
  CALL ABORT_TRANS(' SUSTAONL: inconsistent partitioning')
377
ENDIF
378
379
380
IF (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='('' '')')
405
ENDIF
406
407
!     ------------------------------------------------------------------
408
409
END SUBROUTINE SUSTAONL
410
END MODULE SUSTAONL_MOD
411