SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/LFI/mt/lfilec

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFILEC_MT (LFI, KREP, KNUMER, CDNOMA, KTAB, KLONG )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        SOUS-PROGRAMME DE LECTURE D'UN ARTICLE (DE DONNEES) PAR *NOM*
00008 C     SUR UNE UNITE LOGIQUE OUVERTE POUR LE LOGICIEL DE FICHIERS INDEXES
00009 C     *LFI*; L'ARTICLE EN SORTIE EST UN "BLOC" DE DONNEES ADJACENTES.
00010 C**
00011 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00012 C                KNUMER (ENTREE) ==> LFI%NUMERO DE L'UNITE LOGIQUE;
00013 C                CDNOMA (ENTREE) ==> NOM DE L'ARTICLE A RECHERCHER;
00014 C                KTAB   (ENTREE) ==> PREMIER MOT A LIRE;
00015 C                KLONG  (ENTREE) ==> LONGUEUR DE L'ARTICLE A LIRE.
00016 C
00017 #ifndef f77
00018 #include "precision.h"
00019 #endif
00020 C
00021       TYPE(LFICOM) :: LFI
00022       CHARACTER CDNOMA*(*), CLNOMA*(LFI%JPNCPN)
00023 C
00024       INTEGER KREP, KNUMER, KLONG
00025 #ifndef f77
00026       INTEGER (KIND=JPDBLE)  KTAB (KLONG)
00027 #else
00028       INTEGER KTAB (KLONG)
00029 #endif
00030       INTEGER IREP, IRANG, ILCLNO, IREPX, ILCDNO, IDECBL, IPOSBL, IARTEX
00031       INTEGER ILONEX, IRGPIM, IRGPIF, IPOSEX, IRETIN, INIMES, INBALO
00032 C
00033       LOGICAL LLVERF
00034 C
00035 #include "lficom2.h"
00036 #include "lficom_mt.h"
00037 C**
00038 C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
00039 C-----------------------------------------------------------------------
00040 C
00041 C        Appel legerement anticipe a LFINUM, garantissant l'initialisa-
00042 C     tion des variables globales du logiciel a la 1ere utilisation.
00043 C
00044       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00045       IF (LHOOK) CALL DR_HOOK('LFILEC_MT',0,ZHOOK_HANDLE)
00046       CALL LFINUM_MT (LFI, KNUMER,IRANG)
00047       LLVERF=.FALSE.
00048       IREP=0
00049       IREPX=0
00050       ILCDNO=LEN (CDNOMA)
00051 C
00052       IF (ILCDNO.LE.0) THEN
00053         IREP=-15
00054         CLNOMA=LFI%CHINCO(:LFI%JPNCPN)
00055         ILCLNO=LFI%JPNCPN
00056         GOTO 1001
00057       ELSEIF (CDNOMA.EQ.' ') THEN
00058         IREP=-18
00059         CLNOMA=' '
00060         ILCLNO=1
00061         GOTO 1001
00062       ENDIF
00063 C
00064 C        Recherche de la longueur "utile" du nom d'article specifie.
00065 C        (c'est-a-dire sans tenir compte des blancs terminaux eventuels)
00066 C
00067       IDECBL=0
00068 C
00069   101 CONTINUE
00070       IPOSBL=IDECBL+INDEX (CDNOMA(IDECBL+1:),' ')
00071 C
00072       IF (IPOSBL.LE.IDECBL) THEN
00073         ILCLNO=ILCDNO
00074       ELSEIF (CDNOMA(IPOSBL:).EQ.' ') THEN
00075         ILCLNO=IPOSBL-1
00076       ELSE
00077         IDECBL=IPOSBL
00078         GOTO 101
00079       ENDIF
00080 C
00081       IF (ILCLNO.LE.LFI%JPNCPN) THEN
00082         CLNOMA=CDNOMA(:ILCLNO)
00083       ELSE
00084         CLNOMA=CDNOMA(:LFI%JPNCPN)
00085         ILCLNO=LFI%JPNCPN
00086         IREP=-15
00087         GOTO 1001
00088       ENDIF
00089 C
00090       IF (KLONG.LE.0) THEN
00091         IREP=-14
00092         GOTO 1001
00093       ELSEIF (IRANG.EQ.0) THEN
00094         IREP=-1
00095         GOTO 1001
00096       ENDIF
00097 C
00098        IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'ON')
00099       LLVERF=LFI%LMULTI
00100 C
00101       IARTEX=0
00102       ILONEX=0
00103       INBALO=LFI%MDES1D(IXM(LFI%JPNALO,IRANG))
00104 C
00105       IF (INBALO.NE.0) THEN
00106 C**
00107 C     2.  -  EXPLORATION DES (PAIRES DE) PAGES ET ARTICLES D'INDEX,
00108 C            A LA RECHERCHE DE L'ARTICLE LOGIQUE DEMANDE.
00109 C-----------------------------------------------------------------------
00110 C
00111         CALL LFIRAN_MT (LFI, IREP,IRANG,CLNOMA(:ILCLNO),
00112      S                  IRGPIM,IARTEX,IRETIN)
00113 C
00114         IF (IRETIN.EQ.1) THEN
00115           GOTO 903
00116         ELSEIF (IRETIN.EQ.2) THEN
00117           GOTO 904
00118         ELSEIF (IRETIN.NE.0) THEN
00119           GOTO 1001
00120         ENDIF
00121 C
00122       ENDIF
00123 C
00124       IF (IARTEX.EQ.0) THEN
00125         IREP=-20
00126         CLACTI=CLNOMA(:ILCLNO)
00127         GOTO 1001
00128       ENDIF
00129 C
00130 C        ON COMPLETE LES CARACTERISTIQUES DE L'ARTICLE.
00131 C
00132       IRGPIF=LFI%MRGPIF(IRGPIM)
00133 C
00134       IF (.NOT.LFI%LPHASP(IRGPIM)) THEN
00135 C
00136         CALL LFIPHA_MT (LFI, IREP,IRANG,IRGPIM,IRETIN)
00137 C
00138         IF (IRETIN.EQ.1) THEN
00139           GOTO 903
00140         ELSEIF (IRETIN.EQ.2) THEN
00141           GOTO 904
00142         ELSEIF (IRETIN.NE.0) THEN
00143           GOTO 1001
00144         ENDIF
00145 C
00146       ENDIF
00147 C
00148       ILONEX=LFI%MLGPOS(IXM(2*IARTEX-1,IRGPIM))
00149       IPOSEX=LFI%MLGPOS(IXM(2*IARTEX,IRGPIM))
00150 C
00151 C       CONTROLE CROISE ENTRE LONGUEURS DEMANDEE ET TROUVEE SUR FICHIER.
00152 C
00153       IF (ILONEX.GT.KLONG) THEN
00154         IREP=-21
00155         LLFATA=LLMOER (IREP,IRANG)
00156 C
00157         IF (LLFATA) THEN
00158           CLACTI=CLNOMA(:ILCLNO)
00159           GOTO 1001
00160         ENDIF
00161 C
00162 C        SI L'ERREUR (-21) N'A PAS ETE FATALE, ON VA LIRE SEULEMENT
00163 C       LE DEBUT DE L'ARTICLE ( LECTURE PARTIELLE DE *KLONG* MOTS )
00164 C
00165       ELSEIF (ILONEX.LT.KLONG) THEN
00166         IREP=-22
00167         CLACTI=CLNOMA(:ILCLNO)
00168         GOTO 1001
00169       ENDIF
00170 C
00171       IREPX=IREP
00172 C**
00173 C     3.  -  LECTURE DES DONNEES PROPREMENT DITE.
00174 C-----------------------------------------------------------------------
00175 C
00176       CALL LFILED_MT (LFI, IREP,IRANG,KTAB,KLONG,IRGPIM,IPOSEX,IRETIN)
00177 C
00178       IF (IRETIN.EQ.1) THEN
00179         GOTO 903
00180       ELSEIF (IRETIN.EQ.2) THEN
00181         GOTO 904
00182       ELSEIF (IRETIN.NE.0) THEN
00183         GOTO 1001
00184       ENDIF
00185 C
00186       IREP=IREPX
00187 C**
00188 C     4.  -   MISE A JOUR DE STATISTIQUES ET DE TABLES.
00189 C-----------------------------------------------------------------------
00190 C
00191       LFI%NBLECT(IRANG)=LFI%NBLECT(IRANG)+1
00192       LFI%NBMOLU(IRANG)=LFI%NBMOLU(IRANG)+KLONG
00193       LFI%NDERGF(IRANG)=LFI%JPNAPP*LFI%MFACTM(IRANG)*(IRGPIF-1)+IARTEX
00194       LFI%CNDERA(IRANG)=CLNOMA(:ILCLNO)
00195       LFI%NSUIVF(IRANG)=LFI%JPNIL
00196       LFI%NPRECF(IRANG)=LFI%JPNIL
00197       GOTO 1001
00198 C**
00199 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00200 C-----------------------------------------------------------------------
00201 C
00202   903 CONTINUE
00203       CLACTI='WRITE'
00204       GOTO 909
00205 C
00206   904 CONTINUE
00207       CLACTI='READ'
00208 C
00209   909 CONTINUE
00210 C
00211 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00212 C
00213       IREP=IABS (IREP)
00214 C**
00215 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00216 C            VIA LE SOUS-PROGRAMME "LFIEMS" .
00217 C-----------------------------------------------------------------------
00218 C
00219  1001 CONTINUE
00220       KREP=IREP
00221       LLFATA=LLMOER (IREP,IRANG)
00222 C
00223       IF (IRANG.NE.0) THEN
00224         LFI%NDEROP(IRANG)=2
00225         LFI%NDERCO(IRANG)=IREP
00226          IF (LLVERF) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'OFF')
00227       ENDIF
00228 C
00229       IF (LLFATA.OR.IXNIMS (IRANG).EQ.2) THEN
00230         INIMES=2
00231       ELSE
00232         IF (LHOOK) CALL DR_HOOK('LFILEC_MT',1,ZHOOK_HANDLE)
00233         RETURN
00234       ENDIF
00235 C
00236       CLNSPR='LFILEC'
00237       WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER='
00238 ',I3,     S       '', CDNOMA='''''',A,'''''', KLONG='',I7)')
00239      S     KREP,KNUMER,CLNOMA(:ILCLNO),KLONG
00240       CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA,
00241      S                CLMESS,CLNSPR,CLACTI)
00242 C
00243       IF (LHOOK) CALL DR_HOOK('LFILEC_MT',1,ZHOOK_HANDLE)
00244       END
00245