faitou.F90

Go to the documentation of this file.

! Jan-2013 P. Marguinaud Use JNGEOM & JNEXPL parameters
! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE faitou_fort                                             &
&                     (fa,  krep, knumer, ldnomm, cdnomf, cdsttu,  &
&                      lderfa, ldimst, knimes, knbarp, knbari,     &
&                      cdnomc)
USE fa_mod, ONLY : fa_com, new_fichier, jpniil, jngeom, jnexpl
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Sous-programme d'OUVERTURE d'une unite logique "Fichier ARPEGE"
!     Il s'agit d'un fichier indexe, traite par le logiciel LFI.
!
!**
!     ARGUMENTS : Ce sont les memes que pour "LFIOUV", avec CDNOMC comme
!                 argument supplementaire.
!
!                 KREP   (Sortie) ==> Code-reponse du sous-programme;
!                 KNUMER (Entree) ==> Numero de l'unite logique;
!                 LDNOMM (Entree) ==> Vrai si l'unite logique doit etre
!                                     associee a un NOM de Fichier EXP-
!                                     LICITE lors de l'"OPEN" FORTRAN;
!                 CDNOMF (Entree) ==> Nom de fichier explicite, si
!                                     *LDNOMM* est VRAI - Meme si ce
!                                     n'est pas le cas, ce *DOIT* ETRE
!                                     UN OBJET DE TYPE "CHARACTER" .
!                 CDSTTU (Entree) ==> "STATUS" pour l'"OPEN" FORTRAN
!                                     ('OLD','NEW','UNKNOWN','SCRATCH')
!                                     par defaut, mettre 'UNKNOWN';
!                 LDERFA (Entree) ==> Option d'erreur fatale;
!                 LDIMST (Entree) ==> Option impression de Statistiques
!                                     au moment de la fermeture;
!                 KNIMES (Entree) ==> Niveau de la Messagerie (0,1 ou 2)
!                                     ( 0==>Rien, 2==>Tout )
!                 KNBARP (Entree) ==> Nombre d'articles logiques prevus,
!                                     ce qui n'est utilise que lors de
!                                     la Creation du fichier,
!                                     et qui n'empeche quand meme pas
!                                     d'avoir plus d'articles logiques;
!                 KNBARI (Sortie) ==> Nombre d'articles logiques de don-
!                                     nees sur le fichier, initialement.
!                                     (zero si creation)
!                 CDNOMC (Entree) ==> Nom du CADRE associe au fichier.
!*
!     N.B. :  Pour un fichier en mode creation, ce cadre doit avoir ete
!          defini au prealable (via le sous-programme FACADE, ou par
!          l'ouverture d'un fichier preexistant).
!             Pour un fichier ARPEGE preexistant, le cadre est lu sur le
!          fichier; s'il etait deja defini auparavant, il y a controle
!          de coherence entre les deux versions du cadre.
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KREP, KNUMER, KNIMES, KNBARP, KNBARI
!
INTEGER (KIND=JPLIKB) IRANG, IRANMS
INTEGER (KIND=JPLIKB) IREPOU, ILNOMC, ILOMIN, IREP, J
INTEGER (KIND=JPLIKB) INBARP, IRANER, IRANGC
INTEGER (KIND=JPLIKB) INPAHE, INLATI, ISULEI, INPIND
INTEGER (KIND=JPLIKB) INIVER, ILONGA
INTEGER (KIND=JPLIKB) ITRONC, ILACTI, INIMES, INXLON
INTEGER (KIND=JPLIKB) ITYPTR, IPHASE, IGARDE, IPOSEX, IPUILA
!
INTEGER (KIND=JPLIKB) IDIMEN (fa%jpcadi)
INTEGER (KIND=JPLIKB) IRDPOL (fa%jpxpah+fa%jpxind)
INTEGER (KIND=JPLIKB) IDATEF (fa%jpldat), IDATXF (fa%jpldat)
INTEGER (KIND=JPLIKB) ILDIMEN(fa%jpcadi),          &
&                      ILRDPOL(FA%JPXPAH+FA%JPXIND)
INTEGER (KIND=JPLIKB) ILPNVER
!
REAL (KIND=JPDBLR) ZCHMID (fa%jpcafs), ZSINLA (fa%jpxgeo)
REAL (KIND=JPDBLR) ZHYBRI (0:(1+fa%jpxniv)*2)
!
LOGICAL LDNOMM, LDERFA, LDIMST, LLVERG, LLNOUF, LLNOUC, LLRLFI
LOGICAL LLMODC, LLREDF, LLMODA, LLMLAM
!
CHARACTER CDNOMF*(*), CDSTTU*(*), CDNOMC*(*)
!
CHARACTER(LEN=FA%JPXNOM) CLACTI 
CHARACTER(LEN=FA%JPXNOM) CLNOMA
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR
LOGICAL                  LLFATA
LOGICAL                  LLNEWF

