/home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/LFI/mt/lficap_mt.F

Go to the documentation of this file.

C Jan-2011 P. Marguinaud Thread-safe LFI
      SUBROUTINE LFICAP_MT (LFI, KREP, KNUMER, CDNOMA, KLONG, 
     S                      KPOSEX, LDRECU )
      USE LFIMOD, ONLY : LFICOM
      USE PARKIND1, ONLY : JPRB
      USE YOMHOOK , ONLY : LHOOK, DR_HOOK
C****
C        SOUS-PROGRAMME DONNANT LES CARACTERISTIQUES ( NOM, LONGUEUR,
C     POSITION ) DE L'ARTICLE LOGIQUE *DE DONNEES* PRECEDENT, SUR UNE
C     UNITE LOGIQUE OUVERTE POUR LE LOGICIEL DE FICHIERS INDEXES *LFI* .
C**
C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
C                KNUMER (ENTREE) ==> LFI%NUMERO DE L'UNITE LOGIQUE;
C                CDNOMA (SORTIE) ==> NOM DE L'ARTICLE SUIVANT;
C                KLONG  (SORTIE) ==> LONGUEUR DE L'ARTICLE PRECEDENT;
C                KPOSEX (SORTIE) ==> POSITION ( DANS LE FICHIER, DU PRE-
C                                    MIER MOT ) DE L'ARTICLE PRECEDENT;
C                LDRECU (ENTREE) ==> VRAI SI ON DOIT "RECULER" LE
C                                    POINTEUR DU FICHIER.
C
C     SI L'ON SOUHAITE LIRE ENSUITE L'ARTICLE EN QUESTION (VIA *LFILAP*)
C     IL FAUT PRECISER A L'APPEL LDRECU=.FALSE. ; CET ARGUMENT EXISTE
C     SURTOUT PAR HOMOGENEITE AVEC *LFICAS*.
C
C     SI LE FICHIER EST VIDE OU QUE LE DERNIER ARTICLE LOGIQUE LU ETAIT
C     LE PREMIER, LE SOUS-PROGRAMME "RETOURNE" KLONG=0, ET CDNOMA=' ' .
C
#ifndef f77
#include "precision.h"
#endif
C
      TYPE(LFICOM) :: LFI
      CHARACTER CDNOMA*(*), CLNOMA*(LFI%JPNCPN)
C
      INTEGER KREP, KNUMER, KLONG, KPOSEX, IREP, ILCDNO, IDECBL, IPOSBL
      INTEGER ILCLNO, IRANG, IRGPIM, IARTIC, IRGPIF, INIMES, IRETIN
C
      LOGICAL LDRECU, LLVERF
C
#include "lficom2.h"
#include "lficom_mt.h"
C**
C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
C-----------------------------------------------------------------------
C
C        Appel legerement anticipe a LFINUM, garantissant l'initialisa-
C     tion des variables globales du logiciel a la 1ere utilisation.
C
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (LHOOK) CALL DR_HOOK('LFICAP_MT',0,ZHOOK_HANDLE)
      CALL LFINUM_MT (LFI, KNUMER,IRANG)
      LLVERF=.FALSE.
      IREP=0
      KLONG=0
      KPOSEX=0
      ILCDNO=LEN (CDNOMA)
C
      IF (ILCDNO.LE.0) THEN
        IREP=-15
        CLNOMA=LFI%CHINCO(:LFI%JPNCPN)
        ILCLNO=LFI%JPNCPN
        GOTO 1001
      ELSE
        CDNOMA=' '
        CLNOMA=' '
        ILCLNO=1
      ENDIF
C
      IF (IRANG.EQ.0) THEN
        IREP=-1
        GOTO 1001
      ENDIF
C
       IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'ON')
      LLVERF=LFI%LMULTI
C**
C     2.  -  EXPLORATION DES (PAIRES DE) PAGES ET ARTICLES D'INDEX,
C            A LA RECHERCHE DE L'ARTICLE LOGIQUE DEMANDE,
C            DEFINI PAR SON RANG "A PRIORI" DANS LE FICHIER.
C-----------------------------------------------------------------------
C
      CALL LFICAQ_MT (LFI, IREP,IRANG,IRGPIM,IARTIC,IRETIN)
