      SUBROUTINE FATRAN ( KREP,  KNUMER,  PCHAME, PCHAMS, LDOPT )
#include "facom0.h"
C****
C      Sous-programme du logiciel de Fichiers ARPEGE permettant la
C      TRANsposition d'un champ spectral ARPEGE ou ALADIN,
C      d'un rangement des coeff selon le MODELE vers un rangement
C      des coeff selon FA+GRIB_version0 et inversement.
C
C**
C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
C                KNUMER (Entree) ==> Rang de l'unite logique;
C    ( Tableau ) PCHAME (Entree) ==> Valeurs du champ a transposer;
C    ( Tableau ) PCHAMS (Sortie) ==> Valeurs du champ transpose;
C                LDOPT   (Entree) ==> Option de transposition;
C                                    si .TRUE.  alors PCHAME range comme MODELE
C                                                     (soit "verticalement")
C                                                     PCHAMS range comme FA-GRIB0
C                                                     (soit "horizontalement")
C                                    si .FALSE. alors PCHAME range comme FA-GRIB0
C                                                     PCHAMS range comme MODELE
C*
C
      USE FAMODU   , ONLY : NOMPAR
C
#include "precision.h"
C
#include "facomp.h"
#include "facom1.h"
C
      INTEGER KREP, KNUMER
C
      LOGICAL LDOPT
C
      REAL (KIND=JPDBLR) PCHAME(*), PCHAMS(*)
C
      INTEGER JN, JM, J, INDEX, ILOW, IHIGH, IRANGC, IRANG
      INTEGER INIMES, ITRONC, IMSMAX
      INTEGER, ALLOCATABLE :: IND(:,:)
      INTEGER INDIRECT((JPXTRO+1)*(JPXTRO+2),JPNXCA)
C
      LOGICAL LLMLAM, LLINDIR(JPNXCA)
C
#include "facom2.h"
C
      SAVE LLINDIR, INDIRECT
C
      DATA LLINDIR / JPNXCA*.TRUE. /
C
C**
C     1.  -  CONTROLES ET INITIALISATIONS.
C-----------------------------------------------------------------------
C
      KREP=0
      CALL FANUMU (KNUMER,IRANG)
C
      IF (IRANG.EQ.0) THEN
        KREP=-51
        GOTO 1001
      ENDIF
      IRANGC=NUCADR(IRANG)
      LLMLAM=LIMLAM(IRANGC)
      ITRONC=MTRONC(IRANGC)
      IF (LLMLAM) THEN
        IMSMAX = NOMPAR(2,IRANGC)
      ENDIF
