lfiouv.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe LFI
! Sep-2012 P. Marguinaud Fix uninitialized variables

SUBROUTINE lfiouv_fort                                     &
&                     (lfi, krep, knumer, ldnomm, cdnomf,  &
&                      cdstto, lderfa,                     &
&                      ldimst, knimes, knbarp, knbari )
USE lfimod, ONLY : lficom, lficrw
USE parkind1, ONLY : jprb, jpia, jpim, jpib
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        SOUS-PROGRAMME D'OUVERTURE D'UNE UNITE LOGIQUE DEVANT ETRE
!     TRAITEE COMME UN FICHIER INDEXE, PAR LE LOGICIEL LFI.
!**
!     ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
!                 KNUMER (ENTREE) ==> LFI%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" .
!                 CDSTTO (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)
CHARACTER CPNOMD*(*)
parameter( cpnomd='%%%%% FICHIER SANS NOM %%%%%' )
!
!    Modifications:
!
!    02/06/97, Jean Clochard.
!
!              -Modification des impressions pour que l'annee puisse
!               etre imprimee avec 4 chiffres.
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KREP, KNUMER, KNIMES, KNBARP, KNBARI
INTEGER (KIND=JPLIKB) IDATE, IHEURE
INTEGER (KIND=JPLIKB) ILSTTU, IREPX, IRANG, IRANMS, INBARI 
INTEGER (KIND=JPLIKB) IDECBL, IPOSBL, J
INTEGER (KIND=JPLIKB) ILNOMF, INLNOM, INIMES, IREP, ILNOMS 
INTEGER (KIND=JPLIKB) IFACTM, ILSTTO, IJ
INTEGER (KIND=JPLIKB) IRANFM, ILACTI, ICOMPT, ITAILS, ICRITS
INTEGER (KIND=JPLIKB) IPOFIN, ICRITG
INTEGER (KIND=JPLIKB) ICRITD, ICRITR, IPOSCA, INREAD, INWRIT
INTEGER (KIND=JPLIKB) IBASE, ILOREC
INTEGER (KIND=JPLIKB) INAPHY, JREC, ILARPH, INALPP, IFACPH 
INTEGER (KIND=JPLIKB) IFACPP, INBPIR
INTEGER (KIND=JPLIKB) IRANGD, IREC, INBALO, ILUTIL, IRGPIF 
INTEGER (KIND=JPLIKB) IRETIN
type(lficrw)         ylfic
INTEGER (KIND=JPIB)   IISLEN
!
LOGICAL LDNOMM, LDERFA, LDIMST, LLEXFI, LLNOUF, LLNOMS
LOGICAL LLVERG, LLEXUL
LOGICAL LLISLE
LOGICAL LLRQLE
!
CHARACTER CDNOMF*(*), CDSTTO*(*)
CHARACTER*(LFI%JPLSTX) CLSTTO
CHARACTER*(LFI%JPLFTX) CLNOMF, CLNOMS

!
CHARACTER(LEN=LFI%JPLSPX) CLNSPR
CHARACTER(LEN=LFI%JPLMES) CLMESS
CHARACTER(LEN=LFI%JPLFTX) CLACTI
CHARACTER(LEN=32)         CLENDI
LOGICAL LLFATA

!
!     1.  -  CONTROLES DIVERS, ET INITIALISATIONS.
!-----------------------------------------------------------------------
!*
!     1.0 - PARTIE "ELEMENTAIRE".
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFIOUV_FORT',0,zhook_handle)
clacti=''
ilsttu=min(int(len(clstto), jplikb),  &
&            int(len(cdstto), jplikb))
irepx=0
irang=0
iranms=0
inbari=0
llverg=.false.
llisle=.false.
llrqle=.false.
ylfic%L_C_BTSWAP=.false.
!
clendi=''
CALL get_environment_variable ("LFI_BYTE_ORDER", clendi)
CALL iswap_isle (iislen)
llisle=iislen.NE.0      
SELECT CASE (clendi)
  CASE ('LITTLE_ENDIAN')
    llrqle=.true.
  CASE ('BIG_ENDIAN')
    llrqle=.false.
  CASE ('NATIVE_ENDIAN')
    llrqle=llisle
  CASE DEFAULT
    llrqle=.false.
END SELECT
!
ylfic%L_C_BTSWAP=(llisle.AND.(knumer<0)).NEQV.llrqle
!
ylfic%N_C_FPDESC=0
ylfic%N_C_OFFSET=0
!
!        Appel legerement anticipe a LFINUM, permettant une initialisa-
!     tion des variables globales du logiciel a la 1ere utilisation.
!
CALL lfinum_fort                    &
&               (lfi, knumer, irang)
!        Si KNUMER est nul, alors le numero d'unite logique est
!     attribué automatiquement
IF (knumer == 0) THEN
  CALL lfiuto_fort    (lfi, knumer)
  irang=0