!**
!     1.  -  CONTROLES DIVERS, ET OUVERTURE DU FICHIER AU SENS "LFI".
!-----------------------------------------------------------------------
!
!     Controle sommaire sur les arguments...le reste est "sous-traite"
!     au sous-programme LFIOUV.
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAITOU_MT',0,zhook_handle)
clacti=''
llnewf=.false.
irang=0
iraner=0
iranms=0
irepou=jpniil
llrlfi=.false.
llverg=.false.
ilnomc=int(len(cdnomc), jplikb)
ilomin=min( int(len(cdnomf), jplikb),         &
&             int(len(cdsttu), jplikb), ilnomc)
!
!        L'appel ci-dessous est legerement anticipe, de maniere a
!     initialiser les variables globales du logiciel s'il s'agit
!     du premier appel a un sous-programme de ce logiciel.
!
CALL fanumu_fort                 &
&               (fa, knumer,irang)
!        Si KNUMER est nul, alors le numero d'unite logique est
!     attribué automatiquement
IF (knumer == 0) THEN
  CALL faauto_fort  (fa, knumer, .true.)
  irang=0
ENDIF
!
IF (ilomin.LE.0) THEN
  irep=-65
  GOTO 1001
ELSEIF (irang.NE.0) THEN
!
!            Controle de non-ouverture prealable (au sens du logiciel)
!
  irep=-55
  iranms=irang
  GOTO 1001
ENDIF
!
!             Verrouillage global, si necessaire.
!
IF (fa%LFAMUL) CALL lfiver_fort                        &
&                              (fa%LFI, fa%VRGLAS,'ON')
llverg=fa%LFAMUL
!
!        A-t-on deja atteint le nombre limite de fichiers ARPEGE
!     ouverts simultanement ? Si non, on cherche un emplacement libre
!     dans la table FA%NULOGI (logiquement, il devrait en exister un)
!
IF (fa%NFIOUV.GE.fa%JPNXFA) THEN
  irep=-56
  GOTO 1001
ELSE
!
  DO j=1,fa%JPNXFA
!
  IF (fa%FICHIER(j)%NULOGI.EQ.jpniil) THEN
    irang=j
    GOTO 102
  ENDIF
!
  ENDDO
!
  irep=-66
  GOTO 1001
