      SUBROUTINE LFIECX ( KREP, KRANG, KREC, KZONE, LDADON, KRETIN )
#include "lficomt.h"
C****
C        SOUS-PROGRAMME *INTERNE* DU LOGICIEL DE FICHIERS INDEXES LFI
C     ECRITURE SUR FICHIER D'UNE PAGE DE DONNEES OU D'INDEX LONG./POS.,
C     EN "BOUCHANT LES TROUS" SI ON N'ECRIT PAS A LA SUITE DU DERNIER
C     ARTICLE PRESENT SUR LE FICHIER, ET EN ESSAYANT D'ECRIRE DES ARTI-
C     CLES ADJACENTS SI ON N'ECRIT PAS UN ARTICLE (PHYSIQUE) "NOUVEAU".
C        CE S/P MET A JOUR LE NOMBRE D'ARTICLES PHYSIQUES DU FICHIER,
C     ET DANS LE CAS D'UN ARTICLE PHYSIQUE DE DONNEES, LE NUMERO MAXI.
C     D'ARTICLE PHYSIQUE DE DONNEES DU FICHIER.
C**
C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DE L'ECRITURE FORTRAN;
C                KRANG  (ENTREE) ==> RANG EN MEMOIRE DE L'UNITE LOGIQUE;
C                KREC   (ENTREE) ==> NUMERO D'ENREGISTREMENT A ECRIRE;
C                KZONE  (ENTREE) ==> PREMIER MOT A ECRIRE;
C                LDADON (ENTREE) ==> VRAI SI ARTICLE DE DONNEES;
C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
C
#include "lficom0.h"
#ifndef f77
#include "precision.h"
#endif
#include "lficom1.h"
C
#ifndef f77
      INTEGER (KIND=JPDBLE) KZONE (JPLARX)
#else
      INTEGER KZONE (JPLARX)
#endif
      INTEGER KREP, KRANG, KREC, KRETIN
      INTEGER INADJA (2), IPOSAD (JPNPDF), IMDESC, INUMER, INPPIM, JREC
      INTEGER IPODPI, IFACTM, ILARPH, INALPP, INBPIR, INDIK1, INDIK2, J
      INTEGER INDIC1, INDIC2, INUMPD, INAPHY, IJ, IRGPIM, IRGPIF, IDEBSE
      INTEGER INDIS1, INDIS2, JSENS, ISENS, IREC, INUMAP, IRECX, INIMES
      INTEGER IRETOU, IRETIN
C
      LOGICAL LDADON, LLSAUT, LLFILT, LLLOIN
C
#include "lficom2.h"
C**
C     1.  -  CONTROLES ET INITIALISATIONS.
C-----------------------------------------------------------------------
C
      IF (KRANG.LE.0.OR.KRANG.GT.JPNXFI) THEN
        INUMER=JPNIL
      ELSE
        INUMER=NUMERO(KRANG)
      ENDIF
C
      IRETOU=0
C
      IF (INUMER.EQ.JPNIL) THEN
        KREP=-14
        GOTO 1001
      ENDIF
C
      INAPHY=0
      LLSAUT=.FALSE.
      INPPIM=NPPIMM(KRANG)
      IPODPI=NPODPI(KRANG)
      IFACTM=MFACTM(KRANG)
      ILARPH=JPLARD*IFACTM
      INALPP=JPNAPP*IFACTM
      INBPIR=MDES1D(IXM(JPNPIR,KRANG))
      LLLOIN=KREC.GT.MDES1D(IXM(JPNAPH,KRANG))
C
      IF (LLLOIN) THEN
C**
C     2.  -  CAS OU L'ON ECRIT PLUS LOIN QUE LE DERNIER ARTICLE
C            EFFECTIVEMENT ECRIT SUR LE FICHIER.
C-----------------------------------------------------------------------
C
        INDIK1=1
        INDIK2=JPNPDF
C*
C     2.1 -  ECRITURE D'EVENTUELS ARTICLES ENTRE LE DERNIER PRESENT
C            SUR LE FICHIER, ET CELUI QUE L'ON DOIT ECRIRE.
C-----------------------------------------------------------------------
C
        DO 214 JREC=MDES1D(IXM(JPNAPH,KRANG))+1,KREC-1
