      SUBROUTINE LFISUP ( KREP, KNUMER, CDNOMA, KLONUT )
#include "lficomt.h"
C****
C        SOUS-PROGRAMME PERMETTANT DE *SUPPRIMER* UN ARTICLE LOGIQUE
C     (DE DONNEES) SUR UNE UNITE LOGIQUE OUVERTE POUR LE LOGICIEL
C     DE FICHIERS INDEXES *LFI*; L'ARTICLE EST TRANSFORME EN "TROU"
C     DANS L'INDEX.
C**
C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
C                KNUMER (ENTREE) ==> NUMERO DE L'UNITE LOGIQUE;
C                CDNOMA (ENTREE) ==> NOM DE L'ARTICLE A RECHERCHER;
C                KLONUT (SORTIE) ==> LONGUEUR *REUTILISABLE*
C                                    DE L'ARTICLE SUPPRIME.
C
#include "lficom0.h"
#ifndef f77
#include "precision.h"
#endif
#include "lficom1.h"
C
      CHARACTER CDNOMA*(*), CLNOMA*(JPNCPN)
C
      INTEGER KREP, KNUMER, KLONUT, IMDESC, IRANG, IREP, ILCDNO, ILCLNO
      INTEGER IDECBL, IPOSBL, IARTEX, INBALO, IRGPIM, IRGPIF, ILONGA, J
      INTEGER IPOSEX, IFACTM, ILARPH, INALPP, INALPI, INTPPI, INBPIR
      INTEGER INPPIM, IRECPI, IREC, IRGPI, IRPIMS, INPILE, IRNGMS
      INTEGER IRETIN, INIMES
C
      LOGICAL LLVERF
C
#include "lficom2.h"
C**
C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
C-----------------------------------------------------------------------
C
C        Appel legerement anticipe a LFINUM, garantissant l'initialisa-
C     tion des variables globales du logiciel a la 1ere utilisation.
C
      CALL LFINUM (KNUMER,IRANG)
      LLVERF=.FALSE.
      IREP=0
      KLONUT=0
      ILCDNO=LEN (CDNOMA)
C
      IF (ILCDNO.LE.0) THEN
        IREP=-15
        CLNOMA=CHINCO(:JPNCPN)
        ILCLNO=JPNCPN
        GOTO 1001
      ELSEIF (CDNOMA.EQ.' ') THEN
        IREP=-18
        CLNOMA=' '
        ILCLNO=1
        GOTO 1001
      ENDIF