!
102 CONTINUE
!
ENDIF
!
!              Ouverture du fichier au sens du logiciel LFI.
!     (on ajoute au nombre d'articles prevus par l'utilisateur les
!      articles constituant le cadre, la date et l'identificateur)
!
inbarp=knbarp+7
CALL lfiouv_fort                                             &
&               (fa%LFI, irepou,knumer,ldnomm,cdnomf,cdsttu, &
&             lderfa,ldimst,                                 &
&             knimes,inbarp,knbari)
!
IF (irepou.NE.0.AND.irepou.NE.-11) THEN
  irep=irepou
  llrlfi=.true.
  GOTO 1001
ENDIF
!**
!     2.  -  CONTROLES SPECIFIQUES AU LOGICIEL DE FICHIERS ARPEGE.
!-----------------------------------------------------------------------
!
llnouf=knbari.EQ.0
CALL fanuca_fort                          &
&               (fa, cdnomc,irangc,.false.)
llnouc=irangc.EQ.0
!
IF (llnouf) THEN
!
  IF (llnouc) THEN
    irep=-57
    GOTO 1001
  ELSE
!
!         Fichier en mode creation et cadre predefini... OK a ce niveau.
!
!       On ecrit les articles definissant le cadre sur le fichier,
!     ainsi qu'un article ayant pour nom l'identificateur "par defaut",
!     (en fait, le nom du cadre) de maniere a ce que cet article soit
!     sequentiellement celui qui suit le dernier article du cadre.
!
    llmlam=fa%CADRE(irangc)%LIMLAM
!          
    idimen(1)=fa%CADRE(irangc)%MTRONC
    inlati=fa%CADRE(irangc)%NLATIT
    IF (.NOT.llmlam) THEN
       inpahe=(1+inlati)/2
    ELSE
       isulei=fa%CADRE(irangc)%NOZPAR(1)
!
       inpind=2*isulei+4
    ENDIF                   
    idimen(2)=inlati
    idimen(3)=fa%CADRE(irangc)%NXLOPA
    iniver=fa%CADRE(irangc)%NNIVER
    idimen(4)=iniver
    idimen(5)=fa%CADRE(irangc)%NTYPTR
    zchmid(1)=fa%CADRE(irangc)%SSLAPO
    zchmid(2)=fa%CADRE(irangc)%SCLOPO
    zchmid(3)=fa%CADRE(irangc)%SSLOPO
    zchmid(4)=fa%CADRE(irangc)%SCODIL
    zhybri(0)=fa%CADRE(irangc)%SPREFE
    ilnomc=fa%CADRE(irangc)%NLCCAD
    clnoma=cdnomc
!
    IF (.NOT.llmlam) THEN
!
       DO j=1,inpahe
       irdpol(j)=fa%CADRE(irangc)%NLOPAR(j)
       irdpol(inpahe+j)=fa%CADRE(irangc)%NOZPAR(j)
       zsinla(j)=fa%CADRE(irangc)%SINLAT(j)
       ENDDO
!
    ELSE
       DO j=1,jngeom
          zsinla(j)=fa%CADRE(irangc)%SINLAT(j)
       ENDDO
       DO j=1,jnexpl
          irdpol(j)=fa%CADRE(irangc)%NLOPAR(j)
       ENDDO
       DO j=1,inpind
          irdpol(jnexpl+j)=fa%CADRE(irangc)%NOZPAR(j)
       ENDDO
!
    ENDIF
!
    DO j=0,iniver
    zhybri(j+1)=fa%CADRE(irangc)%SFOHYB(1,j)
    zhybri(j+2+iniver)=fa%CADRE(irangc)%SFOHYB(2,j)
    ENDDO
!
    llrlfi=.true.
    ildimen=idimen
    CALL lfiecr_fort (fa%LFI, irep, knumer, fa%CPCADI, ildimen, fa%JPCADI)
    idimen=ildimen
    IF (irep.NE.0) GOTO 1001
!
    CALL lfiecr_rd (fa%CPCAFS, zchmid, fa%JPCAFS)
    IF (irep.NE.0) GOTO 1001
!
   IF (.NOT.llmlam) THEN
!
       ilonga=inpahe*2
       ilrdpol=irdpol
       CALL lfiecr_fort (fa%LFI, irep, knumer, fa%CPCARP, ilrdpol, ilonga)
       irdpol=ilrdpol
       IF (irep.NE.0) GOTO 1001
!
       ilonga=inpahe
       CALL lfiecr_rd (fa%CPCASL, zsinla, ilonga)
       IF (irep.NE.0) GOTO 1001
!
    ELSE
!
       ilonga=jnexpl+inpind
       ilrdpol=irdpol
       CALL lfiecr_fort (fa%LFI, irep, knumer, fa%CPCARP, ilrdpol, ilonga)
       irdpol=ilrdpol
       IF (irep.NE.0) GOTO 1001
!
       ilonga=jngeom
       CALL lfiecr_rd (fa%CPCASL, zsinla, ilonga)
       IF (irep.NE.0) GOTO 1001
!
    ENDIF
!           
    ilonga=1+(1+iniver)*2
    CALL lfiecr_rd (fa%CPCACH, zhybri, ilonga)
    IF (irep.NE.0) GOTO 1001
!
    ilpnver=fa%JPNVER
    CALL lfiecr_fort (fa%LFI, irep, knumer, clnoma(1:ilnomc), ilpnver, 1_jplikb)
    IF (irep.NE.0) GOTO 1001
!
    llrlfi=.false.
    GOTO 300
  ENDIF
!
ENDIF
!*
!     2.1 - Fichier preexistant...lecture et controle du Cadre "Fichier"
!-----------------------------------------------------------------------
!
CALL lfinfo_fort                                             &
&               (fa%LFI, irep,knumer,fa%CPCADI,ilonga,iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-60
  GOTO 1001
ELSEIF (ilonga.NE.fa%JPCADI) THEN
  irep=-61
  GOTO 1001
ENDIF
!
ildimen=idimen
CALL lfilec_fort (fa%LFI, irep, knumer, fa%CPCADI, ildimen, fa%JPCADI)
idimen=ildimen
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF
!
CALL lfinfo_fort (fa%LFI, irep, knumer, fa%CPCAFS, ilonga, iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-60
  GOTO 1001
ELSEIF (ilonga.NE.fa%JPCAFS) THEN
  irep=-61
  GOTO 1001
ENDIF
!
CALL lfilec_dr (fa%CPCAFS, zchmid, fa%JPCAFS)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF
!
!        Coherence des dimensions par rapport aux valeurs "licites",
!     que l'on doit faire avant de poursuivre les lectures.
!
IF(idimen(5).LE.0) llmlam = .true.
itronc=idimen(1)
inlati=idimen(2)
inpahe=(1+inlati)/2
inxlon=idimen(3)
iniver=idimen(4)
ityptr=idimen(5)
iphase=1
igarde=1
CALL facadi_fort                                                    &
&              (fa, irep,cdnomc,ityptr,zchmid(1),zchmid(2),         &
&               zchmid(3),zchmid(4),itronc,inlati,inxlon,irdpol(1), &
&               irdpol(fa%JPXPAH+1),zsinla,                         &
&               iniver,zhybri(0),zhybri(1),zhybri(fa%JPXNIV+2),     &
&               llmodc,llredf,iphase,irangc,ilnomc,igarde)
IF (irep.NE.0) GOTO 1001
!
CALL lfinfo_fort                                             &
&               (fa%LFI, irep,knumer,fa%CPCARP,ilonga,iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-60
  GOTO 1001
ELSEIF (ilonga.NE.inpahe*2) THEN
  IF (.NOT.llmlam) THEN
     irep=-61
     GOTO 1001
  ENDIF    
ENDIF
!
ilrdpol=irdpol
CALL lfilec_fort (fa%LFI, irep, knumer, fa%CPCARP, ilrdpol, ilonga)
irdpol=ilrdpol
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF
!
CALL lfinfo_fort                                             &
&               (fa%LFI, irep,knumer,fa%CPCASL,ilonga,iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-60
  GOTO 1001
ELSEIF (ilonga.NE.inpahe) THEN
  IF (.NOT.llmlam) THEN
     irep=-61
     GOTO 1001
  ENDIF      
ENDIF
!
CALL lfilec_dr (fa%CPCASL, zsinla, ilonga)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF
!
CALL lfinfo_fort                                             &
&               (fa%LFI, irep,knumer,fa%CPCACH,ilonga,iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-60
  GOTO 1001
ELSEIF (ilonga.NE.1+(1+iniver)*2) THEN
  IF (.NOT.llmlam) THEN
     irep=-61
     GOTO 1001
  ENDIF      
ENDIF
!
CALL lfilec_dr (fa%CPCACH, zhybri, ilonga)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF
!
!        Tests complementaires sur les valeurs lues.
!
iphase=2
CALL facadi_fort                                                    &
&              (fa, irep,cdnomc,ityptr,zchmid(1),zchmid(2),         &
&               zchmid(3),zchmid(4),itronc,inlati,inxlon,irdpol(1), &
&               irdpol(inpahe+1),zsinla,                            &
&               iniver,zhybri(0),zhybri(1),zhybri(iniver+2),        &
&               llmodc,llredf,iphase,irangc,ilnomc,igarde)
IF (irep.NE.0) GOTO 1001
!*
!     2.2 - Fichier preexistant...l'identificateur du fichier est le
!           premier article suivant les articles du cadre.
!-----------------------------------------------------------------------
!
CALL lficas_fort                                   &
&               (fa%LFI, irep,knumer,clnoma,ilonga, &
&                iposex,.false.)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-110
  GOTO 1001
ENDIF
!
!*
!     2.3 - Fichier preexistant...lecture et controle de l'article DATE.
!-----------------------------------------------------------------------
!
CALL lfinfo_fort                                             &
&               (fa%LFI, irep,knumer,fa%CPDATE,ilonga,iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  irep=-62
  GOTO 1001
ELSEIF (ilonga.NE.fa%JPLDAT) THEN
  irep=-63
  GOTO 1001
ENDIF
!
CALL lfilec_fort (fa%LFI, irep, knumer, fa%CPDATE, idatef, fa%JPLDAT)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF

!
!*
!           Fichier preexistant...lecture et controle de l'article DATX.
!-----------------------------------------------------------------------
!
CALL lfinfo_fort                                             &
&               (fa%LFI, irep,knumer,fa%CPDATX,ilonga,iposex)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ELSEIF (ilonga.EQ.0) THEN
  idatxf(:) = 0
  GOTO 103
ELSEIF (ilonga.NE.fa%JPLDAT) THEN
  irep=-63
  GOTO 1001
ENDIF
!
CALL lfilec_fort (fa%LFI, irep, knumer, fa%CPDATX, idatxf, fa%JPLDAT)
!
IF (irep.NE.0) THEN
  llrlfi=.true.
  GOTO 1001
ENDIF

103 CONTINUE

CALL new_fichier (fa, fa%FICHIER(irang), fa%JPLDAT, itronc, ityptr)
llnewf = .true.

!
!        La ligne ci-dessous evite a FANDAI de croire, eventuellement,
!     a une redefinition de date.
!
fa%FICHIER(irang)%LCREAF=.true.
!
!        Controle de la Date fichier, et stockage dans FA%MADATE.
!
CALL fandai_fort                             &
&               (fa, irep,irang,idatef,idatxf,llmoda)
IF (irep.NE.0) GOTO 1001
!
!         Definition du Cadre proprement dite.
!
iphase=3
CALL facadi_fort                                                  &
&              (fa, irep,cdnomc,ityptr,zchmid(1),zchmid(2),         &
&               zchmid(3),zchmid(4),itronc,inlati,inxlon,irdpol(1), &
&               irdpol(inpahe+1),zsinla,                            &
&               iniver,zhybri(0),zhybri(1),zhybri(iniver+2),        &
&               llmodc,llredf,iphase,irangc,ilnomc,igarde)
IF (irep.NE.0) GOTO 1001
!**
!     3.  -  ON MET A JOUR LES TABLES RELATIVES AUX FICHIERS.
!-----------------------------------------------------------------------
!
300 CONTINUE
!
itronc=fa%CADRE(irangc)%MTRONC
ityptr=fa%CADRE(irangc)%NTYPTR

IF (.NOT. llnewf) THEN
  CALL new_fichier (fa, fa%FICHIER(irang), fa%JPLDAT, itronc, ityptr)
  llnewf = .true.
ENDIF

fa%NFIOUV=fa%NFIOUV+1
fa%NULIND(fa%NFIOUV)=irang
fa%FICHIER(irang)%NULOGI=knumer
fa%FICHIER(irang)%NUCADR=irangc
!
fa%FICHIER(irang)%LNOMME=ldnomm
fa%FICHIER(irang)%NIVOMS=knimes
fa%FICHIER(irang)%LERRFA=lderfa
fa%FICHIER(irang)%LCREAF=llnouf
fa%FICHIER(irang)%NBFPDG=fa%NBIPDG
fa%FICHIER(irang)%NBFCSP=fa%NBICSP
fa%FICHIER(irang)%NPUFLA=fa%NPUILA
fa%FICHIER(irang)%NMFDPL=fa%NMIDPL
fa%FICHIER(irang)%NFGRIB=fa%NIGRIB
fa%FICHIER(irang)%CIDENT=clnoma
!
IF (ityptr.LT.0) THEN
  fa%FICHIER(irang)%NSTROF=min(fa%NSTROI,itronc-1,-ityptr-1)
ELSE
  fa%FICHIER(irang)%NSTROF=min(fa%NSTROI,itronc-1)
ENDIF
!
! Appel a FAINOC pour interpreter les eventuels defauts
! de -1 pris par FA%NBFPDG, FA%NBFCSP, FA%NSTROF et FA%NPUFLA en
! IRANG-ieme position.
!
CALL fainoc_fort            &
&               (fa,  irang )
!
iraner=irang
iranms=irang
ipuila=fa%FICHIER(irang)%NPUFLA
!
fa%FICHIER(irang)%NCOGRIF(:)=fa%NCODGRI(:)
fa%FICHIER(irang)%NRASHO = 0
fa%FICHIER(irang)%NRASVE = 0
!
!   L'initialisation de FLAP1Dx sera faite dans FACSIM
!
fa%FICHIER(irang)%LIFLAP=.true.
!
!
IF (fa%LFAMUL) CALL lfiver_fort                                 &
&                              (fa%LFI, fa%FICHIER(irang)%VRFICH,'ASGN')
!
!        On incremente le nombre de fichiers attaches au cadre specifie.
!
fa%CADRE(irangc)%NULCAD=fa%CADRE(irangc)%NULCAD+1
irep=irepou
GOTO 1001
!**
!     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
!-----------------------------------------------------------------------
!
clacti='INQUIRE'
!
!      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
!
irep=abs(irep)
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE SOUS-PROGRAMME "LFIEMS" .
!-----------------------------------------------------------------------
!
1001 CONTINUE
krep=irep
llfata=llmoer(irep,iraner)
!
IF (llfata) THEN
  inimes=2
ELSE
  inimes=ixnvms(iranms)
ENDIF
!
!           Deverrouillage global eventuel.
!
IF (llverg) CALL lfiver_fort                         &
&                           (fa%LFI, fa%VRGLAS,'OFF')
!
IF (.NOT.llfata.AND.inimes.EQ.0)  THEN 
  IF (lhook) CALL dr_hook('FAITOU_MT',1,zhook_handle)
  RETURN
ENDIF
!
clnspr='FAITOU'
!
IF (inimes.EQ.2) THEN
!
  IF (ilnomc.GT.0) THEN
    ilacti=min(int(len(clacti), jplikb),ilnomc)
    clacti(1:ilacti)=cdnomc(1:ilnomc)
  ELSE
    ilacti=8
    clacti=fa%CHAINC(:ilacti)
  ENDIF
!
  WRITE (unit=clmess,fmt='(''KREP='',I4,'', KNUMER='',I3,          &
&     '', LDNOMM= '',L1,'', CDSTTU='''''',A7,'''''', LDERFA= '',L1, &
&     '',  LDIMST= '',L1,                                           &
&         '', KNIMES='',I2,'', KNBARP='',I6,'' KNBARI='',I6)')      &
&   krep,knumer,ldnomm,cdsttu,lderfa,ldimst,knimes,knbarp,knbari
  CALL faipar_fort                                      &
&                 (fa, knumer,inimes,irep,.false.,clmess, &
&                  clnspr,clacti(1:ilacti),llrlfi)
  clmess='CDNOMC='''//clacti(1:ilacti)//''''
  CALL faipar_fort                                     &
&                 (fa, knumer,inimes,irep,llfata,clmess, &
&               clnspr,clacti(1:ilacti),llrlfi)
ENDIF
!
IF (lhook) CALL dr_hook('FAITOU_MT',1,zhook_handle)

CONTAINS

#include "facom2.llmoer.h"
#include "facom2.ixnvms.h"

SUBROUTINE lfilec_dr (CDNOMA, PDONNE, KLONGA)

CHARACTER(LEN=*)      :: CDNOMA
INTEGER (KIND=JPLIKB) :: KLONGA
REAL (KIND=JPDBLR)    :: PDONNE (klonga)
REAL (KIND=JPDBLD)    :: ZDONNE (klonga)

CALL lfilec_fort (fa%LFI, irep, knumer, cdnoma, zdonne, klonga)

pdonne = real(zdonne, jpdblr)

END SUBROUTINE lfilec_dr

SUBROUTINE lfiecr_rd (CDNOMA, PDONNE, KLONGA)

CHARACTER(LEN=*)      :: CDNOMA
INTEGER (KIND=JPLIKB) :: KLONGA
REAL (KIND=JPDBLR)    :: PDONNE (klonga)
REAL (KIND=JPDBLD)    :: ZDONNE (klonga)

zdonne = real(pdonne, jpdbld)

CALL lfiecr_fort (fa%LFI, irep, knumer, cdnoma, zdonne, klonga)

END SUBROUTINE lfiecr_rd

END SUBROUTINE faitou_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE faitou64                                      &
&           (krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, knbarp, knbari, cdnomc)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KREP                                   !   OUT
INTEGER (KIND=JPLIKB)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 ! IN   
CHARACTER (LEN=*)      CDNOMF                                 ! IN   
CHARACTER (LEN=*)      CDSTTU                                 ! IN   
LOGICAL                LDERFA                                 ! IN   
LOGICAL                LDIMST                                 ! IN   
INTEGER (KIND=JPLIKB)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKB)  KNBARP                                 ! IN   
INTEGER (KIND=JPLIKB)  KNBARI                                 !   OUT
CHARACTER (LEN=*)      CDNOMC                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faitou_fort                                             &
&           (fa, krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, knbarp, knbari, cdnomc)

END SUBROUTINE faitou64

SUBROUTINE faitou                                        &
&           (krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, knbarp, knbari, cdnomc)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 ! IN   
CHARACTER (LEN=*)      CDNOMF                                 ! IN   
CHARACTER (LEN=*)      CDSTTU                                 ! IN   
LOGICAL                LDERFA                                 ! IN   
LOGICAL                LDIMST                                 ! IN   
INTEGER (KIND=JPLIKM)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARP                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARI                                 !   OUT
CHARACTER (LEN=*)      CDNOMC                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faitou_mt                                                 &
&           (fa, krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&            ldimst, knimes, knbarp, knbari, cdnomc)

END SUBROUTINE faitou

SUBROUTINE faitou_mt                                           &
&           (fa, krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&            ldimst, knimes, knbarp, knbari, cdnomc)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 ! IN   
CHARACTER (LEN=*)      CDNOMF                                 ! IN   
CHARACTER (LEN=*)      CDSTTU                                 ! IN   
LOGICAL                LDERFA                                 ! IN   
LOGICAL                LDIMST                                 ! IN   
INTEGER (KIND=JPLIKM)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARP                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARI                                 !   OUT
CHARACTER (LEN=*)      CDNOMC                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  IREP                                   !   OUT
INTEGER (KIND=JPLIKB)  INUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  INIMES                                 ! IN   
INTEGER (KIND=JPLIKB)  INBARP                                 ! IN   
INTEGER (KIND=JPLIKB)  INBARI                                 !   OUT
! Convert arguments

inumer     = int(    knumer, jplikb)
inimes     = int(    knimes, jplikb)
inbarp     = int(    knbarp, jplikb)

CALL faitou_fort                                              &
&          (fa, irep, inumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, inimes, inbarp, inbari, cdnomc)

krep       = int(      irep, jplikm)
knbari     = int(    inbari, jplikm)

IF (knumer == 0) THEN
  knumer = int(    inumer, jplikm)
ENDIF

END SUBROUTINE faitou_mt

!INTF KREP            OUT 
!INTF KNUMER        IN    
!INTF LDNOMM        IN    
!INTF CDNOMF        IN    
!INTF CDSTTU        IN    
!INTF LDERFA        IN    
!INTF LDIMST        IN    
!INTF KNIMES        IN    
!INTF KNBARP        IN    
!INTF KNBARI          OUT 
!INTF CDNOMC        IN