C
        IF (LLSAUT) THEN
          LLSAUT=.FALSE.
          GOTO 213
        ENDIF
C
        INDIC1=INDIK1
        INDIC2=INDIK2
C
        DO 211 J=INDIC1,INDIC2
        INUMPD=MOD (NDERPD(KRANG)+J,JPNPDF)
C
        IF (NUMAPD(INUMPD,KRANG).EQ.JREC) THEN
          IF (J.EQ.INDIK1) INDIK1=INDIK1+1
          IF (J.EQ.INDIK2) INDIK2=INDIK2-1
          IF (LMISOP) PRINT *,'$$$ LFIECX - INUMPD= ',INUMPD,
     S          ', INDIK1= ', INDIK1,', INDIK2= ',INDIK2,' $$$'
C
C          ARTICLE PHYSIQUE TROUVE DANS LES PAGES DE DONNEES;
C       IL S'AGIT DONC D'UNE PAGE DE DONNEES NON ENCORE ECRITE,
C       ET FORCEMENT COMPLETE DANS CE CAS.
C
          IF (.NOT.LECRPD(INUMPD,KRANG)
     S        .OR.NLONPD(INUMPD,KRANG).NE.ILARPH) THEN
            KREP=-16
            GOTO 1001
          ENDIF
C
          INAPHY=JREC
          CALL LFIEDO (KREP,INUMER,JREC,MTAMPD(IXT(1,INUMPD,KRANG)),
     S                 NBWRIT(KRANG),IFACTM,IRETIN)
C
          IF (IRETIN.EQ.1) THEN
            GOTO 903
          ELSEIF (IRETIN.NE.0) THEN
            GOTO 1001
          ENDIF
C
          LECRPD(INUMPD,KRANG)=.FALSE.
          GOTO 213
        ELSEIF (NUMAPD(INUMPD,KRANG).LT.JREC) THEN
          IF (J.EQ.INDIK1) INDIK1=INDIK1+1
          IF (J.EQ.INDIK2) INDIK2=INDIK2-1
        ENDIF
C
  211   CONTINUE
C
C        CAS OU L'ARTICLE N'A PAS ETE TROUVE DANS LES PAGES DE DONNEES;
C        IL S'AGIT DONC D'UN ARTICLE D'INDEX "EXCEDENTAIRE", NON ENCORE
C        ECRIT, ET EN FAIT IL Y A DEUX ARTICLES CONSECUTIFS A ECRIRE.
C
        DO 212 J=1,INPPIM
C
C       ON COMMENCE EN FAIT LA RECHERCHE PAR LA DERNIERE P.P.I., CAR IL
C       Y A PRATIQUEMENT TOUTES LES CHANCES QUE CE SOIT CELLE CHERCHEE.
C       ( LA PREMIERE EST, PAR CONSTRUCTION, NON EXCEDENTAIRE )
C
        IF (J.EQ.1) THEN
          IJ=IPODPI
        ELSEIF (J.EQ.IPODPI) THEN
          GOTO 212
        ELSE
          IJ=J
        ENDIF
C
        IRGPIM=MRGPIM(IJ,KRANG)
        IRGPIF=MRGPIF(IRGPIM)
        IF (IRGPIF.LE.INBPIR) GOTO 212
        CALL LFIREC (IRGPIF,KRANG,IREC)
C
        IF (IREC.EQ.JREC) THEN
C
          IF (.NOT.LECRPI(IRGPIM,1).OR..NOT.LECRPI(IRGPIM,2)) THEN
            KREP=-16
            GOTO 1001
          ENDIF
C
          INAPHY=JREC
          CALL LFIECC (KREP,INUMER,JREC,CNOMAR(IXC(1,IRGPIM)),
     S                 NBWRIT(KRANG),IFACTM,IRETIN)
C
          IF (IRETIN.EQ.1) THEN
            GOTO 903
          ELSEIF (IRETIN.NE.0) THEN
            GOTO 1001
          ENDIF
