File: fac_asm_build_sort_index_ELT_m.F

package info (click to toggle)
mumps 5.1.2-5
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 15,704 kB
  • sloc: fortran: 310,672; ansic: 12,364; xml: 521; makefile: 469
file content (487 lines) | stat: -rw-r--r-- 16,218 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
C
C  This file is part of MUMPS 5.1.2, released
C  on Mon Oct  2 07:37:01 UTC 2017
C
C
C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license:
C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
C
      MODULE MUMPS_BUILD_SORT_INDEX_ELT_M
      CONTAINS
      SUBROUTINE MUMPS_ELT_BUILD_SORT(
     &           NUMELT, LIST_ELT, 
     &           MYID, INODE, N, IOLDPS,
     &           HF, NFRONT, NFRONT_EFF, PERM, 
     &           NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, 
     &           IFSON, STEP, PIMASTER, PTRIST, PTRAIW, NELT, 
     &           IW, LIW, 
     &           INTARR, LINTARR, ITLOC,
     &           FILS, FRERE_STEPS, 
     &           KEEP, SON_LEVEL2, NIV1, NBPROCFILS, IFLAG, 
     &           DAD, PROCNODE_STEPS, SLAVEF, 
     &           FRT_PTR, FRT_ELT, Pos_First_NUMORG,
     &           SONROWS_PER_ROW, LSONROWS_PER_ROW
     & )
      IMPLICIT NONE
      INTEGER NELT, INODE, N, IOLDPS, HF, NFRONT, NASS1, LIW, NASS,
     &        NUMSTK, NUMORG, IFSON, MYID, IFLAG,
     &        NUMELT
      INTEGER KEEP(500)
      INTEGER LIST_ELT(*)
      INTEGER(8), INTENT(IN) :: PTRAIW(NELT+1)
      INTEGER STEP(N), PIMASTER(KEEP(28)), PTRIST(KEEP(28)),
     &        ITLOC(N+KEEP(253)), FILS(N), FRERE_STEPS(KEEP(28)),
     &        NBPROCFILS(KEEP(28)), PERM(N)
      INTEGER, TARGET :: IW(LIW)
      INTEGER, INTENT(IN), TARGET :: IWPOSCB
      INTEGER(8), INTENT(IN) :: LINTARR
      INTEGER INTARR(LINTARR)
      LOGICAL, intent(in)    :: NIV1
      LOGICAL, intent(out)   :: SON_LEVEL2
      INTEGER, intent(out)   :: NFRONT_EFF
      INTEGER, intent(in)    :: DAD (KEEP(28))
      INTEGER, intent(in) :: PROCNODE_STEPS(KEEP(28)), SLAVEF
      INTEGER, intent(in) :: FRT_PTR(N+1), FRT_ELT(NELT)
      INTEGER, intent(out) :: Pos_First_NUMORG
      INTEGER, intent(in)    :: LSONROWS_PER_ROW
      INTEGER, intent(out)   :: SONROWS_PER_ROW(LSONROWS_PER_ROW)
      INTEGER NEWEL, IOLDP2, INEW, INEW1,
     &        IN, NTOTFS, ICT11, NELIM, NPIVS, NSLSON, NCOLS,
     &        ITRANS, J, JT1, ISON, IELL, LSTK, 
     &        NROWS, HS, IP1, IP2, IBROT,
     &        I, ILOC, NEWEL_SAVE, NEWEL1_SAVE,
     &        LAST_J_ASS, JMIN, MIN_PERM
      INTEGER :: K, K1, K2, K3, KK
      INTEGER(8) :: JJ8, J18, J28
      LOGICAL LEVEL1_SON
#if ! defined(NO_XXNBPR)
      INTEGER INBPROCFILS_SON
