      SUBROUTINE FACOND ( KREP,   KNUMER, CDPREF, KNIVAU, CDSUFF,
     S                    PCHAMP, LDCOSP, CDNOMA, KLNOMA, PVALCO,
     S                    KLONGD )
#include "facom0.h"
C****
C      Sous-programme de CODAGE d'un CHAMP HORIZONTAL destine a etre
C      ecrit sur un fichier ARPEGE/ALADIN.
C       ( COdage de (Nouvelles ?) Donnees )
C**
C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
C                KNUMER (Entree) ==> Numero de l'unite logique;
C                CDPREF (Entree) ==> Prefixe eventuel du nom d'article;
C                KNIVAU (Entree) ==> Niveau vertical eventuel;
C                CDSUFF (Entree) ==> Suffixe eventuel du nom d'article;
C    ( Tableau ) PCHAMP (Entree) ==> Valeurs REELLES du champ a ecrire;
C                LDCOSP (Entree) ==> Vrai si le champ est represente
C                                    par des coefficients spectraux;
C                CDNOMA (Sortie) ==> Nom de l'article-champ a ecrire;
C                KLNOMA (Sortie) ==> Nombre de caracteres utiles dans
C                                    CDNOMA;
C    ( Tableau ) PVALCO (Sortie) ==> Donnees destinees a l'ecriture;
C                KLONGD (Sortie) ==> Nombre de valeurs (mots de 64 bits
C                                    en principe) a ecrire.
C
C    Remarques:
C
C    - PVALCO est type reel par commodite, et doit avoir une longueur
C      suffisante pour stocker les donnees codees. Le dimensionnement
C      "tous terrains" est (2+ILCHAM), qui permet le cas echeant de
C      stocker un champ a pleine resolution sans codage effectif.
C      (ILCHAM est le nombre de valeurs du champ a ecrire)
C
C    - CDNOMA doit avoir au moins JPXNOM caracteres.
#include "precision.h"
C
#include "facomp.h"
#include "facom1.h"
C
      INTEGER KREP, KNUMER, KNIVAU, KLNOMA, KLONGD
C
      REAL (KIND=JPDBLR) PCHAMP (*), PVALCO (*)
C
      CHARACTER CDPREF*(*), CDSUFF*(*), CDNOMA*(*)
C
      INTEGER IREP, ILPRFU, ILSUFU, ILNOMU, ILONGA, IRANG, INIMES
      INTEGER ILPREF, ILSUFF, ILCDNO, IRANGC
      INTEGER IB1PAR (JPLB1P)
C
      LOGICAL LLVERF, LLRLFI, LDCOSP, LLNOMU, LLNOPA
C
      CHARACTER CLPREF*(JPXNOM), CLSUFF*(JPXSUF)
C
#include "facom2.h"
C**
C     1.  -  CONTROLES ET INITIALISATIONS.
C-----------------------------------------------------------------------
C
      LLVERF=.FALSE.
      LLRLFI=.FALSE.
      LLNOMU=.FALSE.
      LLNOPA=.FALSE.
      ILPRFU=LEN (CDPREF)
      ILSUFU=LEN (CDSUFF)
      ILCDNO=LEN (CDNOMA)
      KLNOMA=0
      CALL FANUMU (KNUMER,IRANG)
C
      IF (IRANG.EQ.0) THEN
        IREP=-51
        GOTO 1001
      ELSEIF (ILCDNO.LT.JPXNOM) THEN
        IREP=-65
        GOTO 1001
      ELSE
        CDNOMA=' '
      ENDIF
C
C         Verrouillage eventuel du fichier.
C
      IF (LFAMUL) CALL LFIVER (VRFICH(IRANG),'ON')
      LLVERF=LFAMUL
C
      IF (LCREAF(IRANG)) THEN
        IREP=-85
        GOTO 1001
      ENDIF
C**
C     2.  -  FABRICATION DU NOM D'ARTICLE VIA LE SOUS-PROGRAMME "FANFAR"
C            ( controles de CDPREF, KNIVAU, CDSUFF inclus )
C-----------------------------------------------------------------------
C
      CALL FANFAR (IREP,IRANG,CDPREF,KNIVAU,CDSUFF,CDNOMA,IB1PAR(6),
     S             ILPRFU,ILSUFU,ILNOMU)
      IF (IREP.NE.0) GOTO 1001
      LLNOMU=.TRUE.
      KLNOMA=ILNOMU
