lfimod.F90

Go to the documentation of this file.

MODULE lfimod
! Jan-2011 P. Marguinaud Interface to thread-safe LFI
! Sep-2012 P. Marguinaud Initialize data + DrHook
USE parkind1, ONLY : jpim, jprb, jpib, jpia
USE yomhook, ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!
!----- DESCRIPTION DES "PARAMETER" DU LOGICIEL DE FICHIERS INDEXES -----
!-----  (et des variables logiques a charger absolument partout )  -----
!
!     JPNBIM = NOMBRE DE BITS PAR MOT MACHINE
!     JPNBIC = NOMBRE DE BITS PAR CARACTERE
!     JPNCMO = NOMBRE DE CARACTERES PAR MOT MACHINE
!
!     JPNCPN = NOMBRE MAXI. POSSIBLE DE CARACTERES PAR NOM D'ARTICLE
!     JPLARD = LONGUEUR D'ARTICLE "PHYSIQUE" elementaire des Fichiers
!              ( exprimee en mots, DOIT ETRE PAIRE, SUPERIEURE OU EGALE
!                a JPLDOC, JPLARD*JPNCMO DOIT ETRE MULTIPLE DE JPNCPN )
!     JPLARC = Longueur d'article "physique" exprimee en caracteres
!     JPRECL = PARAMETRE "RECL" de base POUR "OPEN" DES FICHIERS
!     JPNXFI = NOMBRE MAXIMUM DE FICHIERS INDEXES OUVERTS SIMULTANEMENT
!              (1 fichier de "multiplicite" N comptant comme N fichiers)
!     JPFACX = FACteur multiplicateur maXimum entre longueur d'article
!              physique effective et elementaire ( de 1 a JPNXFI )
!     JPXUFM = Nombre maXimum d'Unites logiques a Facteur Mul. predefini
!     JPNPIA = NOMBRE DE *PAIRES* DE "PAGES D'INDEX" EN MEMOIRE
!              *PREALLOUEES* PAR UNITE LOGIQUE ( AU MOINS *4* )
!     JPNXPI = NOMBRE TOTAL DE *PAIRES* DE "PAGES D'INDEX" EN MEMOIRE
!              ALLOUABLES ( DOIT ETRE AU MOINS EGAL A JPNPIA*JPNXFI )
!     JPNPIS = NOMBRE DE *PAIRES* DE "PAGES D'INDEX" NON PREALLOUEES
!     JPNXNA = NOMBRE MAXI. DE NOMS D'ARTICLES PAR PAGE/ARTICLE D'INDEX
!     JPNBLP = NOMBRE MAXI. DE COUPLES (LONGUEUR/POSITION)"   "     "
!     JPNAPP = NOMBRE MAXI. UTILE DE NOMS D'ARTICLES PAR PAGE/AR D'INDEX
!     JPLDOC = LONGUEUR (MOTS) DE LA PARTIE DOCUMENTAIRE DU 1ER ARTICLE
!     JPNPDF = NOMBRE DE PAGES DE DONNEES PAR FICHIER OUVERT ( >= 2 )
!     JPNXPR = NOMBRE MAXIMUM DE PAIRES D'ARTICLES D'INDEX RESERVABLES
!     JPNIL  = CODE DE "VALEUR ABSENTE" POUR CERTAINES TABLES D'ENTIERS.
!     JPNMPN = NOMBRE DE MOTS NECESSAIRE AU STOCKAGE D'UN NOM D'ARTICLE
!     JPNAPX = JPNAPP*JPFACX
!     JPLARX = JPLARD*JPFACX = longueur d'article physique maximale
!     JPLFTX = Longueur maximale traitable des noms de fichiers.
!     JPLFIX =    "        "     imprimable "   "   "     "    .
!     JPLSPX =    "        "   des noms des sous-programmes du logiciel.
!     JPLSTX =    "     "  des valeurs du "STATUS" FORTRAN (open/close).
!     JPCFMX = Nombre maximum de ConFigurations pour iMport/eXport.
!     JPIMEX =    "     "  de fichiers imp/exportables "simultanement".
!     JPDEXP = Dimension tableau Descripteurs EXPlicites d'imp/export.
!     JPDIMP =     "        "         "       IMPlicites "  "    "   .
!     JPXDAM = Nombre maXimum noms D'Articles d'imp/export en Memoire.
!     JPXCIE =    "     "     de Caracteres par nom pour Import/Export.
!     JPXMET =    "     "     "      "       "   "  avec METacaracteres.
!     JPXCCF =    "     "     "      "      des noms de ConFig. imp/exp.
!     JPTYMX =    "   de TYpes de variables valides pour Import/Export.
!
!
!
      INTEGER (KIND=JPLIKB), PARAMETER :: jplstx = 7
      INTEGER (KIND=JPLIKB), PARAMETER :: jpnbst = 4
      INTEGER (KIND=JPLIKB), PARAMETER :: jpncpn = 16
      INTEGER (KIND=JPLIKB), PARAMETER :: jplftx = 512
      INTEGER (KIND=JPLIKB), PARAMETER :: jpxccf = 16
      INTEGER (KIND=JPLIKB), PARAMETER :: jpxmet = 2 * jpncpn
      INTEGER (KIND=JPLIKB), PARAMETER :: jptymx = 5
      INTEGER (KIND=JPLIKB), PARAMETER :: jplspx = 6

