      SUBROUTINE FAIRNO ( KREP, KNUMER, CDSTTU )
#include "facom0.h"
C****
C       Sous-programme de FERMETURE d'une unite logique "Fichier ARPEGE"
C**
C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
C                KNUMER (Entree) ==> Numero de l'unite logique;
C                CDSTTU (Entree) ==> "STATUS" eventuel pour "CLOSE".
C
#include "precision.h"
C
#include "facomp.h"
#include "facom1.h"
C
      INTEGER KREP, KNUMER
C
      INTEGER IREP, IRANG, J, IPOSNU, IRANGC, INIMES, ILNOMC
C
      CHARACTER CDSTTU*(*), CLSTTU*7
C
      LOGICAL LLSTTU, LLVERF, LLRLFI
C
#include "facom2.h"
C**
C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
C-----------------------------------------------------------------------
C
      IREP=0
      LLVERF=.FALSE.
      LLRLFI=.FALSE.
      CALL FANUMU (KNUMER,IRANG)
C
C         Verrouillage global eventuel.
C
      IF (LFAMUL) CALL LFIVER (VRGLAS,'ON')
C
      IF (IRANG.EQ.0) THEN
        IREP=-51
        GOTO 1001
      ELSEIF (LEN (CDSTTU).LE.0) THEN
        IREP=-65
        GOTO 1001
      ELSE
        LLSTTU=CDSTTU.EQ.'KEEP'.OR.CDSTTU.EQ.'DELETE'
C
        IF (LLSTTU) THEN
          CLSTTU=CDSTTU(1:MIN (LEN (CDSTTU),LEN (CLSTTU)))
        ELSE
          CLSTTU='DEFAUT'
        ENDIF
C
      ENDIF
C
      IF (LFAMUL) CALL LFIVER (VRFICH(IRANG),'ON')
      LLVERF=LFAMUL
C
      IF (LCREAF(IRANG).AND..NOT.LLSTTU) THEN
C
C         On force le relachement d'un fichier "parasite".
C
        LLSTTU=.TRUE.
        CLSTTU='DELETE'
      ENDIF
C**
C     2.  -  FERMETURE DU FICHIER, AU SENS DU LOGICIEL LFI.
C-----------------------------------------------------------------------
C
!     CALL LFIFER (IREP,KNUMER,CLSTTU)
C
!     IF (IREP.NE.0) THEN
!       LLRLFI=.TRUE.
!       GOTO 1001
!     ENDIF
C**
C     3.  -  "NETTOYAGE" DES TABLES AYANT PERMIS DE GERER LE FICHIER.
C            ( au moins celles ayant un caractere "global" )
C-----------------------------------------------------------------------
C
      NULOGI(IRANG)=JPNIIL
C
      DO 301 J=1,NFIOUV
C
      IF (NULIND(J).EQ.IRANG) THEN
        IPOSNU=J
        GOTO 302
      ENDIF
C
  301 CONTINUE
C
      IREP=-66
      GOTO 1001
C
  302 CONTINUE
C
      NFIOUV=NFIOUV-1
C
      DO 303 J=IPOSNU,NFIOUV
      NULIND(J)=NULIND(J+1)
  303 CONTINUE
C
      IF (LFAMUL) THEN
        CALL LFIVER (VRFICH(IRANG),'OFF')
        CALL LFIVER (VRFICH(IRANG),'REL')
      ENDIF
C
      LLVERF=.FALSE.
      IRANGC=NUCADR(IRANG)
      NULCAD(IRANGC)=NULCAD(IRANGC)-1
C
C        Si le cadre auquel etait rattache le fichier n'a plus d'autre
C     fichier rattache, et qu'on ne devait pas conserver ce cadre,
C     on le supprime.
C
      IF (NULCAD(IRANGC).LE.0.AND.
     S   (NGARDE(IRANGC).EQ.0.OR.(NGARDE(IRANGC).EQ.1.AND..NOT.LIGARD)))
     S      CALL FACTUI (IREP,IRANGC)
C**
C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
C            VIA LE SOUS-PROGRAMME "FAIPAR" .
C-----------------------------------------------------------------------
C
 1001 CONTINUE
      KREP=IREP
      LLFATA=LLMOER (IREP,IRANG)
C
C        Deverrouillage(s) eventuel(s).
C
      IF (LLVERF) CALL LFIVER (VRFICH(IRANG),'OFF')
      IF (LFAMUL) CALL LFIVER (VRGLAS,'OFF')
C
      IF (LLFATA) THEN
        INIMES=2
      ELSE
        INIMES=IXNVMS(IRANG)
      ENDIF
C
      IF (INIMES.EQ.0) RETURN
C
      CLNSPR='FAIRME'
C
      IF (IREP.EQ.-65) THEN
        ILNOMC=8
        CLACTI(1:ILNOMC)=CHAINC(:ILNOMC)
       ELSE
        ILNOMC=MIN ( LEN (CLACTI), LEN (CDSTTU) )
        CLACTI(1:ILNOMC)=CDSTTU(1:ILNOMC)
      ENDIF
C
      IF (INIMES.EQ.2) THEN
C
        ILNOMC=MIN (ILNOMC,NCPCAD)
        WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='',I3,
     S         '', CDSTTU='''''',A,'''''''')') KREP,KNUMER,
     S       CLACTI(1:ILNOMC)
        CALL FAIPAR (KNUMER,INIMES,IREP,LLFATA,CLMESS,CLNSPR,
     S               CLACTI(1:ILNOMC),LLRLFI)
C
      ENDIF
C
      RETURN
      END