ENDIF
!
IF (ldnomm) THEN
!
!        Recherche de la longueur "utile" du nom de fichier specifie.
!        (c'est-a-dire sans tenir compte des blancs terminaux eventuels)
!
  idecbl=0
!
101 CONTINUE
  iposbl=idecbl+int(index(cdnomf(idecbl+1:),' '), jplikb)
!
  IF (iposbl.LE.idecbl) THEN
    ilnomf=int(len(cdnomf), jplikb)
  ELSEIF (cdnomf(iposbl:).EQ.' ') THEN
    ilnomf=max(iposbl-1,1_jplikb )
  ELSE
    idecbl=iposbl
    GOTO 101
  ENDIF
!
  IF (ilnomf.GT.lfi%JPLFTX) THEN
    inlnom=lfi%JPLFTX
    inimes=lfi%NIMESG
!
    IF (inimes.GE.1) THEN
!
!        Message preventif, car le controle de non ouverture d'un meme
!     fichier via deux unites logiques differentes risque de "sauter"
!     artificiellement... et pas forcement a cet appel.
!
!        Le code-reponse ci-dessous est bidon, mais permet de mettre
!     en relief le message via LFIEMS.
!
      irep=lfi%JPNIL
      clnspr='LFIOUV'
!
      IF (lfi%LFRANC) THEN
        WRITE (unit=clmess,fmt=                              &
&               '(''ATTENTION: NOM DE FICHIER TRONQUE A'',I4, &
&                 '' CARACTERES...'')') lfi%JPLFTX
      ELSE
        WRITE (unit=clmess,fmt=                               &
&               '(''WARNING: FILE NAME TRUNCATED TO ONLY'',I4, &
&                 '' CHARACTERS...'')') lfi%JPLFTX
      ENDIF
!
      CALL lfiems_fort                                  &
&                     (lfi, knumer,inimes,irep,.false., &
&                      clmess,clnspr,                   &
&                      clacti)
    ENDIF
!
  ELSE
    inlnom=ilnomf
  ENDIF
!
  clnomf=cdnomf(:inlnom)
ELSE
  ilnomf=int(len(cpnomd), jplikb)
  clnomf=cpnomd
  inlnom=ilnomf
ENDIF
!
!       Ci-dessous, initialisations destinees a forcer l'impression
!     du nom du fichier en cas de problemes.
!
clnoms=clnomf
ilnoms=inlnom
ifactm=0
!
!        Controle de validite FORTRAN du Numero d'Unite Logique.
!
IF (knumer > 0) THEN
  INQUIRE (unit=knumer,exist=llexul,err=901,iostat=irep)
ELSE
  llexul=.true.
ENDIF
!
IF (.NOT.llexul) THEN
  irep=-30
  GOTO 1001
ENDIF
!
!        CONTROLE DE L'ARGUMENT D'APPEL "KNIMES"
!
IF (knimes.LT.0.OR.knimes.GT.2) THEN
  irep=-2
  GOTO 1001
ENDIF
!
!        CONTROLE DE L'ARGUMENT D'APPEL "CDSTTO"
!
ilstto=int(index(cdstto,' '), jplikb)-1
DO j=1,lfi%JPNBST
IF (cdstto(1:ilstto).EQ.lfi%LFIOUV_CLSTEX(j)(1:ilstto)) GOTO 104
ENDDO
!
ilacti=min(int(len(cdstto), jplikb),int(len(clacti), jplikb))
clacti=cdstto(:ilacti)
irep=-7
GOTO 1001
!
104 CONTINUE
IF (ilstto.GT.0) ilsttu=ilstto
clstto=cdstto(:ilsttu)
!
!               CONTROLE DE NON-OUVERTURE PREALABLE.
!
IF (irang.NE.0) THEN
  irep=-5
  GOTO 1001
ENDIF
!
IF (lfi%LMULTI) CALL lfiver_fort                       &
&                               (lfi, lfi%VERGLA,'ON')
llverg=lfi%LMULTI
!
!        Recherche d'un eventuel facteur multiplicatif predefini pour
!     l'unite logique en question.
!
CALL lfifmp_fort                     &
&               (lfi, knumer,iranfm)
ifactm=lfi%MFACTU(iranfm)
!
IF (ldnomm) THEN
!
!        SI LE FICHIER EST NOMME, ON VERIFIE QU'IL N'A PAS ETE
!        DEJA OUVERT POUR UNE AUTRE UNITE LOGIQUE.
!
  DO j=1,lfi%NBFIOU
  ij=lfi%NUMIND(j)
!
  IF (clnomf.EQ.lfi%CNOMFI(ij)(:min(lfi%JPLFTX,lfi%NLNOMF(ij)))) &
&  THEN
    ilacti=min(int(len(clnomf), jplikb), &
&               int(len(clacti), jplikb))
    clacti=clnomf(:ilacti)
    iranms=ij
    irep=-13
    GOTO 1001
  ENDIF
!
  ENDDO
!
ENDIF
!
110 CONTINUE
!*
!     1.1 - RECHERCHE D'UN EMPLACEMENT DISPONIBLE DANS LA TABLE DES
!           NUMEROS D'UNITES LOGIQUES *LFI%NUMERO* .
!           (Il faut IFACTM emplacements CONSECUTIFS)
!-----------------------------------------------------------------------
!
IF ((lfi%NFACTM+ifactm).GT.lfi%JPNXFI) THEN
  irep=-6
  GOTO 1001
ENDIF
!
icompt=0
itails=lfi%JPNXFI+1
icrits=0
!
DO j=1,lfi%JPNXFI
!
IF (lfi%NUMERO(j).EQ.lfi%JPNIL) THEN
  icompt=icompt+1
  IF (j.NE.lfi%JPNXFI.OR.icompt.LT.ifactm.OR.icompt.GT.itails) &
&    cycle
  ipofin=lfi%JPNXFI
ELSEIF (icompt.LT.ifactm.OR.icompt.GT.itails) THEN
  icompt=0
!
  IF ((lfi%JPNXFI-j).LT.ifactm) THEN
    GOTO 112
  ELSE
    cycle
  ENDIF
!
ELSE
  ipofin=j-1
ENDIF
!
!       Les lignes qui suivent sont atteintes si on a trouve un espace
!     contigu suffisant dans la table LFI%NUMERO, et de taille inferieure
!     ou egale a ce qu'on aurait pu trouver precedemment.
!       On calcule alors un critere de cadrage (a gauche ou a droite)
!     dans cet espace, en privilegiant une occupation decentree.
!
icritg=abs(lfi%JPNXFI+1-2*(ipofin-icompt+1))
icritd=abs(lfi%JPNXFI+1-2*ipofin)
!
IF (icritg.GE.icritd) THEN
  icritr=icritg
  iposca=ipofin-icompt+1
ELSE
  icritr=icritd
  iposca=ipofin-ifactm+1
ENDIF
!
!       On retient l'espace trouve s'il est plus petit que ce qu'on
!     avait pu trouver precedemment, ou en cas d'egalite de taille
!     s'il est plus decentre.
!
IF (icompt.LT.itails.OR.icritr.GT.icrits) THEN
  itails=icompt
  irang=iposca
  icrits=icritr
ENDIF
!
icompt=0
IF ((lfi%JPNXFI-j).LT.ifactm) GOTO 112
!
ENDDO   
!
112 CONTINUE
!
IF (itails.GT.lfi%JPNXFI) THEN
!
!         On n'a pas trouve d'espace ad hoc.
!
  IF (ifactm.GT.1) THEN
    irep=-27
  ELSE
    irep=-16
  ENDIF
!
  GOTO 1001
!
ENDIF
!
iranms=irang
IF (lfi%LMISOP) WRITE (unit=lfi%NULOUT,fmt=*)           &
&  '====> LFIOUV - IRANG = ',irang, ', IFACTM = ',ifactm
lfi%LERFAT(irang)=lderfa
lfi%NIVMES(irang)=knimes
inread=0
inwrit=0
!
!        CETTE INITIALISATION QUI PEUT PARAITRE BIEN COMPLIQUEE SERT
!     DE PARADE AU MAUVAIS COMPORTEMENT DU "READ" SUR UN FICHIER VIDE,
!     sur CRAY-2 sous UNICOS 4.0 et 5.0... ( Debut )
!
CALL lfidah_fort                    &
&               (lfi, idate,iheure)
ibase=iheure+lfi%JPNIL
!
DO j=1,lfi%JPLDOC
lfi%MDES1D(ixm(j,irang))=ibase-j
ENDDO
!**
!     2.  -  OUVERTURE DU FICHIER AU SENS FORTRAN DU TERME (*OPEN*).
!-----------------------------------------------------------------------
!
ilorec=lfi%JPRECL*ifactm
!
IF (ldnomm) THEN
!*
!     2.1 - CAS OU L'UNITE LOGIQUE DOIT ETRE ASSOCIEE A UN FICHIER
!           DONT LE NOM EST EXPLICITEMENT DONNE.
!-----------------------------------------------------------------------
!
  INQUIRE (file=cdnomf,exist=llexfi,iostat=irep,err=901)
!
  IF (llexfi.AND.clstto.EQ.'NEW'                &
&      .OR..NOT.llexfi.AND.clstto.EQ.'OLD') THEN
    clacti=clstto
    irep=-9
    irang=0
    iranms=0
    GOTO 1001
  ENDIF
!
  llnouf=clstto.EQ.'NEW'.OR.clstto.EQ.'SCRATCH'.OR..NOT.llexfi
!
!     APRES TOUS CES CONTROLES DE BASE, ON TENTE L'"OPEN" DU FICHIER .
!
  IF (knumer < 0) THEN
    CALL openc (clnoms, llnoms, irep)
    IF (irep /= 0) GOTO 902
  ELSE
    OPEN (unit=knumer,file=cdnomf,status=clstto,                 &
&         err=902,form='UNFORMATTED',access='DIRECT',recl=ilorec, &
&         iostat=irep)
  ENDIF
!
ELSE
!*
!     2.2 - CAS OU L'UNITE LOGIQUE N'A PAS DE NOM DE FICHIER ASSOCIE
!           EXPLICITE; ON TENTE DIRECTEMENT L'"OPEN" .
!-----------------------------------------------------------------------
!
  IF (knumer < 0) THEN
    CALL openc (clnoms, llnoms, irep)
    IF (irep /= 0) GOTO 902
  ELSEIF (clstto.NE.'OLD'.AND.clstto.NE.'NEW') THEN
    OPEN (unit=knumer,status=clstto,form='UNFORMATTED',    &
&          access='DIRECT',recl=ilorec,err=902,iostat=irep)
  ELSE
    OPEN (unit=knumer,form='UNFORMATTED',                  &
&          access='DIRECT',recl=ilorec,err=902,iostat=irep)
  ENDIF
!
  llnouf=clstto.EQ.'SCRATCH'
!
ENDIF
!*
!     2.3 - L'"OPEN" S'EST BIEN PASSE... ON ESSAIE DE RECUPERER LE NOM
!           *SYSTEME* EVENTUEL ASSOCIE A L'UNITE LOGIQUE.
!-----------------------------------------------------------------------
!

IF (knumer > 0) THEN
  INQUIRE (unit=knumer,named=llnoms,name=clnoms,err=901, &
  &        iostat=irep)
ENDIF
!
IF (llnoms) THEN
!
!        Recherche de la longueur "utile" du nom systeme du fichier.
!        (c'est-a-dire sans tenir compte des blancs terminaux eventuels)
!
  idecbl=0
!
231 CONTINUE
  iposbl=idecbl+int(index(clnoms(idecbl+1:),' '), jplikb)
!
  IF (iposbl.LE.idecbl) THEN
    ilnoms=int(len(clnoms), jplikb)
  ELSEIF (clnoms(iposbl:).EQ.' ') THEN
    ilnoms=max(iposbl-1,1_jplikb )
  ELSE
    idecbl=iposbl
    GOTO 231
  ENDIF
!
  IF (.NOT.ldnomm) THEN
    ilnomf=ilnoms
    inlnom=ilnoms
    clnomf=clnoms
  ENDIF
!
  DO j=1,lfi%NBFIOU
  ij=lfi%NUMIND(j)
!
  IF (clnoms.EQ.lfi%CNOMSY(ij)(:lfi%NLNOMS(ij))) THEN
    ilacti=min(int(len(clnoms), jplikb), &
&               int(len(clacti), jplikb))
    clacti=clnoms(:ilacti)
    irep=-13
    irang=0
    iranms=0
    GOTO 1001
  ENDIF
!
  ENDDO
!
ELSE
  ilnoms=int(len(cpnomd), jplikb)
  clnoms=cpnomd
ENDIF
!
IF (clstto.EQ.'OLD'.OR..NOT.llnouf) THEN
!**
!     3.  -  DANS LE CAS OU LE FICHIER DEVAIT OU POUVAIT EXISTER AVANT
!            OUVERTURE, ON ESSAIE DE LIRE LES PREMIERS ARTICLES.
!-----------------------------------------------------------------------
!        ( L'ARTICLE DOCUMENTAIRE ET UNE PAIRE D'ARTICLES D'INDEX;
!          ON COMMENCE PAR L'ARTICLE NO. 3 CAR IL Y A PLUS DE CHANCES
!          D'AVOIR UNE MAUVAISE LECTURE POUR CELUI-CI )
!
!          DANS LE CAS DU "STATUS" 'UNKNOWN', IL S'AGIT DE LEVER
!       L'AMBIGUITE: FICHIER DEJA ECRIT PAR LE LOGICIEL, OU DEVANT ETRE
!       CREE PAR LUI ?
!

  DO jrec=3,1,-2
  inaphy=jrec
  CALL lfildo_fort                                     &
&                 (lfi, irep,knumer,jrec,            &
&                  lfi%MDES1D(ixm(1_jplikb ,irang)), &
&                  inread,ifactm,                    &
&                  ylfic,iretin)
!
  IF (iretin.NE.0) THEN
    GOTO 302
  ENDIF
!
  ENDDO

! Si la longueur max des articles depasse 128, alors il faut faire du
! byte-swapping
  IF (lfi%MDES1D(ixm(2_jplikb, irang)) > 128) THEN
    ylfic%L_C_BTSWAP = .NOT. ylfic%L_C_BTSWAP
    CALL jswap (lfi%MDES1D(ixm(1_jplikb, irang)), lfi%MDES1D(ixm(1_jplikb, irang)), &
              & 8_jplikm, int(lfi%JPLARD*ifactm, jplikm))
  ENDIF

!
302 CONTINUE
!
  IF (irep.EQ.0) THEN
!
!           LECTURE OK... ON CONTROLE QUELQUES VALEURS "DOCUMENTAIRES"
!
!            Fin de la parade sur CRAY2, sous UNICOS 4.0 et 5.0 .
!
    DO j=1,lfi%JPLDOC
    IF (lfi%MDES1D(ixm(j,irang)).NE.(ibase-j)) GOTO 304
    ENDDO
!
    llnouf=.true.
    GOTO 390
!
304 CONTINUE
    llnouf=.false.
    ilarph=lfi%MDES1D(ixm(lfi%JPLPAR,irang))
    inalpp=lfi%MDES1D(ixm(lfi%JPXAPI,irang))
    ifacph=ilarph/lfi%JPLARD
    ifacpp=inalpp/lfi%JPNAPP
!
    IF (min(ilarph,inalpp).LE.0.OR.mod(ilarph,lfi%JPLARD).NE.0   &
&        .OR.lfi%MDES1D(ixm(lfi%JPLMNA,irang)).NE.lfi%JPNCPN        &
&        .OR.lfi%MDES1D(ixm(lfi%JPLLDO,irang)).NE.lfi%JPLDOC        &
&        .OR.mod(inalpp,lfi%JPNAPP).NE.0.OR.ifacpp.NE.ifacph) THEN
      irep=-10
      irang=0
      iranms=0
      GOTO 1001
    ELSEIF (lfi%MDES1D(ixm(lfi%JPFEAM,irang)).NE.0) THEN
      irep=-11
      llfata=llmoer(irep,irang)
!
      IF (llfata) THEN
        irang=0
        iranms=0
        GOTO 1001
      ENDIF
!
!        SI L'ERREUR (-11) N'A PAS ETE FATALE, ON DONNE LA POSSIBILITE
!       DE TRAITER LE FICHIER DONT LA DERNIERE MODIFICATION N'A PAS ETE
!       "ENREGISTREE" . MAIS SANS AUCUNE GARANTIE ...
!
    ENDIF
!
    IF (ifacph.NE.ifactm) THEN
!
!     Messagerie de Niveau 1 pour prevenir de l'incident...
!
      inimes=ixnims(iranms)
!
      IF (inimes.GE.1) THEN
        clnspr='LFIOUV'
!
        IF (lfi%LFRANC) THEN
          WRITE (unit=clmess,fmt='(''Unite logique'',I3,        &
& '', facteur multiplicatif lu sur fichier='',I3,'', attendu='', &
&                 I3)')knumer,ifacph,ifactm
        ELSE
          WRITE (unit=clmess,fmt='(''Logical Unit'',I3,       &
& '', multiply factor read on file='',I3,'', expected='',I3)') &
&          knumer,ifacph,ifactm
        ENDIF
!
        irepx=irep
        irep=0
        CALL lfiems_fort                                  &
&                       (lfi, knumer,inimes,irep,.false., &
&                        clmess,clnspr,clacti)
!
        IF (lfi%LFRANC) THEN
          ilutil=min(inlnom,lfi%JPLFIX,            &
&                      int(len(clmess), jplikb)-6)
          clmess='Nom='''//clnomf(:ilutil)//''''
        ELSE
          ilutil=min(inlnom,lfi%JPLFIX,            &
&                      int(len(clmess), jplikb)-7)
          clmess='Name='''//clnomf(:ilutil)//''''
        ENDIF
!
        CALL lfiems_fort                                  &
&                       (lfi, knumer,inimes,irep,.false., &
&                        clmess,clnspr,clacti)
!
        IF (ldnomm.AND.clnoms.NE.clnomf) THEN
!
          IF (lfi%LFRANC) THEN
            ilutil=min(ilnoms,lfi%JPLFIX,             &
&                        int(len(clmess), jplikb)-14)
            clmess='Nom SYSTEME='''//clnoms(:ilutil)//''''
          ELSE
            ilutil=min(ilnoms,lfi%JPLFIX,             &
&                        int(len(clmess), jplikb)-14)
            clmess='SYSTEM Name='''//clnoms(:ilutil)//''''
          ENDIF
!
          CALL lfiems_fort                                  &
&                         (lfi, knumer,inimes,irep,.false., &
&                          clmess,clnspr,clacti)
        ENDIF
!
        IF (lfi%LFRANC) THEN
          clmess='On essaie de s''adapter au facteur ' &
&               //'multiplicatif lu sur le fichier...'
        ELSE
          clmess='One tries to adapt to multiply ' &
&               //'factor read on the file...'
        ENDIF
!
        CALL lfiems_fort                                  &
&                       (lfi, knumer,inimes,irep,.false., &
&                        clmess,clnspr,clacti)
        irep=irepx
      ENDIF
!
!        On va essayer de traiter le fichier avec la longueur d'Article
!     Physique lue sur le fichier. Pour cela, on doit d'abord le fermer,
!     puis on va recommencer le traitement depuis le paragraphe 1.1 .
!
      irang=0
      iranms=0
      IF (knumer > 0) THEN
        CLOSE (unit=knumer,status='KEEP',err=905,iostat=irep)
      ELSE
        CALL closec (irep)
        IF (irep /= 0) GOTO 905
      ENDIF
!
      IF (ifacph.GT.lfi%JPFACX) THEN
        irep=-28
        GOTO 1001
      ENDIF
!
      ifactm=ifacph
      GOTO 110
    ENDIF
!
  ELSEIF (clstto.EQ.'OLD') THEN
    irep=-12
    irang=0
    iranms=0
    GOTO 1001
  ELSE
    irep=0
    llnouf=.true.
  ENDIF
!
ENDIF
!
390 CONTINUE
!
!         Controle ultime avant le paragraphe suivant, dans la mesure
!     ou, contrairement au FORTRAN, on autorise les "STATUS" 'OLD'
!     et 'NEW' pour une unite logique sans nom de fichier explicite...
!     puisque le logiciel a sa propre mecanique de discrimination entre
!     un fichier "existant" ou "en mode creation".
!
IF (llnouf.AND.clstto.EQ.'OLD'                &
&    .OR..NOT.llnouf.AND.clstto.EQ.'NEW') THEN
  clacti=clstto
  irep=-9
  irang=0
  iranms=0
  GOTO 1001
ENDIF
!**
!     4.  -  L'OUVERTURE FORTRAN EST OK, ON SAIT SI ON EST EN MODE
!            CREATION DU FICHIER INDEXE OU NON... ON COMMENCE A GARNIR
!            LES VARIABLES EN COMMON, MAIS SANS INCREMENTER *LFI%NBFIOU*
!            CAR ON PEUT ENCORE AVOIR DE (MAUVAISES) SURPRISES.
!-----------------------------------------------------------------------
!
irepx=irep
lfi%CNOMFI(irang)=clnomf
lfi%NLNOMF(irang)=ilnomf
lfi%CNOMSY(irang)=clnoms
lfi%NLNOMS(irang)=ilnoms
lfi%NDEROP(irang)=0
lfi%CSTAOP(irang)=clstto
lfi%LNOUFI(irang)=llnouf
lfi%LMODIF(irang)=.false.
lfi%NDERCO(irang)=irep
lfi%NTRULZ(irang)=0
lfi%NRFPTZ(irang)=0
lfi%NRFDTZ(irang)=0
lfi%NBMOLU(irang)=0
lfi%NBMOEC(irang)=0
lfi%NDERGF(irang)=lfi%JPNIL
lfi%CNDERA(irang)=' '
lfi%MFACTM(irang)=ifactm
lfi%NSUIVF(irang)=lfi%JPNIL
lfi%NPRECF(irang)=lfi%JPNIL
!
!     N.B.: LES PAGES D'INDEX DE RANG "IRANG" SONT AUTOMATIQUEMENT
!        "AFFECTEES" A L'UNITE LOGIQUE AYANT CE RANG, ET SERVENT
!        A Y STOCKER LA PREMIERE P.A.I. EN RANG DANS LE FICHIER.
!
!     ( LES PAGES D'INDEX DE RANG "IRANG+(J-1)*LFI%JPNXFI" OU J VARIE
!       DE 1 A LFI%JPNPIA, SONT AUTOMATIQUEMENT AFFECTEES A L'UNITE
!       LOGIQUE DE RANG "IRANG" )
!
lfi%NBLECT(irang)=0
lfi%NBNECR(irang)=0
lfi%NREESP(irang)=0
lfi%NREECO(irang)=0
lfi%NREELO(irang)=0
lfi%NBTROU(irang)=0
lfi%NBRENO(irang)=0
lfi%NBSUPP(irang)=0
lfi%LISTAT(irang)=ldimst
lfi%LMIMAL(irang)=.false.
 IF (lfi%LMULTI) CALL lfiver_fort                                &
&                                (lfi, lfi%VERRUE(irang),'ASGN')
!
IF (llnouf) THEN
!*
!     4.1 - CAS DE CREATION DU FICHIER INDEXE - INITIALISATIONS DIVERSES
!-----------------------------------------------------------------------
!
  ilarph=lfi%JPLARD*ifactm
  inalpp=lfi%JPNAPP*ifactm
!
  DO j=1,ilarph
  lfi%MLGPOS(ixm(j,irang))=0
  ENDDO
!
  DO j=1,lfi%JPNXNA
  lfi%CNOMAR(ixc(j,irang))=' '
  ENDDO
!
  DO j=1,ilarph
  lfi%MDES1D(ixm(j,irang))=0
  ENDDO
!
!         NOMBRE DE PAIRES D'ARTICLES D'INDEX RESERVES,
!         (ELLES OCCUPERONT LES ARTICLES 2 A (2*INBPIR+1) DU FICHIER)
!         ET REMPLISSAGE DE CERTAINS MOTS DE L'ARTICLE DOCUMENTAIRE.
!
  inbpir=max(1_jplikb ,min(lfi%JPNXPR,1+(knbarp-1)/inalpp))
  lfi%MDES1D(ixm(lfi%JPNPIR,irang))=inbpir
  lfi%MDES1D(ixm(lfi%JPNAPH,irang))=1+2*inbpir
  lfi%MDES1D(ixm(lfi%JPLPAR,irang))=ilarph
  lfi%MDES1D(ixm(lfi%JPLMNA,irang))=lfi%JPNCPN
  lfi%MDES1D(ixm(lfi%JPLLDO,irang))=lfi%JPLDOC
  lfi%MDES1D(ixm(lfi%JPXAPI,irang))=inalpp
  lfi%MDES1D(ixm(lfi%JPFEAM,irang))=1
  lfi%NPODPI(irang)=1
  lfi%NALDPI(irang)=0
  lfi%NPPIMM(irang)=1
  irangd=irang
  CALL lfidah_fort                                           &
&                 (lfi, lfi%MDES1D(ixm(lfi%JPDCRE,irang)), &
&                  lfi%MDES1D(ixm(lfi%JPHCRE,irang)))
!
!          ECRITURE DU PREMIER ARTICLE (DESCRIPTIF)
!
  irec=1
  inaphy=irec
  CALL lfiedo_fort                                     &
&                 (lfi, irep,knumer,irec,            &
&                  lfi%MDES1D(ixm(1_jplikb ,irang)), &
&                  inwrit,  ifactm, ylfic, iretin)
!
  IF (iretin.NE.0) THEN
    GOTO 904
  ENDIF
!
!
!     Remise a zero du descripteur en vue d'une fermeture normale.
!
  lfi%MDES1D(ixm(lfi%JPFEAM,irang))=0
!
!          ECRITURE DES ARTICLES CONTENANT LES PAIRES D'ARTICLES D'INDEX
!          "RESERVES".
!
  DO j=1,inbpir
  irec=irec+1
  inaphy=irec
  CALL lfiecc_fort                                     &
&                 (lfi, irep,knumer,irec,            &
&                  lfi%CNOMAR(ixc(1_jplikb ,irang)), &
&                  inwrit,ifactm, ylfic, iretin)
!
  IF (iretin.NE.0) THEN
    GOTO 903
  ENDIF
!
  irec=irec+1
  inaphy=irec
  CALL lfiedo_fort                                     &
&                 (lfi, irep,knumer,irec,            &
&                  lfi%MLGPOS(ixm(1_jplikb ,irang)), &
&                  inwrit,  ifactm, ylfic, iretin)
!
  IF (iretin.NE.0) THEN
    GOTO 904
  ENDIF
!
  ENDDO
!
ELSE
!*
!     4.2 - LE FICHIER EXISTAIT DEJA... ON LIT LA 1ERE PAIRE D'ARTICLES
!           D'INDEX ( + LA DERNIERE S'IL Y EN A AU MOINS 2 *UTILISEES* )
!-----------------------------------------------------------------------
!
  inbalo=lfi%MDES1D(ixm(lfi%JPNALO,irang))
  inbpir=lfi%MDES1D(ixm(lfi%JPNPIR,irang))
  irec=2
  inaphy=irec
  CALL lfilcc_fort                                     &
&                 (lfi, irep,knumer,irec,            &
&                  lfi%CNOMAR(ixc(1_jplikb ,irang)), &
&                  inread,ifactm,ylfic,iretin)
!
  IF (iretin.NE.0) THEN
    GOTO 904
  ENDIF
!
  irec=3
  inaphy=irec
  CALL lfildo_fort                                     &
&                 (lfi, irep,knumer,irec,            &
&                  lfi%MLGPOS(ixm(1_jplikb ,irang)), &
&                  inread,ifactm,                    &
&                  ylfic,iretin)
!
  IF (iretin.NE.0) THEN
    GOTO 904
  ENDIF
!
  IF (inbalo.LE.inalpp) THEN
    lfi%NALDPI(irang)=inbalo
    lfi%NPODPI(irang)=1
    lfi%NPPIMM(irang)=1
    irangd=irang
  ELSE
!
!          CAS OU IL Y A AU MOINS 2 PAIRES D'ARTICLES D'INDEX UTILISEES.
!
    irgpif=1+(inbalo-1)/inalpp
    CALL lfirec_fort                         &
&                   (lfi, irgpif,irang,irec)
    irangd=irang+lfi%JPNXFI
    inaphy=irec
    CALL lfilcc_fort                                      &
&                   (lfi, irep,knumer,irec,             &
&                    lfi%CNOMAR(ixc(1_jplikb ,irangd)), &
&                    inread,ifactm,ylfic,iretin)
!
    IF (iretin.NE.0) THEN
      GOTO 904
    ENDIF
!
    irec=irec+1
    inaphy=irec
    CALL lfildo_fort                                      &
&                   (lfi, irep,knumer,irec,             &
&                    lfi%MLGPOS(ixm(1_jplikb ,irangd)), &
&                    inread,ifactm,                     &
&                    ylfic,iretin)
!
    IF (iretin.NE.0) THEN
      GOTO 904
    ENDIF
!
    lfi%NALDPI(irang)=1+mod(inbalo-1,inalpp)
    lfi%NPODPI(irang)=2
    lfi%NPPIMM(irang)=2
    lfi%MRGPIM(2,irang)=irangd
    lfi%MRGPIF(irangd)=irgpif
  ENDIF
!
ENDIF
!**
!     5.  -  L'OUVERTURE AU SENS DU LOGICIEL DE FICHIERS INDEXES LFI
!            EST COMPLETE; ON MET DONC A JOUR LES DERNIERES VARIABLES
!            EN COMMON, DONT *LFI%NBFIOU*.
!-----------------------------------------------------------------------
!
!           REMARQUE: LA PREMIERE ET LA DERNIERE P.P.I. SONT TOUJOURS
!                     "PHASEES".
!
DO j=irang,irangd,lfi%JPNXFI
lfi%LECRPI(j,1)=.false.
lfi%LECRPI(j,2)=.false.
lfi%LPHASP(j)=.true.
ENDDO
!
DO j=0,lfi%JPNPDF-1
lfi%NUMAPD(j,irang)=lfi%JPNIL
lfi%NLONPD(j,irang)=0
lfi%LECRPD(j,irang)=.false.
ENDDO
!
DO j=1,ifactm
lfi%NUMERO(irang+j-1)=knumer
ENDDO
!
ylfic%CNOMFI => lfi%CNOMFI (irang)
lfi%YLFIC (irang)=ylfic
!
lfi%NDERPD(irang)=lfi%JPNPDF-1
lfi%NBFIOU=lfi%NBFIOU+1
lfi%NFACTM=lfi%NFACTM+ifactm
lfi%NUMIND(lfi%NBFIOU)=irang
inbari=lfi%MDES1D(ixm(lfi%JPNALO,irang))- &
&       lfi%MDES1D(ixm(lfi%JPNTRU,irang))
lfi%NBREAD(irang)=inread
lfi%NBWRIT(irang)=inwrit
lfi%LTAMPL(irang)=lfi%LTAMLG
lfi%LTAMPE(irang)=lfi%LTAMEG
lfi%NEXPOR(irang)=lfi%JPNIL
lfi%NIMPOR(irang)=lfi%JPNIL
!
irep=irepx
GOTO 1001
!**
!     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
!-----------------------------------------------------------------------
!
901 CONTINUE
clacti='INQUIRE'
inaphy=0
GOTO 909
!
902 CONTINUE
clacti='OPEN'
irang=0
iranms=0
inaphy=0
GOTO 909
!
903 CONTINUE
clacti='WRITE'
GOTO 909
!
904 CONTINUE
clacti='READ'
GOTO 909
!
905 CONTINUE
clacti='CLOSE'
inaphy=0
!
909 CONTINUE
!
!      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
!
irep=abs(irep)
lfi%NUMAPH(irang)=inaphy
IF (irang.EQ.0) lfi%MFACTM(0)=ifactm
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE SOUS-PROGRAMME "LFIEMS" .
!-----------------------------------------------------------------------
!
1001 CONTINUE
krep=irep
knbari=inbari
llfata=llmoer(irep,irang)
!
IF (llfata) THEN
  inimes=2
ELSE
  inimes=ixnims(iranms)
ENDIF
!
 IF (lfi%LMULTI.AND.llverg) CALL lfiver_fort                        &
&                                           (lfi, lfi%VERGLA,'OFF')
!
IF (.NOT.llfata.AND.inimes.EQ.0)  THEN 
  IF (lhook) CALL dr_hook('LFIOUV_FORT',1,zhook_handle)
  RETURN
ENDIF
!
clnspr='LFIOUV'
!
IF (inimes.GE.1) THEN
!
!           Impression du nom du fichier.
!
  IF (lfi%LFRANC) THEN
    ilutil=min(inlnom,lfi%JPLFIX,            &
&                int(len(clmess)-6, jplikb))
    clmess='Nom='''//clnomf(:ilutil)//''''
  ELSE
    ilutil=min(inlnom,lfi%JPLFIX,            &
&                int(len(clmess)-7, jplikb))
    clmess='Name='''//clnomf(:ilutil)//''''
  ENDIF
!
  CALL lfiems_fort                                  &
&                 (lfi, knumer,inimes,irep,.false., &
&                  clmess,clnspr,clacti)
!
  IF (ldnomm.AND.clnoms(:ilnoms).NE.clnomf(:inlnom)) THEN
!
    IF (lfi%LFRANC) THEN
      ilutil=min(ilnoms,lfi%JPLFIX,             &
&                  int(len(clmess)-14, jplikb))
      clmess='Nom SYSTEME='''//clnoms(:ilutil)//''''
    ELSE
      ilutil=min(ilnoms,lfi%JPLFIX,             &
&                  int(len(clmess)-14, jplikb))
      clmess='SYSTEM Name='''//clnoms(:ilutil)//''''
    ENDIF
!
    CALL lfiems_fort                                  &
&                   (lfi, knumer,inimes,irep,.false., &
&                    clmess,clnspr,clacti)
  ENDIF
!
ENDIF
!
IF (inimes.EQ.2) THEN
  WRITE (unit=clmess,fmt='(''KREP='',I4,'', KNUMER='',I3,          &
&     '', LDNOMM= '',L1,'', CDSTTO='''''',A,'''''', LDERFA= '',L1,  &
&     '',  LDIMST= '',L1,                                           &
&         '', KNIMES='',I2,'', KNBARP='',I6,'' KNBARI='',I6)')      &
&   krep,knumer,ldnomm,cdstto(:ilsttu),lderfa,ldimst,knimes,knbarp, &
&   knbari
  CALL lfiems_fort                                 &
&                 (lfi, knumer,inimes,irep,llfata, &
&                  clmess,clnspr,clacti)
ENDIF
!
!        LA MESSAGERIE QUI SUIT N'EST PAS EMISE EN CAS D'ERREUR FATALE.
!
IF (inimes.GE.1.AND.(irep.EQ.0.OR.irep.EQ.-11)) THEN
!
  IF (llnouf) THEN
!
    IF (lfi%LFRANC) THEN
      WRITE (unit=clmess,fmt='(''Unite'',I3,                       &
&   '' OUVERTE, CREATION de Fichier,'',I7,'' Articles prevus,'',I7, &
&   '' Articles gerables sans debordement'')')                      &
&      knumer,knbarp,inalpp*inbpir
    ELSE
      WRITE (unit=clmess,fmt='(''Unit'',I3,                  &
&   '' OPENED, File CREATION,'',I7,'' expected Records,'',I7, &
&   '' Records may be handled without overflow'')')           &
&      knumer,knbarp,inalpp*inbpir
    ENDIF
!
  ELSE
!
    IF (lfi%LFRANC) THEN
      WRITE (unit=clmess,fmt='(''Unite'',I3,                      &
&       '' OUVERTE, derniere Modification OK a'',I9.6,''_'',I6.6,  &
&       '','',I7,'' Articles de donnees,'',I9,'' mots en tout'')') &
&     knumer,lfi%MDES1D(ixm(lfi%JPDDMG,irang)),                    &
&     lfi%MDES1D(ixm(lfi%JPHDMG,irang)),                           &
&            knbari,ilarph*lfi%MDES1D(ixm(lfi%JPNAPH,irang))
    ELSE
      WRITE (unit=clmess,fmt='(''Unit'',I3,                  &
&       '' OPENED, last Modification OK at'',I9.6,''_'',I6.6, &
&       '','',I7,'' data Records,'',I9,'' words in file'')')  &
&     knumer,lfi%MDES1D(ixm(lfi%JPDDMG,irang)),               &
&     lfi%MDES1D(ixm(lfi%JPHDMG,irang)),                      &
&            knbari,ilarph*lfi%MDES1D(ixm(lfi%JPNAPH,irang))
    ENDIF
!
  ENDIF
!
  CALL lfiems_fort                                  &
&                 (lfi, knumer,inimes,irep,.false., &
&                  clmess,clnspr,clacti)
ENDIF
!
IF (lhook) CALL dr_hook('LFIOUV_FORT',1,zhook_handle)

CONTAINS

#include "lficom2.ixc.h"
#include "lficom2.ixm.h"
#include "lficom2.ixnims.h"
#include "lficom2.llmoer.h"

SUBROUTINE openc (CDNOMS, LDNOMS, KREP)

IMPLICIT NONE

CHARACTER (LEN=*)     CDNOMS
LOGICAL               LDNOMS
INTEGER (KIND=JPLIKB) KREP

INTEGER (KIND=JPLIKB) I
INTEGER (KIND=JPIM) IREP4

krep=0

ldnoms=.true.

IF (ldnomm) THEN

  cdnoms = cdnomf

ELSE

  DO i = 1, len(cdnoms)
    cdnoms(i:i) = ' '
  ENDDO
  WRITE (cdnoms, '(I4.4)') -knumer
  DO i = 1, 3
    IF (cdnoms(1:1) == '0') cdnoms(1:4) = cdnoms(2:5)
  ENDDO

  cdnoms = "fort."//trim(cdnoms)

ENDIF

SELECT CASE (clstto)
  CASE ('NEW')
    CALL fi_fopen (ylfic%N_C_FPDESC, cdnoms, "w+")
  CASE ('OLD')
    CALL fi_fopen (ylfic%N_C_FPDESC, cdnoms, "r+")
    IF (ylfic%N_C_FPDESC == 0) &
   &CALL fi_fopen (ylfic%N_C_FPDESC, cdnoms, "r")
  CASE DEFAULT
    CALL fi_fopen (ylfic%N_C_FPDESC, cdnoms, "r+")
    IF (ylfic%N_C_FPDESC == 0) &
   &CALL fi_fopen (ylfic%N_C_FPDESC, cdnoms, "w+")
    IF (ylfic%N_C_FPDESC == 0) &
   &CALL fi_fopen (ylfic%N_C_FPDESC, cdnoms, "r")
END SELECT

IF (ylfic%N_C_FPDESC == 0) THEN
  CALL fi_errno (irep4)
  krep=int(irep4, jplikb)
ENDIF

END SUBROUTINE openc

SUBROUTINE closec (KREP)
USE parkind1, ONLY : jpim

INTEGER (KIND=JPLIKB) KREP

INTEGER (KIND=JPIM) IREP4

krep=0

CALL fi_fclose (irep4, ylfic%N_C_FPDESC)
IF (irep4 /= 0) THEN
  CALL fi_errno (irep4)
  krep=irep4
ENDIF

END SUBROUTINE closec

END SUBROUTINE lfiouv_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfiouv64                                      &
&           (krep, knumer, ldnomm, cdnomf, cdstto, lderfa, &
&           ldimst, knimes, knbarp, knbari)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_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=*)      CDSTTO                                 ! IN   
LOGICAL                LDERFA                                 ! IN   
LOGICAL                LDIMST                                 ! IN   
INTEGER (KIND=JPLIKB)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKB)  KNBARP                                 ! IN   
INTEGER (KIND=JPLIKB)  KNBARI                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfiouv_fort                                               &
&           (lfi, krep, knumer, ldnomm, cdnomf, cdstto, lderfa, &
&           ldimst, knimes, knbarp, knbari)