C
C        Recherche de la longueur "utile" du nom d'article specifie.
C        (c'est-a-dire sans tenir compte des blancs terminaux eventuels)
C
      IDECBL=0
C
  101 CONTINUE
      IPOSBL=IDECBL+INDEX (CDNOMA(IDECBL+1:),' ')
C
      IF (IPOSBL.LE.IDECBL) THEN
        ILCLNO=ILCDNO
      ELSEIF (CDNOMA(IPOSBL:).EQ.' ') THEN
        ILCLNO=IPOSBL-1
      ELSE
        IDECBL=IPOSBL
        GOTO 101
      ENDIF
C
      IF (ILCLNO.LE.JPNCPN) THEN
        CLNOMA=CDNOMA(:ILCLNO)
      ELSE
        CLNOMA=CDNOMA(:JPNCPN)
        ILCLNO=JPNCPN
        IREP=-15
        GOTO 1001
      ENDIF
C
      IF (IRANG.EQ.0) THEN
        IREP=-1
        GOTO 1001
      ENDIF
C
       IF (LMULTI) CALL LFIVER (VERRUE(IRANG),'ON')
      LLVERF=LMULTI
C
      IF (NEXPOR(IRANG).GT.0) THEN
C
C         Fichier en cours d'export... la seule modification acceptee
C         est l'ajout de nouveaux articles.
C
        IREP=-37
        GOTO 1001
      ENDIF
C
      IARTEX=0
      INBALO=MDES1D(IXM(JPNALO,IRANG))
C
      IF (INBALO.NE.0) THEN
C**
C     2.  -  EXPLORATION DES (PAIRES DE) PAGES ET ARTICLES D'INDEX,
C            A LA RECHERCHE DE L'ARTICLE LOGIQUE A SUPPRIMER.
C-----------------------------------------------------------------------
C
        CALL LFIRAN (IREP,IRANG,CLNOMA(:ILCLNO),IRGPIM,IARTEX,IRETIN)
C
        IF (IRETIN.EQ.1) THEN
          GOTO 903
        ELSEIF (IRETIN.EQ.2) THEN
          GOTO 904
        ELSEIF (IRETIN.NE.0) THEN
          GOTO 1001
        ENDIF
C
      ENDIF
C
      IF (IARTEX.EQ.0) THEN
        IREP=-20
        CLACTI=CLNOMA(:ILCLNO)
        GOTO 1001
      ENDIF
C
C        ON COMPLETE LES CARACTERISTIQUES DE L'ARTICLE PAR SA LONGUEUR,
C     EXPRIMEE EN TERME DE DONNEES "LISIBLES" POUR L'UTILISATEUR.
C
      IRGPIF=MRGPIF(IRGPIM)
C
      IF (.NOT.LPHASP(IRGPIM)) THEN
C
        CALL LFIPHA (IREP,IRANG,IRGPIM,IRETIN)
C
        IF (IRETIN.EQ.1) THEN
          GOTO 903
        ELSEIF (IRETIN.EQ.2) THEN
          GOTO 904
        ELSEIF (IRETIN.NE.0) THEN
          GOTO 1001
        ENDIF
C
      ENDIF
C
      ILONGA=MLGPOS(IXM(2*IARTEX-1,IRGPIM))
      IPOSEX=MLGPOS(IXM(2*IARTEX,IRGPIM))
      IFACTM=MFACTM(IRANG)
      ILARPH=JPLARD*IFACTM
      INALPP=JPNAPP*IFACTM
      INALPI=MIN0 (INALPP,INBALO-(IRGPIF-1)*INALPP)
      INTPPI=(INBALO-1+INALPP)/INALPP
      INBPIR=MDES1D(IXM(JPNPIR,IRANG))
      INPPIM=NPPIMM(IRANG)
C**
C     3.  -  AFIN D'ASSURER UN MEILLEUR RECYCLAGE (EVENTUEL) DE CE FUTUR
C            TROU, ON CALCULE SA LONGUEUR EFFECTIVEMENT REUTILISABLE.
C-----------------------------------------------------------------------
C
      IF (IARTEX.EQ.1.AND.IRGPIF.GT.INBPIR) THEN
C
C            IL Y A EU DEBORDEMENT DES P.A.I. PREALLOUEES, ET IL Y A
C        EN OUTRE UNE P.A.I. SUR LE FICHIER, JUSTE DERRIERE L'ARTICLE
C        LOGIQUE AUQUEL ON S'INTERESSE.
C
        IRECPI=MDES1D(IXM(ILARPH+1-(IRGPIF-INBPIR),IRANG))
        KLONUT=ILARPH*(IRECPI-1)-IPOSEX+1
      ELSEIF (IARTEX.EQ.INALPI.AND.IRGPIF.EQ.INTPPI) THEN
C
C           CAS OU L'ARTICLE TROUVE EST LE DERNIER ARTICLE LOGIQUE DE
C        DONNEES, SANS P.A.I. JUSTE DERRIERE.
C           LA DERNIERE POSITION REUTILISABLE SANS AUGMENTER LA TAILLE
C       DU FICHIER CORRESPOND A LA FIN DU DERNIER ARTICLE PHYSIQUE
C       CONTENANT DES DONNEES, OU A LA FIN DU DERNIER ARTICLE PHYSIQUE
C       EFFECTIVEMENT ECRIT SUR LE FICHIER.
C
        IMDESC=MDES1D(IXM(JPNAPH,IRANG))
        IREC=MAX0 (1+(IPOSEX+ILONGA-2)/ILARPH,IMDESC)
        KLONUT=ILARPH*IREC-IPOSEX+1
C
C          EN ARRIVANT AU TEST CI-DESSOUS, ON EST DONC SUR QUE L'ARTICLE
C        TROUVE N'EST PAS LE DERNIER ARTICLE LOGIQUE.
C          ON VA CALCULER LA DISTANCE ENTRE LES DEBUTS D'ARTICLE,
C        CE QUI CONSTITUE LA LONGUEUR REUTILISABLE CHERCHEE.
C
      ELSEIF (IARTEX.NE.INALPP) THEN
C
C           L'ARTICLE SUIVANT EST DANS LA MEME PAGE D'INDEX...
C
        KLONUT=MLGPOS(IXM(2*IARTEX+2,IRGPIM))-IPOSEX
      ELSE
C
C           L'ARTICLE TROUVE EST EN PLUS EN FIN DE PAGE D'INDEX...
C       RECHERCHE DANS LES P.P.I. DE LA P.A.I. SUIVANTE.
C
        DO 302 J=2,INPPIM
        IRGPI=MRGPIM(J,IRANG)
C
        IF (MRGPIF(IRGPI).EQ.(IRGPIF+1)) THEN
C
          IRPIMS=IRGPI
C
          IF (.NOT.LPHASP(IRPIMS)) THEN
C
            CALL LFIPHA (IREP,IRANG,IRPIMS,IRETIN)
C
            IF (IRETIN.EQ.1) THEN
              GOTO 903
            ELSEIF (IRETIN.EQ.2) THEN
              GOTO 904
            ELSEIF (IRETIN.NE.0) THEN
              GOTO 1001
            ENDIF
C
          ENDIF
C
          GOTO 305
C
        ENDIF
C
  302   CONTINUE
C
C             LA P.A.I. SUIVANTE (EN RANG DANS LE FICHIER) N'EST PAS
C          EN MEMOIRE; DECIDEMENT, CELA SE GATE ! ... ON L'Y MET.
C
        INPILE=2
        CALL LFIPIM (KREP,IRANG,IRNGMS,IRPIMS,IRGPIF+1,IRGPIF,INPILE,
     S               IRETIN)
C
        IF (IRETIN.EQ.1) THEN
          GOTO 903
        ELSEIF (IRETIN.EQ.2) THEN
          GOTO 904
        ELSEIF (IRETIN.NE.0) THEN
          GOTO 1001
        ENDIF
C
  305   CONTINUE
C
        KLONUT=MLGPOS(IXM(2,IRPIMS))-IPOSEX
      ENDIF
C**
C     4  -  TRANSFORMATION EFFECTIVE DE L'ARTICLE LOGIQUE DE DONNEES
C           EN "TROU" D'INDEX.
C-----------------------------------------------------------------------
C
      CNOMAR(IXC(IARTEX,IRGPIM))=' '
      IF (NDERGF(IRANG).NE.JPNIL.AND.CNDERA(IRANG).EQ.CLNOMA(:ILCLNO))
     S                             CNDERA(IRANG)=' '
      LECRPI(IRGPIM,1)=.TRUE.
      NBSUPP(IRANG)=NBSUPP(IRANG)+1
      LMIMAL(IRANG)=LMIMAL(IRANG).OR.ILONGA.EQ.MDES1D(IXM(JPLNAL,IRANG))
     S              .OR.ILONGA.EQ.MDES1D(IXM(JPLXAL,IRANG))
      NBTROU(IRANG)=NBTROU(IRANG)+1
      MDES1D(IXM(JPLTAL,IRANG))=MDES1D(IXM(JPLTAL,IRANG))-ILONGA
C
      IF (KLONUT.NE.ILONGA) THEN
        MLGPOS(IXM(2*IARTEX-1,IRGPIM))=KLONUT
        LECRPI(IRGPIM,2)=.TRUE.
      ENDIF
C
      IF (.NOT.LMODIF(IRANG)) THEN
C
C         CAS DE LA PREMIERE MODIFICATION DEPUIS L'OUVERTURE DU FICHIER.
C
        LMODIF(IRANG)=.TRUE.
        CALL LFIMOD (IREP,IRANG,IRETIN)
C
        IF (IRETIN.EQ.1) THEN
          GOTO 903
        ELSEIF (IRETIN.EQ.2) THEN
          GOTO 904
        ELSEIF (IRETIN.NE.0) THEN
          GOTO 1001
        ENDIF
C
      ENDIF
C
      GOTO 1001
C**
C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
C-----------------------------------------------------------------------
C
  903 CONTINUE
      CLACTI='WRITE'
      GOTO 909
C
  904 CONTINUE
      CLACTI='READ'
C
  909 CONTINUE
C
C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
C
      IREP=IABS (IREP)
C**
C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
C            VIA LE SOUS-PROGRAMME "LFIEMS" .
C-----------------------------------------------------------------------
C
 1001 CONTINUE
      KREP=IREP
      LLFATA=LLMOER (IREP,IRANG)
C
      IF (IRANG.NE.0) THEN
        NDEROP(IRANG)=15
        NDERCO(IRANG)=IREP
         IF (LLVERF) CALL LFIVER (VERRUE(IRANG),'OFF')
      ENDIF
C
      IF (LLFATA.OR.IXNIMS (IRANG).EQ.2) THEN
        INIMES=2
      ELSE
        RETURN
      ENDIF
C
      CLNSPR='LFISUP'
      WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='',I3,
     S       '', CDNOMA='''''',A,'''''', KLONUT='',I8)')
     S     KREP,KNUMER,CLNOMA(:ILCLNO),KLONUT
      CALL LFIEMS (KNUMER,INIMES,IREP,LLFATA,CLMESS,CLNSPR,CLACTI)
C
      RETURN
      END
