1C
2C This file is issued from the MODULEF library, but has been
3C subsequently modified
4C
5      SUBROUTINE FONDID(NIDENT)
6C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
7C           S.P. FONDID          (FONCTIONS INTERPRETEES)
8C           -----------
9C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
10C BUT :
11C     DETRUIRE DE LA TABLE DES IDENTIFICATEURS
12C     LES NIDENT DERNIERS IDENTIFICATEURS RENCONTRES
13C
14C PARAMETRES D ENTREE :
15C     NIDENT  : NOMBRE D IDENTIFICATEURS A DETRUIRE
16C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
17C PROGRAMMEUR : PATRICK LAUG ; INRIA (3) 954 90 20 POSTE 508
18C ......................................................................
19      PARAMETER (LIDN=8)
20      CHARACTER*256 MIDN(LIDN)
21      COMMON /FONIDN/ MIDN
22      COMMON /FONNUM/ IDLIG,IFLIG,NITEMS,NBIDEN,IMPLIC
23      COMMON /FONLC / LCI,LCR,LCL,LCC,LCD,LCOPN,LCOPT,LCSYM,LCEXP,LCIDN
24      COMMON /FONLM / LMI,LMR,LML,LMC,LMD,LMOPN,LMOPT,LMSYM,LMEXP,LMIDN
25C
26      IF (NIDENT.LE.0) RETURN
27      NBIDEN = MAX(NBIDEN-NIDENT, 0)
28      IIDENT = 0
29C
30C PARCOURS INVERSE DE LA CHAINE
31  100 IFIN  = INDEX(MIDN(LCIDN), '||')
32  200 IFIN = IFIN - 1
33      IF (IFIN .LE. 0) THEN
34         LCIDN = LCIDN - 1
35         IF (LCIDN .LE. 0) THEN
36            LCIDN = 1
37            MIDN(1)(1:2) = '||'
38            RETURN
39         END IF
40         GOTO 100
41      END IF
42      IF (MIDN(LCIDN)(IFIN:IFIN) .EQ. '|') THEN
43         IIDENT = IIDENT + 1
44         IF (IIDENT .EQ. NIDENT) THEN
45            MIDN(LCIDN)(IFIN+1:IFIN+1) = '|'
46            RETURN
47         END IF
48      END IF
49      GOTO 200
50      END
51