!
!---------- VARIABLES LOGIQUES A CHARGER ABSOLUMENT PARTOUT ------------
!
!     LMISOP = VRAI SI ON DOIT TRAVAILLER EN MODE MISE AU POINT LOGICIEL
!     LFRANC = Vrai/Faux si la messagerie doit etre en francais/anglais
!
!
!-------- DESCRIPTION DE LA PARTIE DOCUMENTAIRE DU 1ER ARTICLE ---------
!
!     MOT  1 ==> LONGUEUR "PHYSIQUE" Effective DES ARTICLES (EN MOTS)
!     MOT  2 ==> LONGUEUR MAXIMUM DES NOMS D'ARTICLES (CARACTERES)
!     MOT  3 ==> "DRAPEAU" SIGNALANT SI LE FICHIER A BIEN ETE FERME
!                APRES LA DERNIERE MODIFICATION
!     MOT  4 ==> LONGUEUR DE LA PARTIE DOCUMENTAIRE DU FICHIER
!     MOT  5 ==> NOMBRE D'ARTICLES "PHYSIQUES" DANS LE FICHIER
!     MOT  6 ==>    "        "      LOGIQUES    "    "    "
!                (Y COMPRIS LES "TROUS" CREES PAR LES REECRITURES
!                 D'ARTICLES PLUS LONGUES QUE PRECEDEMMENT, ET N'AYANT
!                 PAS ENCORE PU ETRE REUTILISES, COMPTES DANS LE MOT 21)
!     MOT  7 ==> LONGUEUR MINI. DES ARTICLES LOGIQUES DE DONNEES (MOTS)
!     MOT  8 ==>    "     MAXI.  "     "         "     "    "      "
!     MOT  9 ==>    "     TOTALE "     "         "     "    "      "
!     MOT 10 ==> NOMBRE DE REECRITURES SUR PLACE (VRAIES)
!     MOT 11 ==>   "     "      "      PLUS COURTES
!     MOT 12 ==>   "     "      "       "   LONGUES
!     MOT 13 ==> NOMBRE MAXIMUM D'ARTICLES PAR PAGE OU ARTICLE D'INDEX
!     MOT 14 ==> DATE DE LA CREATION DU FICHIER (1ERE OUVERTURE)
!     MOT 15 ==> HEURE "  "    "     "     "    (  "      "    )
!     MOT 16 ==> DATE DE LA DERNIERE MODIFICATION GARANTIE (FERMETURE)
!     MOT 17 ==> HEURE "  "    "          "           "    (    "    )
!     MOT 18 ==> DATE DE LA 1ERE MODIFICATION PAS FORCEMENT GARANTIE
!     MOT 19 ==> HEURE "  "    "      "        "      "        "
!       (LES MODIFICATIONS NE SONT GARANTIES QUE SI LE MOT 4 VAUT ZERO)
!     MOT 20 ==> NOMBRE DE PAIRES D'ARTICLES D'INDEX PRERESERVES .
!     MOT 21 ==> NOMBRE DE "TROUS" CORRESP. A DES REECRITURES + LONGUES
!                ( AVANT OUVERTURE )
!     MOT 22 ==> NUMERO D'ARTICLE MAXI. DES ARTICLES PHYSIQ. DE DONNEES
!
!------ "PARAMETER" DECRIVANT LES POSITIONS DES ENTITES CI-DESSUS ------
!
!
!
!
!--- DESCRIPTIF DES TABLES CONCERNANT LES (PAIRES DE) PAGES D'INDEX ----
!                       ( ALIAS "P.P.I." )
!
!     CNOMAR = TABLE DES PAGES D'INDEX DE TYPE "NOMS D'ARTICLES"
!     MLGPOS = TABLE DES PAGES D'INDEX DE TYPE "LONGUEUR/POSITION"
!     MRGPIF = TABLE DES RANGS DES P.P.I. DANS LEUR FICHIER RESPECTIF
!     MCOPIF = TABLE DE CORRESPONDANCE PAGES D'INDEX/UNITES LOGIQUES
!     MRGPIM = TABLE DES RANGS EN MEMOIRE DES P.P.I. AFFECTEES
!              ( DANS *MCOPIF,MRGPIF,CNOMAR,MLGPOS,LECRPI,LPHASP* )
!     LECRPI = VRAI SI LA PAGE D'INDEX CORRESP. DOIT ETRE (RE)ECRITE
!              (.,1) ==> PAGE "NOM", (.,2) ==> PAGE "LONGUEUR/POSITION"
!     LPHASP = VRAI SI LA PAGE D'INDEX "LONG/POS" EST PHASEE EN MEMOIRE
!              AVEC LA PAGE D'INDEX "NOM" CORRESPONDANTE
!
!---------------- VARIABLES "SIMPLES" GLOBALES -------------------------
!
!     NBFIOU = Nombre d'Unites Logiques ouvertes
!     NFACTM = Somme des Facteurs Multiplicatifs utilises
!     NIMESG = NIVEAU *GLOBAL* DE LA MESSAGERIE
!     NERFAG = NIVEAU DE FILTRAGE GLOBAL DES ERREURS FATALES
!     NISTAG = NIVEAU D'IMPRESSION GLOBAL DES STATISTIQUES
!     NPISAF = NBRE DE PAIRES DE PAGES D'INDEX SUPPLEMENTAIRES AFFECTEES
!     LMULTI = VRAI SI ON DOIT TRAVAILLER EN MODE MULTI-TACHES
!     LTAMLG = OPTION PAR DEFAUT D'UTILISATION DE LA MEMOIRE TAMPON EN
!              LECTURE; VRAIE ==> UTILISATION MAXIMUM
!     LTAMEG = CF. CI-DESSUS, EN ECRITURE
!     VERGLA = VERROU GLOBAL (EN MULTI-TASKING)
!     NULOFM = Nombre d'Unites LOgiques a Facteur Multiplicat. predefini
!     CHINCO = Nom par defaut d'une variable qui devrait etre CHaracter
!     NUIMEX = Nombre d'Unites LOgiques en cours d'IMport/EXport
!
!--------- DESCRIPTIF DES ELEMENTS CONCERNANT UNE UNITE LOGIQUE --------
!
!     NUMIND = TABLE D'ADRESSAGE INDIRECT DANS LES TABLEAUX CI-DESSOUS
!     NUMERO = NUMERO DE L'UNITE LOGIQUE
!     MFACTM = FACteur Multiplicatif de la longueur physique elementaire
!     CNOMFI = NOM eventuel du FIchier associe a l'unite logique
!     CNOMSY = Idem pour le systeme, ou a defaut pour l'utilisateur.
!     NLNOMF = LONGUEUR (CARACTERES) DU NOM EVENTUEL
!     NLNOMS = Longueur (en caracteres) du Nom SYSTEME eventuel
!     NDEROP = CODE DE LA DERNIERE ACTION EFFECTUEE
!     CSTAOP = 'STATUS' DE L'OUVERTURE
!     LNOUFI = VRAI SI LE FICHIER EST NOUVEAU (AU SENS DU LOGICIEL)
!     LMODIF =  "   "   "    "    A ETE MODIFIE DEPUIS L'OUVERTURE
!     NDERCO = DERNIER CODE-REPONSE (CORRESPONDANT A LA DERNIERE ACTION)
!     MTAMPD = PAGES DE DONNEES "TAMPON"
!     NUMAPD = NUMERO D'ARTICLE PHYSIQUE CORRESPONDANT A CES PAGES
!     LECRPD = VRAI SI LA PAGE DE DONNEES CORRESP. DOIT ETRE ECRITE
!     NLONPD = LONGUEUR DE PAGE DE DONNEES REELLEMENT REMPLIE
!     NDERPD = NUMERO DE LA DERNIERE PAGE DE DONNEES UTILISEE
!     NPODPI = RANG DE LA DERNIERE PAGE D'INDEX DANS LA TABLE *MRGPIM*
!     NALDPI = NOMBRE D'ARTICLES LOGIQUES DANS LA DERNIERE PAGE D'INDEX
!     NBLECT =    "   DE LECTURES          EFFECTUEES DEPUIS L'OUVERTURE
!     NBNECR =    "   "  NOUVELLES ECRITURES    "        "       "
!     NREESP =    "   "  "VRAIES" REECRITURES SUR PLACE  "       "
!     NREECO =    "   "  REECRITURES PLUS COURTES        "       "
!     NREELO =    "   "       "      PLUS LONGUES        "       "
!     NBRENO =    "   "  FOIS OU ON A RENOMME UN ARTICLE "       "
!     NBSUPP =    "   "   "  " "  " " SUPPRIME "    "    "       "
!     NBTROU =    "   "  TROUS D'INDEX CREES             "       "
!     NIVMES = NIVEAU DE LA MESSAGERIE
!     LERFAT = VRAI SI TOUTE ERREUR DOIT ETRE FATALE
!     LISTAT = OPTION D'IMPRESSION DES STATISTIQUES ( A LA FERMETURE )
!     VERRUE = VERROU DE L'UNITE LOGIQUE (EN MODE MULTI-TASKING)
!     NPPIMM = NBRE DE PAIRES DE PAGES D'INDEX EN MEMOIRE
!     MDES1D = TABLE CONTENANT LE 1ER ARTICLE ("DESCRIPTIF")
!     NTRULZ = NOMBRE DE TROUS D'INDEX DE LONGUEUR NULLE
!     NRFPTZ = RANG PREMIERE ARTICLE AYANT LA CARACTERISTIQUE CI-DESSUS
!     NRFDTZ =   "  DERNIER     "    "    "         "         "
!     NBREAD = NOMBRE DE "READ" FORTRAN REELLEMENT EXECUTES  (DEPUIS L'
!     NBWRIT =    "      "WRITE"   "        "         "       OUVERTURE)
!     NBMOLU = NOMBRE DE MOTS UTILISATEUR LUS   CORRECTEMENT (DEPUIS L'
!     NBMOEC =    "    "   "       "      ECRITS     "        OUVERTURE)
!     LTAMPL = OPTION D'UTILISATION MAXI DE LA MEMOIRE TAMPON EN LECTURE
!     LTAMPE =    "   "      "       "   "   "    "      "    " ECRITURE
!     NDERGF = RANG DANS LE FICHIER DU DERNIER ARTICLE LOGIQUE LU
!              ou dont on a demande les caracteristiques (LFICAS/LFICAP)
!     CNDERA = NOM de ce dernier article logique de donnees
!     NSUIVF = RANG DANS LE FICHIER DU PROCHAIN ARTICLE LOGIQUE A LIRE
!              "SEQUENTIELLEMENT"
!     NPRECF = RANG DANS LE FICHIER DU PROCHAIN ARTICLE LOGIQUE
!              "PRECEDENT" A LIRE
!     LMIMAL = VRAI SI ON DOIT RECALCULER LES LONGUEURS MINI. ET MAXI.
!              DES ARTICLES LOGIQUES DE DONNEES
!     NUMAPH = NUMero d'Article PHysique (pour messages d'erreur E/S).
!     NEXPOR = Rang eventuel (d'EXPORt) dans les tables MNUIEX,NDIMPL,
!     NIMPOR =  "      "     (d'IMPORt) NDEXPL,NREXPL,CNEXPL,NIMPEX...
!
!------------------------ VARIABLES DIVERSES ---------------------------
!
!     MULOFM = Table des Unites LOgiques avec Facteur Multip. predefini
!     MFACTU =   "    "  FActeurs mUltiplicatifs associes a ces Unites
!     MNUIEX =   "    "  Numeros d'Unites logiques en Import/EXport
!     NINIEX =   "   d'adressage INdirect dans MNUIEX
!     NDIMPL = Descripteurs IMPLicites d'import/export en memoire
!     NDEXPL =      "       EXPLicites "   "   /  "    "     "
!     CNIMPL = Profil des articles a description IMPLicite
!     NAEXPL = Nombre d'articles decrits EXPLicitement
!     CNEXPL = Noms des articles decrits dans NDEXPL
!     NREXPL = Rang  "      "       "      "  NDEXPL
!     NIMPEX = Numero d'unite logique associee a l'IMPort ou l'EXport.
!     NUTRAV =    "   "   "      "    de TRAVail pour import ou export.
!     NLAPFD = Longueur d'Article Physique du fichier d'export/import.
!     NXCNLD = Nb.maX. Caracteres/Nom d'article du logiciel LFI Distant.
!     NRCFMX = Rang de la config. Imp/eXport dans CFGMXD, NBMOSD, NBCASD
!     CFGMXD = ConFiGuration pour iMport/eXport des systemes Distants.
!     NBMOSD = Nombre de Bits par MOt       des systemes Distants.
!     NBCASD =    "   "    "   "  CAractere  "     "        "    .
!     CTYPMX = Liste des types de variables valides pour Import/eXport.
!
      TYPE lficrw
        sequence
! C file pointer
        INTEGER (KIND=JPIA) :: n_c_fpdesc = 0
! File offset (start from zero)
        INTEGER (KIND=JPIB) :: n_c_offset = 0
! File requires byte-swapping
        LOGICAL             :: l_c_btswap = .false.
! File name
        CHARACTER*(JPLFTX), POINTER :: cnomfi => null ()
      END TYPE lficrw

      TYPE lficom
      sequence
      CHARACTER (LEN=8)   :: cmagic = "LFI_FORT"
      INTEGER (KIND=JPIA) :: ilficc = 0_jpia
! lficom0
      INTEGER (KIND=JPLIKB) jpnbim, jpnbic, jpncpn, jplard
      INTEGER (KIND=JPLIKB) jpnpdf, jpxufm, jpnxfi
      INTEGER (KIND=JPLIKB) jpnpia, jpnxpi, jpnxpr, jpldoc
      INTEGER (KIND=JPLIKB) jpnil, jpncmo, jplarc
      INTEGER (KIND=JPLIKB) jpxmet, jprecl, jpfacx, jplftx
      INTEGER (KIND=JPLIKB) jplfix, jplspx, jplstx
      INTEGER (KIND=JPLIKB) jpimex, jpdexp, jpdimp, jpxdam
      INTEGER (KIND=JPLIKB) jpxcie, jpcfmx, jpxccf
      INTEGER (KIND=JPLIKB) jpnxna, jpnblp, jpnapp, jpnpis
      INTEGER (KIND=JPLIKB) jpnapx, jpnmpn, jplarx
      INTEGER (KIND=JPLIKB) jptymx, jpnbst
      LOGICAL lmisop, lfranc
! lficom1
      INTEGER (KIND=JPLIKB) jplpar, jplmna, jpfeam, jplldo
      INTEGER (KIND=JPLIKB) jpnaph, jpnalo, jplnal
      INTEGER (KIND=JPLIKB) jplxal, jpltal, jpnres, jpnrec
      INTEGER (KIND=JPLIKB) jpnrel, jpxapi, jpdcre
      INTEGER (KIND=JPLIKB) jphcre, jpddmg, jphdmg, jpdmng
      INTEGER (KIND=JPLIKB) jphmng, jpnpir, jpntru
      INTEGER (KIND=JPLIKB) jpaxpd
      CHARACTER*(JPNCPN), POINTER :: cnomar (:)     => null ()
      CHARACTER*(JPNCPN), POINTER :: cndera (:)     => null ()
      CHARACTER*(JPNCPN) chinco
      CHARACTER*(JPLFTX), POINTER :: cnomfi (:)     => null ()
      CHARACTER*(JPLFTX), POINTER :: cnomsy (:)     => null ()
      CHARACTER*(JPLSTX), POINTER :: cstaop (:)     => null ()
      CHARACTER*(JPNCPN), POINTER :: cnexpl (:,:)   => null ()
      CHARACTER*(JPTYMX) ctypmx
      CHARACTER*(JPXMET), POINTER :: cnimpl (:)     => null ()
      CHARACTER*(JPXCCF), POINTER :: cfgmxd (:)     => null ()
!
      INTEGER (KIND=JPLIKB) nbfiou, nfactm, nimesg
      INTEGER (KIND=JPLIKB) nerfag, nistag, npisaf, nulofm
      INTEGER (KIND=JPLIKB), POINTER :: mlgpos (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mtampd (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mdes1d (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mrgpim (:,:) => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nderpd (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mcopif (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mrgpif (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: numero (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nlnomf (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nlnoms (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nderco (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: npodpi (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: numaph (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: naldpi (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nblect (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nreesp (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nreeco (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbnecr (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nreelo (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nivmes (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nderop (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: numapd (:,:) => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nlonpd (:,:) => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nppimm (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nrfdtz (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: ntrulz (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nrfptz (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbtrou (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: numind (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbwrit (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbmolu (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbread (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbmoec (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: ndergf (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nsuivf (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbreno (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbsupp (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nprecf (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mfactm (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mulofm (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mfactu (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nimpex (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nutrav (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbcasd (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nlapfd (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: mnuiex (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: niniex (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nbmosd (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: ndexpl (:,:) => null ()
      INTEGER (KIND=JPLIKB), POINTER :: ndimpl (:,:) => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nxcnld (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: naexpl (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nrcfmx (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nexpor (:)   => null ()
      INTEGER (KIND=JPLIKB), POINTER :: nimpor (:)   => null ()
      INTEGER (KIND=JPLIKB) nuimex
      INTEGER (KIND=JPLIKB), POINTER :: nrexpl (:,:) => null ()
!
      REAL (KIND=JPDBLR), POINTER :: verrue (:) => null ()
      REAL (KIND=JPDBLR) vergla
!
      LOGICAL lmulti, ltamlg, ltameg
      LOGICAL, POINTER :: lecrpi (:,:) => null ()
      LOGICAL, POINTER :: ltampl (:)   => null ()
      LOGICAL, POINTER :: ltampe (:)   => null ()
      LOGICAL, POINTER :: lmodif (:)   => null ()
      LOGICAL, POINTER :: lnoufi (:)   => null ()
      LOGICAL, POINTER :: lerfat (:)   => null ()
      LOGICAL, POINTER :: listat (:)   => null ()
      LOGICAL, POINTER :: lphasp (:)   => null ()
      LOGICAL, POINTER :: lecrpd (:,:) => null ()
      LOGICAL, POINTER :: lmimal (:)   => null ()

! subroutine saved variables
      LOGICAL :: lficfg_llprea = .true.
      CHARACTER (LEN=10) :: lfichi_clchif = '0123456789'
      LOGICAL :: lfideb_llprea = .true.
      LOGICAL :: lfifmd_llprea = .true.
      LOGICAL :: lfifra_llprea = .true.
      LOGICAL :: lfiini_llprea = .true., lfiini_lldefm = .false.
      LOGICAL :: lfineg_llprea = .true.
      LOGICAL :: lfinmg_llprea = .true.
      LOGICAL :: lfinsg_llprea = .true.
      LOGICAL :: lfinum_llprea = .true.
      LOGICAL :: lfioeg_llprea = .true.
      LOGICAL :: lfiofd_llprea = .true.
      LOGICAL :: lfiomg_llprea = .true.
      LOGICAL :: lfiosg_llprea = .true.
      CHARACTER*(JPLSTX) :: lfiouv_clstex (jpnbst)

      INTEGER (KIND=JPLIKB) lfirac_jpdebn

      INTEGER (KIND=JPLIKB) :: nulout = 0
      INTEGER (KIND=JPLIKB) :: jplmes = 1024

      type(lficrw), POINTER :: ylfic(:) => null()

      END TYPE lficom


      type(lficom), SAVE, TARGET :: lficom_default
      LOGICAL, SAVE :: lficom_default_init = .false.

      CONTAINS

      SUBROUTINE new_lfi_default ()
      INTEGER :: IERR
      REAL (KIND=JPRB) :: ZHOOK_HANDLE

      IF (lhook) CALL dr_hook ('LFICOM:NEW_LFI_DEFAULT',0,zhook_handle)

      IF (.NOT. lficom_default_init) THEN
        CALL new_lfi (lficom_default, ierr)
        lficom_default_init = .true.
      ENDIF

      IF (lhook) CALL dr_hook ('LFICOM:NEW_LFI_DEFAULT',1,zhook_handle)

      END SUBROUTINE new_lfi_default

      SUBROUTINE new_lfi (LFI, KERR, KPNXFI, KPFACX)
      type(lficom) :: lfi
      INTEGER, INTENT(OUT) :: KERR
      INTEGER, OPTIONAL, INTENT(IN) :: KPNXFI
      INTEGER, OPTIONAL, INTENT(IN) :: KPFACX
      REAL (KIND=JPRB) :: ZHOOK_HANDLE

      IF (lhook) CALL dr_hook ('LFICOM:NEW_LFI',0,zhook_handle)

      kerr = 0

      lfi%JPLSTX = jplstx
      lfi%JPNBST = jpnbst
      lfi%JPNCPN = jpncpn
      lfi%JPLFTX = jplftx

      lfi%JPLARD=512 
      lfi%JPNPDF=20 
      lfi%JPXUFM=100 
      lfi%JPNPIA=4 
      lfi%JPNXPR=100


#ifdef HIGHRES
      lfi%JPNXFI=300 
      lfi%JPFACX=120
#else
      lfi%JPNXFI=50 
      lfi%JPFACX=20
#endif


      IF (PRESENT (kpnxfi)) lfi%JPNXFI = int(kpnxfi, jplikb)
      IF (PRESENT (kpfacx)) lfi%JPFACX = int(kpfacx, jplikb)

!
!     Implementation-dependent symbolic constants (except for JPNCMO and
!     JPLARC definitions, which are there to have only one set of
!     "ifdef" in current header).
!
#if defined ( DEC )
      lfi%JPNBIM=64 
      lfi%JPNBIC=8 
      lfi%JPNCMO=lfi%JPNBIM/lfi%JPNBIC
      lfi%JPLARC=lfi%JPNCMO*lfi%JPLARD
      lfi%JPRECL=2*lfi%JPLARD 
#elif defined ( HPPA )
      lfi%JPNBIM=32
      lfi%JPNBIC=8 
      lfi%JPNCMO=lfi%JPNBIM/lfi%JPNBIC 
      lfi%JPLARC=lfi%JPNCMO*lfi%JPLARD
      lfi%JPRECL=lfi%JPLARC
#else
!     Notice : record length should be in BYTES for the computer system
      lfi%JPNBIM=64 
      lfi%JPNBIC=8 
      lfi%JPNCMO=lfi%JPNBIM/lfi%JPNBIC
      lfi%JPLARC=lfi%JPNCMO*lfi%JPLARD 
      lfi%JPRECL=lfi%JPLARC 
#endif

      lfi%JPLDOC=22
      lfi%JPNIL=-999
      lfi%JPXMET=jpxmet
      lfi%JPCFMX=4
      lfi%JPNXPI=lfi%JPNPIA*lfi%JPNXFI+2*lfi%JPFACX
      lfi%JPXCIE=2*lfi%JPNCPN
      lfi%JPLFIX=128
      lfi%JPLSPX=jplspx
      lfi%JPLSTX=7
      lfi%JPTYMX=jptymx
      lfi%JPIMEX=2
      lfi%JPDEXP=10000
      lfi%JPDIMP=1000
      lfi%JPXDAM=1000
      lfi%JPNXNA=(lfi%JPLARD*lfi%JPNCMO)/lfi%JPNCPN
      lfi%JPNBLP=lfi%JPLARD/2
      lfi%JPNAPP=(lfi%JPNBLP*(lfi%JPNXNA/lfi%JPNBLP)+lfi%JPNXNA* &
     &  (lfi%JPNBLP/lfi%JPNXNA))/(lfi%JPNXNA/                    &
     &   lfi%JPNBLP+lfi%JPNBLP/lfi%JPNXNA)
      lfi%JPXCCF=jpxccf
      lfi%JPNPIS=lfi%JPNXPI-lfi%JPNPIA*lfi%JPNXFI
      lfi%JPNAPX=lfi%JPNAPP*lfi%JPFACX
      lfi%JPNMPN=1+(lfi%JPNCPN-1)/lfi%JPNCMO
      lfi%JPLARX=lfi%JPLARD*lfi%JPFACX
      lfi%JPLPAR=1
      lfi%JPLMNA=2
      lfi%JPFEAM=3
      lfi%JPLLDO=4
      lfi%JPNAPH=5
      lfi%JPNALO=6
      lfi%JPLNAL=7
      lfi%JPLXAL=8
      lfi%JPLTAL=9
      lfi%JPNRES=10
      lfi%JPNREC=11
      lfi%JPNREL=12
      lfi%JPXAPI=13
      lfi%JPDCRE=14
      lfi%JPHCRE=15
      lfi%JPDDMG=16
      lfi%JPHDMG=17
      lfi%JPDMNG=18
      lfi%JPHMNG=19
      lfi%JPNPIR=20
      lfi%JPNTRU=21
      lfi%JPAXPD=22

      lfi%LFIRAC_JPDEBN=(lfi%JPNMPN*(2/lfi%JPNMPN)+2*(lfi%JPNMPN/2)) &
     &                  /((lfi%JPNMPN/2)+(2/lfi%JPNMPN))

      lfi%LFIOUV_CLSTEX = ''
      lfi%LFIOUV_CLSTEX(1) = 'OLD'
      lfi%LFIOUV_CLSTEX(2) = 'NEW'
      lfi%LFIOUV_CLSTEX(3) = 'UNKNOWN'
      lfi%LFIOUV_CLSTEX(4) = 'SCRATCH'

      ALLOCATE (lfi%YLFIC (lfi%JPNXFI), &
     &          stat = kerr)
      IF (kerr /= 0) GOTO 999

      ALLOCATE (                                                    &
     & lfi%CNOMAR (lfi%JPNXNA*lfi%JPNXPI), lfi%CNDERA (lfi%JPNXFI), &
     & lfi%CNOMFI (lfi%JPNXFI), lfi%CNOMSY (lfi%JPNXFI),            &
     & lfi%CSTAOP (lfi%JPNXFI), lfi%CNEXPL (lfi%JPXDAM,lfi%JPIMEX), &
     & lfi%CNIMPL (lfi%JPIMEX), lfi%CFGMXD (0:lfi%JPCFMX),          &
     & lfi%MLGPOS (lfi%JPLARD*lfi%JPNXPI),                          &
     & lfi%MTAMPD (lfi%JPLARD*lfi%JPNPDF*lfi%JPNXFI),               &
     & lfi%MDES1D (lfi%JPLARD*lfi%JPNXFI),                          &
     & lfi%MRGPIM (lfi%JPNPIA+lfi%JPNPIS,lfi%JPNXFI),               &
     & lfi%NDERPD (lfi%JPNXFI), lfi%MCOPIF (lfi%JPNXPI),            &
     & lfi%MRGPIF (lfi%JPNXPI), lfi%NLNOMS (lfi%JPNXFI),            &
     & lfi%NUMERO (lfi%JPNXFI), lfi%NLNOMF (lfi%JPNXFI),            &
     & lfi%NDERCO (lfi%JPNXFI), lfi%NPODPI (lfi%JPNXFI),            &
     & stat = kerr )
      IF (kerr /= 0) GOTO 999

      lfi%CNOMAR = ''; lfi%CNDERA = ''; lfi%CNOMFI  = '';
      lfi%CNOMSY = ''; lfi%CSTAOP = ''; lfi%CNEXPL  = '';
      lfi%CNIMPL = ''; lfi%CFGMXD = ''; lfi%MLGPOS  =  0;
      lfi%MTAMPD =  0; lfi%MDES1D =  0; lfi%MRGPIM  =  0;
      lfi%NDERPD =  0; lfi%MCOPIF =  0; lfi%MRGPIF  =  0;
      lfi%NLNOMS =  0; lfi%NUMERO =  0; lfi%NLNOMF  =  0;
      lfi%NDERCO =  0; lfi%NPODPI =  0; 

      ALLOCATE (                                                         &
     & lfi%NUMAPH (0:lfi%JPNXFI), lfi%NALDPI (lfi%JPNXFI),               &
     & lfi%NBLECT (lfi%JPNXFI), lfi%NBNECR (lfi%JPNXFI),                 &
     & lfi%NREESP (lfi%JPNXFI), lfi%NREECO (lfi%JPNXFI),                 &
     & lfi%NREELO (lfi%JPNXFI), lfi%NIVMES (0:lfi%JPNXFI),               &
     & lfi%NDEROP (lfi%JPNXFI), lfi%NPPIMM (lfi%JPNXFI),                 &
     & lfi%NUMAPD (0:lfi%JPNPDF-1,lfi%JPNXFI),                           &
     & lfi%NLONPD (0:lfi%JPNPDF-1,lfi%JPNXFI), lfi%NTRULZ (lfi%JPNXFI),  &
     & lfi%NRFPTZ (lfi%JPNXFI), lfi%NRFDTZ (lfi%JPNXFI),                 &
     & lfi%NBTROU (lfi%JPNXFI), lfi%NUMIND (lfi%JPNXFI),                 &
     & lfi%NBREAD (lfi%JPNXFI), lfi%NBWRIT (lfi%JPNXFI),                 &
     & lfi%NBMOLU (lfi%JPNXFI), lfi%NBMOEC (lfi%JPNXFI),                 &
     & stat = kerr )
      IF (kerr /= 0) GOTO 999

      lfi%NUMAPH = 0; lfi%NALDPI = 0; lfi%NBLECT = 0;
      lfi%NBNECR = 0; lfi%NREESP = 0; lfi%NREECO = 0;
      lfi%NREELO = 0; lfi%NIVMES = 0; lfi%NDEROP = 0;
      lfi%NPPIMM = 0; lfi%NUMAPD = 0; lfi%NLONPD = 0;
      lfi%NTRULZ = 0; lfi%NRFPTZ = 0; lfi%NRFDTZ = 0;
      lfi%NBTROU = 0; lfi%NUMIND = 0; lfi%NBREAD = 0;
      lfi%NBWRIT = 0; lfi%NBMOLU = 0; lfi%NBMOEC = 0;

      ALLOCATE (                                                     &
     & lfi%NDERGF (lfi%JPNXFI), lfi%NSUIVF (lfi%JPNXFI),             &
     & lfi%NPRECF (lfi%JPNXFI), lfi%NBRENO (lfi%JPNXFI),             &
     & lfi%NBSUPP (lfi%JPNXFI), lfi%MFACTM (0:lfi%JPNXFI),           &
     & lfi%MULOFM (lfi%JPXUFM), lfi%MFACTU (0:lfi%JPXUFM),           &
     & lfi%NIMPEX (lfi%JPIMEX), lfi%NUTRAV (lfi%JPIMEX),             &
     & lfi%NBMOSD (0:lfi%JPCFMX), lfi%NBCASD (0:lfi%JPCFMX),         &
     & lfi%NLAPFD (lfi%JPIMEX), lfi%MNUIEX (lfi%JPIMEX),             &
     & lfi%NINIEX (lfi%JPIMEX), lfi%NDEXPL (lfi%JPDEXP,lfi%JPIMEX),  &
     & lfi%NDIMPL (lfi%JPDIMP,lfi%JPIMEX), lfi%NXCNLD (lfi%JPIMEX),  &
     & stat = kerr )
      IF (kerr /= 0) GOTO 999

      lfi%NDERGF = 0; lfi%NSUIVF = 0; lfi%NPRECF = 0;
      lfi%NBRENO = 0; lfi%NBSUPP = 0; lfi%MFACTM = 0;
      lfi%MULOFM = 0; lfi%MFACTU = 0; lfi%NIMPEX = 0;
      lfi%NUTRAV = 0; lfi%NBMOSD = 0; lfi%NBCASD = 0;
      lfi%NLAPFD = 0; lfi%MNUIEX = 0; lfi%NINIEX = 0;
      lfi%NDEXPL = 0; lfi%NDIMPL = 0; lfi%NXCNLD = 0;

      ALLOCATE (                                                        &
     & lfi%NAEXPL (lfi%JPIMEX), lfi%NEXPOR (lfi%JPNXFI),                &
     & lfi%NIMPOR (lfi%JPNXFI), lfi%NRCFMX (lfi%JPIMEX),                &
     & lfi%NREXPL (0:lfi%JPXDAM,lfi%JPIMEX), lfi%VERRUE (lfi%JPNXFI),   &
     & lfi%LECRPI (lfi%JPNXPI,2), lfi%LTAMPL (lfi%JPNXFI),              &
     & lfi%LTAMPE (lfi%JPNXFI), lfi%LMODIF (lfi%JPNXFI),                &
     & lfi%LNOUFI (lfi%JPNXFI), lfi%LERFAT (0:lfi%JPNXFI),              &
     & lfi%LISTAT (lfi%JPNXFI), lfi%LPHASP (lfi%JPNXPI),                &
     & lfi%LECRPD (0:lfi%JPNPDF-1,lfi%JPNXFI), lfi%LMIMAL (lfi%JPNXFI), &
     & stat = kerr )
      IF (kerr /= 0) GOTO 999

      lfi%NAEXPL = 0; lfi%NEXPOR = 0; lfi%NIMPOR = 0;
      lfi%NRCFMX = 0; lfi%NREXPL = 0; lfi%VERRUE = 0.;
      lfi%LECRPI = .false.; lfi%LTAMPL = .false.;
      lfi%LTAMPE = .false.; lfi%LMODIF = .false.;
      lfi%LNOUFI = .false.; lfi%LERFAT = .false.;
      lfi%LISTAT = .false.; lfi%LPHASP = .false.;
      lfi%LECRPD = .false.; lfi%LMIMAL = .false.;

 999  CONTINUE

      IF (lhook) CALL dr_hook ('LFICOM:NEW_LFI',1,zhook_handle)

      END SUBROUTINE new_lfi

      SUBROUTINE free_lfi (LFI, KERR)
      type(lficom) :: lfi
      INTEGER, INTENT(OUT) :: KERR
      REAL (KIND=JPRB) :: ZHOOK_HANDLE

      IF (lhook) CALL dr_hook ('LFICOM:FREE_LFI',0,zhook_handle)

      kerr = 0

      DEALLOCATE (lfi%YLFIC, &
     &            stat = kerr)
      IF (kerr .NE. 0) GOTO 999

      DEALLOCATE (              &
     & lfi%CNOMAR, lfi%CNDERA,  &
     & lfi%CNOMFI, lfi%CNOMSY,  &
     & lfi%CSTAOP, lfi%CNEXPL,  &
     & lfi%CNIMPL, lfi%CFGMXD,  &
     & lfi%MLGPOS,              &
     & lfi%MTAMPD,              &
     & lfi%MDES1D,              &
     & lfi%MRGPIM,              &
     & lfi%NDERPD, lfi%MCOPIF,  &
     & lfi%MRGPIF, lfi%NLNOMS,  &
     & lfi%NUMERO, lfi%NLNOMF,  &
     & lfi%NDERCO, lfi%NPODPI,  &
     & stat = kerr )
      IF (kerr .NE. 0) GOTO 999

      DEALLOCATE (              &
     & lfi%NUMAPH, lfi%NALDPI,  &
     & lfi%NBLECT, lfi%NBNECR,  &
     & lfi%NREESP, lfi%NREECO,  &
     & lfi%NREELO, lfi%NIVMES,  &
     & lfi%NDEROP, lfi%NPPIMM,  &
     & lfi%NUMAPD,              &
     & lfi%NLONPD, lfi%NTRULZ,  &
     & lfi%NRFPTZ, lfi%NRFDTZ,  &
     & lfi%NBTROU, lfi%NUMIND,  &
     & lfi%NBREAD, lfi%NBWRIT,  &
     & lfi%NBMOLU, lfi%NBMOEC,  &
     & stat = kerr )
      IF (kerr .NE. 0) GOTO 999

      DEALLOCATE (              &
     & lfi%NDERGF, lfi%NSUIVF,  &
     & lfi%NPRECF, lfi%NBRENO,  &
     & lfi%NBSUPP, lfi%MFACTM,  &
     & lfi%MULOFM, lfi%MFACTU,  &
     & lfi%NIMPEX, lfi%NUTRAV,  &
     & lfi%NBMOSD, lfi%NBCASD,  &
     & lfi%NLAPFD, lfi%MNUIEX,  &
     & lfi%NINIEX, lfi%NDEXPL,  &
     & lfi%NDIMPL, lfi%NXCNLD,  &
     & stat = kerr )
      IF (kerr .NE. 0) GOTO 999

      DEALLOCATE (              &
     & lfi%NAEXPL, lfi%NEXPOR,  &
     & lfi%NIMPOR, lfi%NRCFMX,  &
     & lfi%NREXPL, lfi%VERRUE,  &
     & lfi%LECRPI, lfi%LTAMPL,  &
     & lfi%LTAMPE, lfi%LMODIF,  &
     & lfi%LNOUFI, lfi%LERFAT,  &
     & lfi%LISTAT, lfi%LPHASP,  &
     & lfi%LECRPD, lfi%LMIMAL,  &
     & stat = kerr )
      IF (kerr .NE. 0) GOTO 999

 999  CONTINUE

      IF (lfi%ILFICC /= 0) CALL lfi_hndl_free (lfi)

      IF (lhook) CALL dr_hook ('LFICOM:FREE_LFI',1,zhook_handle)

      END SUBROUTINE free_lfi

END MODULE lfimod