C
          INAPHY=JREC+1
          CALL LFIEDO (KREP,INUMER,JREC+1,MLGPOS(IXM(1,IRGPIM)),
     S                 NBWRIT(KRANG),IFACTM,IRETIN)
C
          IF (IRETIN.EQ.1) THEN
            GOTO 903
          ELSEIF (IRETIN.NE.0) THEN
            GOTO 1001
          ENDIF
C
          LECRPI(IRGPIM,1)=IJ.NE.IPODPI.OR.NALDPI(KRANG).EQ.INALPP
          LECRPI(IRGPIM,2)=LECRPI(IRGPIM,1)
          LLSAUT=.TRUE.
          GOTO 213
        ENDIF
C
  212   CONTINUE
C
        PRINT *,'$$$ LFIECX - APRES ETIQUETTE 212, JREC= ',
     S              JREC,' NON TROUVE $$$'
        KREP=-16
        GOTO 1001
C
  213   CONTINUE
C
  214   CONTINUE
C
        IDEBSE=2
C
      ELSE
C
C       CAS OU L'ARTICLE PHYSIQUE A ECRIRE EXISTE DEJA SUR LE FICHIER.
C
        IDEBSE=1
C
      ENDIF
C**
C     3.  -  CAS "GENERAL" .
C-----------------------------------------------------------------------
C*
C     3.1 -  RECHERCHE D'ARTICLES PHYSIQUES ADJACENTS A ECRIRE,
C            PARMI LES PAGES DE DONNEES *COMPLETES* EXCLUSIVEMENT.
C-----------------------------------------------------------------------
C
      INDIS1=0
      INDIS2=JPNPDF-1
C
      DO 313 JSENS=IDEBSE,2
      ISENS=2*JSENS-3
      INADJA(JSENS)=(JPNPDF+1)*(JSENS-1)
      IF (.NOT.LDADON.AND.JSENS.EQ.2) GOTO 320
      INDIK1=INDIS1
      INDIK2=INDIS2
      IREC=KREC
C
  311 CONTINUE
      IREC=IREC+ISENS
      INDIC1=INDIK1
      INDIC2=INDIK2
C
      DO 312 J=INDIC1,INDIC2
      INUMAP=NUMAPD(J,KRANG)
      LLFILT=LECRPD(J,KRANG).AND.NLONPD(J,KRANG).EQ.ILARPH
C
      IF (LLFILT.AND.INUMAP.EQ.IREC) THEN
        INADJA(JSENS)=INADJA(JSENS)-ISENS
        IPOSAD(INADJA(JSENS))=J
        IF (J.EQ.INDIK1) INDIK1=INDIK1+1
        IF (J.EQ.INDIK2) INDIK2=INDIK2-1
        IF (J.EQ.INDIS1) INDIS1=INDIS1+1
        IF (J.EQ.INDIS2) INDIS2=INDIS2-1
        GOTO 311
      ELSEIF(.NOT.LLFILT.OR.INUMAP.EQ.KREC
     S       .OR.IABS (INUMAP-KREC).GT.JPNPDF) THEN
        IF (J.EQ.INDIS1) INDIS1=INDIS1+1
        IF (J.EQ.INDIS2) INDIS2=INDIS2-1
      ELSEIF(INUMAP*ISENS.LT.IREC*ISENS) THEN
        IF (J.EQ.INDIK1) INDIK1=INDIK1+1
        IF (J.EQ.INDIK2) INDIK2=INDIK2-1
      ENDIF
C
  312 CONTINUE
C
  313 CONTINUE
C*
C     3.2 -  ECRITURE DES (EVENTUELS) ARTICLES ADJACENTS DE NUMERO
C            *INFERIEUR* A CELUI QUE LE SOUS-PROGRAMME DOIT ECRIRE.
C-----------------------------------------------------------------------
C
  320 CONTINUE
C
      IF (.NOT.LLLOIN) THEN
        IREC=KREC-INADJA(1)
C
        DO 321 J=INADJA(1),1,-1
        IJ=IPOSAD(J)
        INAPHY=IREC
        CALL LFIEDO (KREP,INUMER,IREC,MTAMPD(IXT(1,IJ,KRANG)),
     S               NBWRIT(KRANG),IFACTM,IRETIN)
