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

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