C
      IF (IRETIN.EQ.1) THEN
        GOTO 903
      ELSEIF (IRETIN.EQ.2) THEN
        GOTO 904
      ELSEIF (IRETIN.NE.0.OR.IARTIC.EQ.0) THEN
        GOTO 1001
      ENDIF
C*
C     2.1 -  ARTICLE DE DONNEES TROUVE... APRES CONTROLES SUPPLEMENTAI-
C            RES, ON RETOURNE SES CARACTERISTIQUES.
C-----------------------------------------------------------------------
C
      IRGPIF=LFI%MRGPIF(IRGPIM)
C
      IF (.NOT.LFI%LPHASP(IRGPIM)) THEN
C
        CALL LFIPHA_MT (LFI, IREP,IRANG,IRGPIM,IRETIN)
C
        IF (IRETIN.EQ.1) THEN
          GOTO 903
        ELSEIF (IRETIN.EQ.2) THEN
          GOTO 904
        ELSEIF (IRETIN.NE.0) THEN
          GOTO 1001
        ENDIF
C
      ENDIF
C
      KLONG=LFI%MLGPOS(IXM(2*IARTIC-1,IRGPIM))
      KPOSEX=LFI%MLGPOS(IXM(2*IARTIC,IRGPIM))
      CLNOMA=LFI%CNOMAR(IXC(IARTIC,IRGPIM))
C
C        Recherche de la longueur "utile" du nom d'article.
C        (c'est-a-dire sans tenir compte des blancs terminaux eventuels)
C
      IDECBL=0
C
  211 CONTINUE
      IPOSBL=IDECBL+INDEX (CLNOMA(IDECBL+1:),' ')
C
      IF (IPOSBL.LE.IDECBL) THEN
        ILCLNO=LFI%JPNCPN
      ELSEIF (CLNOMA(IPOSBL:).EQ.' ') THEN
        ILCLNO=IPOSBL-1
      ELSE
        IDECBL=IPOSBL
        GOTO 211
      ENDIF
C
      IF (ILCDNO.GE.ILCLNO) THEN
        CDNOMA=CLNOMA(:ILCLNO)
      ELSE
        IREP=-24
        CLACTI=CLNOMA
        GOTO 1001
      ENDIF
C
      IF (LDRECU) THEN
C
C          ON RECULE LE "POINTEUR" DU FICHIER...
C       ET ON REINITIALISE LES "POINTEURS" SUIVANT ET PRECEDENT.
C
        LFI%NDERGF(IRANG)=LFI%JPNAPP*LFI%MFACTM(IRANG)*(IRGPIF-1)+IARTIC
        LFI%CNDERA(IRANG)=CLNOMA
        LFI%NSUIVF(IRANG)=LFI%JPNIL
        LFI%NPRECF(IRANG)=LFI%JPNIL
      ENDIF
C
      GOTO 1001
C**
C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
C-----------------------------------------------------------------------
C
  903 CONTINUE
      CLACTI='WRITE'
      GOTO 909
C
  904 CONTINUE
      CLACTI='READ'
C
  909 CONTINUE
C
C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
C
      IREP=IABS (IREP)
C**
C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
C            VIA LE SOUS-PROGRAMME "LFIEMS" .
C-----------------------------------------------------------------------
C
 1001 CONTINUE
      KREP=IREP
      LLFATA=LLMOER (IREP,IRANG)
C
      IF (IRANG.NE.0) THEN
        LFI%NDEROP(IRANG)=17
        LFI%NDERCO(IRANG)=IREP
         IF (LLVERF) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'OFF')
      ENDIF
C
      IF (LLFATA.OR.IXNIMS (IRANG).EQ.2) THEN
        INIMES=2
      ELSE
        IF (LHOOK) CALL DR_HOOK('LFICAP_MT',1,ZHOOK_HANDLE)
        RETURN
      ENDIF
C
      CLNSPR='LFICAP'
      WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
',I3,     S    '', CDNOMA='''''',A,'''''', KLONG='',I7,'', KPOSEX='
',I8,     S    '', LDRECU= '',L1)')
     S  KREP,KNUMER,CLNOMA(:ILCLNO),KLONG,KPOSEX,LDRECU
      CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA,
     S                CLMESS,CLNSPR,CLACTI)
C
      IF (LHOOK) CALL DR_HOOK('LFICAP_MT',1,ZHOOK_HANDLE)
      END