#endif
      INTEGER TYPESPLIT
      INTEGER ELTI, NUMELT_IBROT
      INCLUDE 'mumps_headers.h'
      INTEGER, POINTER :: SON_IWPOSCB
      INTEGER, POINTER, DIMENSION(:) :: SON_IW
      INTEGER allocok
      INTEGER, ALLOCATABLE, DIMENSION(:) :: PTTRI, PTLAST
      INTEGER  MUMPS_TYPESPLIT, MUMPS_TYPENODE
      EXTERNAL MUMPS_TYPESPLIT, MUMPS_TYPENODE 
#if ! defined(NO_XXNBPR)
      IW(IOLDPS+XXNBPR) = 0
#endif
      Pos_First_NUMORG = 1
      TYPESPLIT  = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)), 
     &              SLAVEF)
      SON_LEVEL2 = .FALSE.
      IOLDP2     = IOLDPS + HF - 1
      ICT11      = IOLDP2 + NFRONT
      NFRONT_EFF = NASS1
      NTOTFS     = 0
      IF ( (TYPESPLIT.EQ.5).OR.(TYPESPLIT.EQ.6) ) THEN
        K2    = PIMASTER(STEP(IFSON))
        LSTK  = IW(K2    +KEEP(IXSZ))
        NELIM = IW(K2 + 1+KEEP(IXSZ))
        NPIVS  = IW(K2 + 3+KEEP(IXSZ))
        IF (NPIVS.LT.0) NPIVS = 0
        NSLSON = IW(K2 + 5+KEEP(IXSZ))
        IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE.
        LEVEL1_SON    = NSLSON.EQ.0
        NCOLS  = NPIVS + LSTK
        NROWS  = NCOLS
        ITRANS = NROWS
        IF (NIV1) THEN
          write(6,*) MYID, ':',
     &    ' Internal error 2 in MUMPS_ELT_BUILD_SORT ',
     &    ' interior split node of type 1 '
          CALL MUMPS_ABORT()
        ENDIF
        I= MUMPS_TYPENODE(PROCNODE_STEPS(STEP(IFSON)),SLAVEF)
        J= MUMPS_TYPESPLIT(PROCNODE_STEPS(STEP(IFSON)), 
     &              SLAVEF)
        IF (LEVEL1_SON.or.J.LT.4) THEN
           write(6,*) MYID, ':',
     &     ' Internal error 3 in MUMPS_ELT_BUILD_SORT ',
     &     ' son', IFSON, 
     &     ' of interior split node', INODE, ' of type 1 ', 
     &     ' NSLSON =', NSLSON, ' TYPE_SON=', I, 'TYPESPLIT_SON=', J
           CALL MUMPS_ABORT()
        ENDIF
#if ! defined(NO_XXNBPR)
        IF (PIMASTER(STEP(IFSON)) .GT. IWPOSCB) THEN
          INBPROCFILS_SON = PIMASTER(STEP(IFSON))+XXNBPR
        ELSE
          INBPROCFILS_SON = PTRIST(STEP(IFSON))+XXNBPR
        ENDIF
#endif
        NBPROCFILS(STEP(IFSON)) = NSLSON
        NBPROCFILS(STEP(INODE)) = NSLSON
#if ! defined(NO_XXNBPR)
        IW(IOLDPS+XXNBPR)=NSLSON
        IW(INBPROCFILS_SON) = NSLSON
        CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE)),IW(IOLDPS+XXNBPR))