C
        IF (IRETIN.EQ.1) THEN
          GOTO 903
        ELSEIF (IRETIN.NE.0) THEN
          GOTO 1001
        ENDIF
C
        LECRPD(IJ,KRANG)=.FALSE.
        IREC=IREC+1
  321   CONTINUE
C
      ENDIF
C*
C     3.3 -  ECRITURE DE L'ARTICLE DEMANDE.
C-----------------------------------------------------------------------
C
      INAPHY=KREC
      CALL LFIEDO (KREP,INUMER,KREC,KZONE,NBWRIT(KRANG),IFACTM,IRETIN)
C
      IF (IRETIN.EQ.1) THEN
        GOTO 903
      ELSEIF (IRETIN.NE.0) THEN
        GOTO 1001
      ENDIF
C
C*
C     3.4 -  ECRITURE DES (EVENTUELS) ARTICLES ADJACENTS DE NUMERO
C            *SUPERIEUR* A CELUI QUE LE SOUS-PROGRAMME DOIT ECRIRE.
C-----------------------------------------------------------------------
C
      IREC=KREC
C
      DO 341 J=JPNPDF,INADJA(2),-1
      IREC=IREC+1
      IJ=IPOSAD(J)
      INAPHY=IREC
      CALL LFIEDO (KREP,INUMER,IREC,MTAMPD(IXT(1,IJ,KRANG)),
     S             NBWRIT(KRANG),IFACTM,IRETIN)
C
      IF (IRETIN.EQ.1) THEN
        GOTO 903
      ELSEIF (IRETIN.NE.0) THEN
        GOTO 1001
      ENDIF
C
      LECRPD(IJ,KRANG)=.FALSE.
  341 CONTINUE
C
      IRECX=KREC+JPNPDF-INADJA(2)+1
C**
C     4.  -  DANS LE CAS D'UN ARTICLE DE DONNEES, MISE A JOUR DU NUMERO
C            MAXI D'ENREGISTREMENT DE CES ARTICLES PHYSIQUES, ET DANS
C            TOUS LES CAS MISE A JOUR DU NOMBRE D'ARTICLES PHYSIQUES.
C-----------------------------------------------------------------------
C
      IF (LDADON) THEN
        IMDESC=MDES1D(IXM(JPAXPD,KRANG))
        MDES1D(IXM(JPAXPD,KRANG))=MAX0 (IMDESC,IRECX)
      ENDIF
C
      IMDESC=MDES1D(IXM(JPNAPH,KRANG))
      MDES1D(IXM(JPNAPH,KRANG))=MAX0 (IMDESC,IRECX)
      KREP=0
      GOTO 1001
C**
C     9.  - CI-DESSOUS, ETIQUETTE DE BRANCHEMENT EN CAS D'ERREUR ECR.
C           ON FORCE LE CODE DE RETOUR A ETRE POSITIF.
C-----------------------------------------------------------------------
C
  903 CONTINUE
      IRETOU=1
      CLACTI='WRITE'
      KREP=IABS (KREP)
      NUMAPH(KRANG)=INAPHY
C**
C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
C-----------------------------------------------------------------------
C
 1001 CONTINUE
      LLFATA=LLMOER (KREP,KRANG)
C
      IF (KREP.EQ.0) THEN
        KRETIN=0
      ELSEIF (KREP.GT.0) THEN
        KRETIN=IRETOU
      ELSE
        KRETIN=3
      ENDIF
C
      IF (LMISOP.OR.LLFATA) THEN
        INIMES=2
        CLNSPR='LFIECX'
        WRITE (UNIT=CLMESS,FMT='(''KREP='',I5,'', KRANG='',I3,
     S       '', KREC='',I6,'', LDADON='',L2,'', KRETIN='',I2)')
     S    KREP,KRANG,KREC,LDADON,KRETIN
        CALL LFIEMS (INUMER,INIMES,KREP,.FALSE.,CLMESS,CLNSPR,CLACTI)
      ENDIF
C
      RETURN
C
      END