END SUBROUTINE lfiouv64

SUBROUTINE lfiouv                                        &
&           (krep, knumer, ldnomm, cdnomf, cdstto, lderfa, &
&           ldimst, knimes, knbarp, knbari)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_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=*)      CDSTTO                                 ! IN   
LOGICAL                LDERFA                                 ! IN   
LOGICAL                LDIMST                                 ! IN   
INTEGER (KIND=JPLIKM)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARP                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARI                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfiouv_mt                                                &
&           (lfi, krep, knumer, ldnomm, cdnomf, cdstto, lderfa, &
&           ldimst, knimes, knbarp, knbari)

END SUBROUTINE lfiouv

SUBROUTINE lfiouv_mt                                          &
&           (lfi, krep, knumer, ldnomm, cdnomf, cdstto, lderfa, &
&           ldimst, knimes, knbarp, knbari)
USE lfimod, ONLY : lficom
USE lfi_precision
IMPLICIT NONE
! Arguments
type(lficom)          lfi                                    ! INOUT
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 ! IN   
CHARACTER (LEN=*)      CDNOMF                                 ! IN   
CHARACTER (LEN=*)      CDSTTO                                 ! IN   
LOGICAL                LDERFA                                 ! IN   
LOGICAL                LDIMST                                 ! IN   
INTEGER (KIND=JPLIKM)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARP                                 ! IN   
INTEGER (KIND=JPLIKM)  KNBARI                                 !   OUT
! 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 lfiouv_fort                                               &
&           (lfi, irep, inumer, ldnomm, cdnomf, cdstto, lderfa, &
&           ldimst, inimes, inbarp, inbari)

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

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

END SUBROUTINE lfiouv_mt

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