#endif
        SONROWS_PER_ROW(1:NFRONT-NASS1) = 1
        IF ( K2.GT. IWPOSCB ) THEN
          NROWS = IW(K2 + 2+KEEP(IXSZ))
          ITRANS = NPIVS + NROWS
        ENDIF
        HS = NSLSON + 6 + KEEP(IXSZ)
        K1 = K2 + HS + NROWS + NPIVS
        K2 = K1 + LSTK - 1
        K3 = K1 + NELIM - 1
        IF (NELIM.GT.0) THEN
         DO KK=K1,K3
          NTOTFS = NTOTFS + 1
          JT1 = IW(KK)
          IW(ICT11 + NTOTFS) = JT1
          IW(KK) = NTOTFS
          IW(IOLDP2 + NTOTFS) = IW(KK - ITRANS)
         ENDDO
        ENDIF
        DO KK =K3+1, K2
         NTOTFS = NTOTFS + 1
         JT1 = IW(KK)
         ITLOC(JT1) = NTOTFS 
         IW(KK) = NTOTFS
         IW(ICT11 + NTOTFS) = JT1
         IW(IOLDP2 + NTOTFS) = JT1
        ENDDO
        NFRONT_EFF = NTOTFS
        DO IELL=1,NUMELT
          ELTI = LIST_ELT(IELL)
          J18= PTRAIW(ELTI)
          J28= PTRAIW(ELTI+1)-1
          DO JJ8=J18,J28
           J = INTARR(JJ8)
            INTARR(JJ8) = ITLOC(J)
          ENDDO
        ENDDO
        Pos_First_NUMORG = ITLOC(INODE)
        K1 = IOLDPS+HF
        DO KK=K1+NELIM,K1+NFRONT_EFF-1
          ITLOC(IW(KK)) = 0
        ENDDO
        RETURN   
      ENDIF
      IF (NUMSTK.GT.0) THEN
        ALLOCATE(PTTRI(NUMSTK), stat=allocok)
        IF (allocok .GT. 0) THEN
         IFLAG = -13
         GOTO 800
        ENDIF
        ALLOCATE(PTLAST(NUMSTK), stat=allocok)
        IF (allocok .GT. 0) THEN
         IFLAG = -13
         GOTO 800
        ENDIF        
      ENDIF
      IF (.NOT. NIV1) SONROWS_PER_ROW(1:NFRONT-NASS1) = 0
      IN = INODE
      INEW = IOLDPS + HF
      INEW1 = 1
      DO WHILE (IN.GT.0)
       ITLOC(IN)        = INEW1
       IW(INEW)         = IN
       IW(INEW+NFRONT)  = IN
       INEW1     = INEW1 + 1
       INEW      = INEW + 1
       IN = FILS(IN)
      END DO
      NTOTFS = NUMORG
      IF (NUMSTK .NE. 0) THEN
        ISON = IFSON
        DO IELL = 1, NUMSTK
          K2 = PIMASTER(STEP(ISON))
          SON_IW => IW
          SON_IWPOSCB => IWPOSCB
          LSTK   = SON_IW(K2    +KEEP(IXSZ))
          NELIM  = SON_IW(K2 + 1+KEEP(IXSZ))
          NPIVS  = SON_IW(K2 + 3+KEEP(IXSZ))
          IF (NPIVS.LT.0) NPIVS = 0
          NSLSON = SON_IW(K2 + 5+KEEP(IXSZ))
          IF( NSLSON.GT.0) SON_LEVEL2 = .TRUE.
          LEVEL1_SON    = NSLSON.EQ.0
          NCOLS  = NPIVS + LSTK
          NROWS  = NCOLS
          ITRANS = NROWS
#if ! defined(NO_XXNBPR)
          IF (PIMASTER(STEP(ISON)).GT.IWPOSCB) THEN
            INBPROCFILS_SON = PIMASTER(STEP(ISON))+XXNBPR
          ELSE
            INBPROCFILS_SON = PTRIST(STEP(ISON))+XXNBPR
          ENDIF
#endif
          IF (NIV1) THEN
           NBPROCFILS(STEP(ISON)) = NSLSON
           NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE)) + NSLSON
#if ! defined(NO_XXNBPR)
           IW(INBPROCFILS_SON) = NSLSON
           IW(IOLDPS+XXNBPR) = IW(IOLDPS+XXNBPR) + NSLSON
           CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE)),IW(IOLDPS+XXNBPR))
           CALL CHECK_EQUAL(NBPROCFILS(STEP(ISON)),IW(INBPROCFILS_SON))
#endif
          ELSE
           IF (LEVEL1_SON) THEN
            NBPROCFILS(STEP(ISON)) = 1
#if ! defined(NO_XXNBPR)
            IW(INBPROCFILS_SON) = 1
#endif
           ELSE
            NBPROCFILS(STEP(ISON)) = NSLSON