C
C Initialisation de l'indirection pour IRANGC, si ce n'est pas deja fait.
C Si ARPEGE, INDIRECT(J,IRANGC)=INDEX signifie que les indices J dans
C   le tableau "FA+GRIB0" et INDEX dans le tableau "modele ARPEGE"
C    designent un meme coeff spectral.
C Si Aladin, INDIRECT(JM*(ITRONC+1)+JN+1,IRANGC)=J signifie que l'indice
C   J dans le tableau "FA+GRIB0" est le premier coeff associe au couple (JM,JN)
C   ou JM est le nombre d'onde zonal et JN le nombre d'onde meridien.
C   4 coeff spectraux sont associes a chaque couple (JM,JN) car JM varie
C   de 0 a IMSMAX et JN varie de 0 a ITRONC (soit 1/4 de l'ellipse).
C
C  CAS ARPEGE
C
      IF (LLINDIR(IRANGC).AND..NOT.LLMLAM) THEN
        ALLOCATE (IND(0:JPXTRO,-JPXTRO:JPXTRO))
        DO JN=0,ITRONC
          ILOW=JN**2+1
          IHIGH=(JN+1)**2
          JM=-JN-1
          DO J=ILOW,IHIGH
            JM=JM+1
            IND(JN,JM)=J
          ENDDO
        ENDDO
C
        INDEX=-1
        DO JM=0,ITRONC
        DO JN=JM,ITRONC
          INDEX=INDEX+2
          INDIRECT  (IND(JN, JM),IRANGC)=INDEX
          IF (JM.NE.0) THEN
            INDIRECT(IND(JN,-JM),IRANGC)=INDEX+1
          ENDIF
        ENDDO
        ENDDO
        LLINDIR(IRANGC)=.FALSE.
        DEALLOCATE (IND)
      ENDIF
C
C  CAS ALADIN
C
      IF (LLINDIR(IRANGC).AND.LLMLAM) THEN
        DO JN=0,ITRONC
        DO J=NOZPAR(2*JN+3,IRANGC), NOZPAR(2*JN+4,IRANGC), 4
          JM=(J-NOZPAR(2*JN+3,IRANGC)) / 4
          INDIRECT(JM*(ITRONC+1)+JN+1,IRANGC) = J
        ENDDO
        ENDDO
        LLINDIR(IRANGC)=.FALSE.
      ENDIF
C**
C     2.  -  TRANSPOSITION DES DONNEES
C-----------------------------------------------------------------------
C
C  CAS ALADIN
C
      IF (LLMLAM) THEN
          IF (LDOPT) THEN
C PCHAME range comme MODELE (soit "verticalement")
C
          DO JM=0,IMSMAX
          DO INDEX=NOMPAR(2*JM+3,IRANGC), NOMPAR(2*JM+4,IRANGC), 4
            JN = (INDEX-NOMPAR(2*JM+3,IRANGC)) / 4
            J  = INDIRECT(JM*(ITRONC+1)+JN+1,IRANGC)
            PCHAMS(J  )=PCHAME(INDEX  )  
            PCHAMS(J+1)=PCHAME(INDEX+1)
            PCHAMS(J+2)=PCHAME(INDEX+2)
            PCHAMS(J+3)=PCHAME(INDEX+3)
          ENDDO
          ENDDO
        ELSE
C PCHAME range comme FA+GRIB0 (soit "horizontalement")
C
          DO JM=0,IMSMAX
          DO INDEX=NOMPAR(2*JM+3,IRANGC), NOMPAR(2*JM+4,IRANGC), 4
            JN = (INDEX-NOMPAR(2*JM+3,IRANGC)) / 4
            J  = INDIRECT(JM*(ITRONC+1)+JN+1,IRANGC)
            PCHAMS(INDEX  )=PCHAME(J  )  
            PCHAMS(INDEX+1)=PCHAME(J+1)
            PCHAMS(INDEX+2)=PCHAME(J+2)
            PCHAMS(INDEX+3)=PCHAME(J+3)
          ENDDO
          ENDDO
        ENDIF
      ELSE
C
C  CAS ARPEGE
C
C  1/ Passage du rangement des coeff. spectraux du type modele ARPEGE
C  a celui de FA associe a GRIB version0 (et pas associe a GRIBEX qui
C  reprend la structure de tableau de ARPEGE).
C
        IF (LDOPT) THEN
          DO JN=0,ITRONC
            ILOW=JN**2+1
            IHIGH=(JN+1)**2
            DO J=ILOW,IHIGH
              PCHAMS(J)=PCHAME(INDIRECT(J,IRANGC))
            ENDDO
          ENDDO
C
C  2/ Passage du rangement des coeff. spectraux du type FA associe
C  a GRIB version0 (et pas associe a GRIBEX qui reprend la structure de
C  tableau de ARPEGE) a celui du type modele ARPEGE.
C
        ELSE
C  Initialisation de la partie "JM=0" a zero, pour y introduire
C  ensuite uniquement les coeff reels correspondant dans PCHAME
C  (les coeff imaginaires etant donc crees et mis a zero).
          PCHAMS(1:2*(ITRONC+1))=0.
C
          DO JN=0,ITRONC
            ILOW=JN**2+1
            IHIGH=(JN+1)**2
            DO J=ILOW,IHIGH
              PCHAMS(INDIRECT(J,IRANGC))=PCHAME(J)
            ENDDO
          ENDDO
        ENDIF
      ENDIF
C
C**
C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
C            VIA LE SOUS-PROGRAMME "FAIPAR" .
C-----------------------------------------------------------------------
C
 1001 CONTINUE
      LLFATA=LLMOER (KREP,IRANG)
C
      IF (LLFATA) THEN
        INIMES=2
      ELSE
        INIMES=IXNVMS(IRANG)
      ENDIF
C
      IF (INIMES.EQ.0) RETURN
C
      CLNSPR='FATRAN'
C
      WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', IRANG='',I4,
     S         '', LDOPT='',L)')  KREP, IRANG, LDOPT
      CALL FAIPAR (KNUMER,INIMES,KREP,LLFATA,CLMESS,CLNSPR,
     S               CLNSPR,.FALSE.)
C
      RETURN
      END