C**
C     3.  -  FABRICATION DE L'ARTICLE A ECRIRE SUR LE FICHIER.
C-----------------------------------------------------------------------
C
C
C  Controle de l'homogeneite du type de rangement des coeff. spectraux
C  parmi les champs lus/ecrits: ces champs compactes avec
C  NIGRIB=-1 ou 3 doivent etre ranges comme dans le modele ("verticalement"
C  soit selon des colonnes JM=cst consecutives) et contrairement si compactes
C  avec NIGRIB= 0,1 ou 2.
C 
      IRANGC=NUCADR(IRANG)
      IF (LDCOSP) THEN
        IF (NFGRIB(IRANG).EQ.-1.OR.NFGRIB(IRANG).EQ.3) THEN
          NRASVE(IRANG)=NRASVE(IRANG)+1
          IF (NRASVE(IRANG).EQ.1.AND.NRASHO(IRANG).GT.0) THEN
            WRITE(0,*)'------------------------------------------------'
            WRITE(0,*)' FACOND :  WARNING !!!!!           '
            WRITE(0,*)' Un champ de coeff. spectraux avec'
            WRITE(0,*)' rangement type modele va etre ecrit alors que'
            WRITE(0,*)' d''autres champs spec. ont un rangt different.'
            WRITE(0,*)'------------------------------------------------'
          ENDIF
        ELSEIF (NFGRIB(IRANG).GE.0.AND.NFGRIB(IRANG).LE.2) THEN
          NRASHO(IRANG)=NRASHO(IRANG)+1
          IF (NRASHO(IRANG).EQ.1.AND.NRASVE(IRANG).GT.0) THEN
            WRITE(0,*)'------------------------------------------------'
            WRITE(0,*)' FACOND :  WARNING !!!!!           '
            WRITE(0,*)' Un champ de coeff. spectraux avec'
            WRITE(0,*)' rangt autre que celui du modele va etre ecrit'
            WRITE(0,*)' alors que d''autres champs ont le rangt modele'
            WRITE(0,*)'------------------------------------------------'
          ENDIF
        ENDIF
      ENDIF
C
500   CONTINUE
C
      IF (NFGRIB(IRANG).EQ.3) THEN
C Cas d'un champ qu'il faut "griber" avec GRIBEX
        CALL FACODX ( IREP, IRANG, CDPREF, KNIVAU, CDSUFF, PCHAMP,
     S                LDCOSP, PVALCO, KLONGD)
C
C Cas particulier de l'erreur GRIBEX num 710: OUTPUT ARRAY TOO SMALL
C On s'en sert pour detecter un probleme de compactage lie a ce que
C le champ compacte + les descripteurs prennent plus de place que le
C champ non compacte...
C On sort donc du compactage (FACODX) pour demander un codage sans
C compactage (FACINE) avec rangement des valeurs selon le modele:
C NFGRIB=-1.
C
        IF (IREP==-1710) THEN
          IREP = 0
          NFGRIB(IRANG) = -1
          LLNOPA = .TRUE.
          GOTO 500
        ENDIF
      ELSE
        CALL FACINE ( IREP, IRANG, CDNOMA(1:ILNOMU), PCHAMP,
     S                LDCOSP, PVALCO, KLONGD, IB1PAR )
        IF (LLNOPA) NFGRIB(IRANG) = 3
C  Le codage num 3 avait ete demande mais se revelait etre
C  plus gourmand en place que le num -1: on avait donc force
C  l'absence de compactage (-1). On revient maintenant au codage
C  num 3 pour ce cadre IRANG et les eventuels codages suivants.
C
      ENDIF
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 eventuel du fichier.
C
      IF (LLVERF) CALL LFIVER (VRFICH(IRANG),'OFF')
C
      IF (LLFATA) THEN
        INIMES=2
      ELSE
        INIMES=IXNVMS(IRANG)
      ENDIF
C
      IF (.NOT.LLFATA.AND.INIMES.NE.2) RETURN
C
      CLNSPR='FACOND'
C
      IF (ILPRFU.GE.1) THEN
        ILPREF=MIN (ILPRFU,LEN (CLPREF))
        CLPREF(1:ILPREF)=CDPREF(1:ILPREF)
      ELSE
        ILPREF=8
        CLPREF(1:ILPREF)=CHAINC(:ILPREF)
      ENDIF
C
      IF (ILSUFU.GE.1) THEN
        ILSUFF=MIN (ILSUFU,LEN (CLSUFF))
        CLSUFF(1:ILSUFF)=CDSUFF(1:ILSUFF)
      ELSE
        ILSUFF=8
        CLSUFF(1:ILSUFF)=CHAINC(:ILSUFF)
      ENDIF
C
      IF (.NOT.LLNOMU) THEN
        ILNOMU=MIN (ILPREF,NCPCAD)
        CDNOMA(1:ILNOMU)=CLPREF(1:ILPREF)
      ENDIF
C
      WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='',I3,
     S       '', CDPREF='''''',A,'''''', KNIVAU='',I6,
     S       '', CDSUFF='''''',A,'''''', LDCOSP= '',L1)')
     S   KREP,KNUMER,CLPREF(1:ILPREF),KNIVAU,CLSUFF(1:ILSUFF),LDCOSP
      CALL FAIPAR (KNUMER,INIMES,IREP,LLFATA,CLMESS,CLNSPR,
     S             CDNOMA(1:ILNOMU),LLRLFI)
C
      RETURN
      END