#if ! defined(NO_XXNBPR)
            IW(INBPROCFILS_SON) = NSLSON
#endif
           ENDIF
           NBPROCFILS(STEP(INODE)) = NBPROCFILS(STEP(INODE))+
     &                               NBPROCFILS(STEP(ISON))
#if ! defined(NO_XXNBPR)
           IW(IOLDPS+XXNBPR) = IW(IOLDPS+XXNBPR) + IW(INBPROCFILS_SON)
           CALL CHECK_EQUAL(NBPROCFILS(STEP(INODE)),IW(IOLDPS+XXNBPR))
#endif
          ENDIF
          IF (K2.GT.SON_IWPOSCB) THEN
           NROWS = SON_IW(K2 + 2+KEEP(IXSZ))
           ITRANS = NPIVS + NROWS
          ENDIF
          HS = NSLSON + 6 + KEEP(IXSZ)
          K1 = K2 + HS + NROWS + NPIVS
          K2 = K1 + LSTK - 1 - KEEP(253)
          K3 = K1 + NELIM - 1
          IF (NELIM .NE. 0) THEN
            DO KK = K1, K3
              NTOTFS = NTOTFS + 1
              JT1 = SON_IW(KK)
              IW(ICT11 + NTOTFS) = JT1
              ITLOC(JT1) = NTOTFS
              SON_IW(KK) = NTOTFS
              IW(IOLDP2 + NTOTFS) = SON_IW(KK - ITRANS)
            ENDDO
          ENDIF
          PTTRI(IELL)  = K2+1
          PTLAST(IELL) = K2
          K1 = K3 + 1
          IF (NASS1 .NE. NFRONT - KEEP(253)) THEN
            DO KK = K1, K2
              J = SON_IW(KK)
              IF (ITLOC(J) .EQ. 0) THEN 
                PTTRI(IELL) = KK
                EXIT
              ENDIF
            ENDDO
          ELSE
            DO KK = K1, K2
              SON_IW(KK) = ITLOC(SON_IW(KK))
            ENDDO
            DO KK=K2+1, K2+KEEP(253)
              SON_IW(KK)=NFRONT-KEEP(253)+KK-K2
           ENDDO
          ENDIF
          ISON = FRERE_STEPS(STEP(ISON))
        ENDDO
      ENDIF
      IF (NFRONT-KEEP(253).EQ.NASS1) GOTO 500
      MIN_PERM = N + 1
      JMIN     = -1
      DO IELL = 1, NUMSTK 
        SON_IW => IW
        ILOC = PTTRI( IELL )
        IF ( ILOC .LE. PTLAST( IELL ) ) THEN 
         IF ( PERM( SON_IW( ILOC ) ) .LT. MIN_PERM ) THEN
           JMIN     = SON_IW( ILOC )
           MIN_PERM = PERM( JMIN )
         END IF
        END IF
      END DO
      NEWEL = IOLDP2 + NASS1 + NFRONT
      DO WHILE ( MIN_PERM .NE. N + 1 )
          NEWEL  = NEWEL + 1
          NFRONT_EFF = NFRONT_EFF + 1
          IW( NEWEL ) = JMIN
          ITLOC( JMIN ) = NFRONT_EFF
          LAST_J_ASS = JMIN
          MIN_PERM = N + 1
          DO IELL = 1,  NUMSTK
            SON_IW => IW
            IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN
              IF ( SON_IW( PTTRI( IELL ) ) .eq. LAST_J_ASS )
     &        PTTRI( IELL ) = PTTRI( IELL ) + 1
            ENDIF
            IF ( PTTRI( IELL ) .LE. PTLAST( IELL ) ) THEN 
             IF ( PERM(SON_IW( PTTRI( IELL )) ) .LT. MIN_PERM ) THEN
                JMIN        = SON_IW( PTTRI( IELL ) )
                MIN_PERM = PERM( JMIN )
             END IF
            END IF
          END DO
      END DO
      NEWEL_SAVE  = NEWEL
      NEWEL1_SAVE = NFRONT_EFF
      IF (NEWEL1_SAVE.LT.NFRONT - KEEP(253)) THEN 
      DO IELL = 1,NUMELT
        ELTI = LIST_ELT(IELL)
         J18= PTRAIW(ELTI)
         J28= PTRAIW(ELTI+1)-1_8
         DO JJ8=J18,J28
           J     = INTARR( JJ8 )
           IF ( ITLOC( J ) .eq. 0 ) THEN
            NEWEL  = NEWEL + 1
            NFRONT_EFF = NFRONT_EFF + 1
            IW( NEWEL ) = J
            ITLOC( J ) = NFRONT_EFF
           END IF
         ENDDO
      ENDDO
       IF ( (TYPESPLIT.EQ.4).AND.
     &      (NFRONT_EFF.LT.NFRONT-KEEP(253)) ) THEN
         IBROT = INODE
         DO WHILE
     &      (
     &        ( MUMPS_TYPESPLIT 
     &           (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF)
     &           .EQ.5 
     &        )
     &        .OR.
     &        ( MUMPS_TYPESPLIT 
     &           (PROCNODE_STEPS(STEP(DAD(STEP(IBROT)))),SLAVEF)
     &           .EQ.6  
     &        )
     &      )
          IBROT = DAD(STEP(IBROT))
          NUMELT_IBROT = FRT_PTR(IBROT+1) - FRT_PTR(IBROT)
          IF (NUMELT_IBROT.EQ.0) CYCLE 
          DO IELL = FRT_PTR(IBROT), FRT_PTR(IBROT+1)
            ELTI = FRT_ELT(IELL)
            J18= PTRAIW(ELTI)
            J28= PTRAIW(ELTI+1)-1
            DO JJ8 = J18, J28
              J     = INTARR( JJ8 )
              IF ( ITLOC( J ) .eq. 0 ) THEN
                NEWEL  = NEWEL + 1
                NFRONT_EFF = NFRONT_EFF + 1
                IW( NEWEL ) = J
                ITLOC( J ) = NFRONT_EFF
              END IF
            ENDDO
          ENDDO
          IF (NFRONT_EFF.EQ.NFRONT-KEEP(253)) EXIT
        ENDDO
        IF (NFRONT_EFF.NE.NFRONT-KEEP(253) .AND.
     &      .NOT. (KEEP(376).EQ.1 .AND. KEEP(79) .GE.1)) THEN
          write(6,*) MYID, ': INODE', INODE, ' of type 4 ', 
     &             ' not yet fully assembled ', 
     &             ' NFRONT_EFF, NFRONT =',  NFRONT_EFF, NFRONT
          CALL MUMPS_ABORT()
        ENDIF
       ENDIF
      ENDIF
      IF ( NEWEL1_SAVE .eq. NFRONT_EFF ) THEN
         DO KK=NASS1+1, NFRONT_EFF
           IW( IOLDP2+KK ) = IW( ICT11+KK )
         ENDDO
      ELSE
        CALL MUMPS_SORT( N, PERM, 
     &           IW( NEWEL_SAVE + 1 ), NFRONT_EFF - NEWEL1_SAVE )
        CALL MUMPS_SORTED_MERGE( N, NASS1, PERM, ITLOC,
     &    IW( NEWEL_SAVE + 1), NFRONT_EFF - NEWEL1_SAVE,
     &    IW( ICT11  + NASS1 + 1 ), NEWEL1_SAVE - NASS1,
     &    IW( IOLDP2 + NASS1 + 1 ), NFRONT_EFF - NASS1 )
        DO KK = NASS1+1, NFRONT_EFF
          IW(ICT11 + KK) = IW(IOLDP2+KK)
        ENDDO
      END IF
  500 CONTINUE
      IF ( KEEP(253).GT.0) THEN
        IP1 = IOLDPS +  HF + NFRONT_EFF  
        IP2 = IOLDPS + HF + NFRONT + NFRONT_EFF 
        DO I= 1, KEEP(253)
          IW(IP1+I-1) = N+I
          IW(IP2+I-1) = N+I
          ITLOC(N+I)  = NFRONT_EFF + I
        ENDDO
        NFRONT_EFF = NFRONT_EFF + KEEP(253)
      ENDIF
      IF (NFRONT.GT.NFRONT_EFF) THEN
        IP1 = IOLDPS + NFRONT + HF
        IP2 = IOLDPS + NFRONT_EFF + HF
        DO I=1, NFRONT_EFF
          IW(IP2+I-1)=IW(IP1+I-1)
        ENDDO
      ELSE IF (NFRONT .LT. NFRONT_EFF) THEN
        WRITE(*,*) "Internal error in MUMPS_ELT_BUILD_SORT",
     &             NFRONT, NFRONT_EFF
        IFLAG = -53
        GOTO 800
      ENDIF
      IF ( (NUMSTK .NE.0) 
     & .AND. (NFRONT-KEEP(253).GT.NASS1 )   
     &  ) THEN
        ISON = IFSON
        DO IELL = 1, NUMSTK
          K2 = PIMASTER(STEP(ISON))
          SON_IW => IW
          SON_IWPOSCB => IWPOSCB
          LSTK = SON_IW(K2+KEEP(IXSZ))
          NELIM = SON_IW(K2 + 1 +KEEP(IXSZ))
          NPIVS = SON_IW(K2 + 3 +KEEP(IXSZ))
          IF (NPIVS.LT.0) NPIVS = 0
          NSLSON = SON_IW(K2 + 5 +KEEP(IXSZ))
          LEVEL1_SON = (NSLSON .EQ. 0)
          NCOLS = NPIVS + LSTK
          NROWS = NCOLS
          IF (K2.GT.SON_IWPOSCB) THEN
           NROWS = SON_IW(K2 + 2+KEEP(IXSZ))
          ENDIF
          HS = NSLSON + 6 +KEEP(IXSZ)
          K1 = K2 + HS + NROWS + NPIVS
          K2 = K1 + LSTK - 1
          K3 = K1 + NELIM - 1
          K1 = K3 + 1
          IF (NFRONT-KEEP(253).GT.NASS1) THEN
            DO KK = K1, K2
              J = SON_IW(KK)
              SON_IW(KK) = ITLOC(J)
              IF (NIV1 .AND. NSLSON.EQ.0) THEN
              ELSE
                IF (SON_IW(KK) .LE. NASS1 .OR. NIV1) THEN
                ELSE
                  SONROWS_PER_ROW(SON_IW(KK)-NASS1) =
     &                         SONROWS_PER_ROW(SON_IW(KK)-NASS1) + 1
                ENDIF
              ENDIF
            ENDDO
          ELSE
              IF (.not. NIV1) THEN
                WRITE(*,*) "Internal error 1 in MUMPS_ELT_BUILD_SORT"
                CALL MUMPS_ABORT() 
              ENDIF
              IF (.not.LEVEL1_SON) THEN
              ENDIF
          ENDIF
          ISON = FRERE_STEPS(STEP(ISON))
        ENDDO
      ENDIF
      DO IELL=1,NUMELT
        ELTI = LIST_ELT(IELL)
        J18 = PTRAIW(ELTI)
        J28 = PTRAIW(ELTI+1)-1
        DO JJ8=J18,J28
          J = INTARR(JJ8)
            INTARR(JJ8) = ITLOC(J)
        ENDDO
      ENDDO
        K1 = IOLDPS + HF + NUMORG
        K2 = K1 + NFRONT_EFF - 1 + NASS
        DO K = K1, K2
          I = IW(K)
          ITLOC(I) = 0
        ENDDO
  800 CONTINUE
      IF (allocated(PTTRI)) DEALLOCATE(PTTRI)
      IF (allocated(PTLAST)) DEALLOCATE(PTLAST)
      RETURN
      END SUBROUTINE MUMPS_ELT_BUILD_SORT
      END MODULE MUMPS_BUILD_SORT_INDEX_ELT_M