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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFICAQ_MT (LFI, KREP, KRANG, KRGPIM, KARTEX, KRETIN )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        SOUS-PROGRAMME *INTERNE* DU LOGICIEL DE FICHIERS INDEXES LFI;
00008 C     RECHERCHE DE L'ARTICLE LOGIQUE *DE DONNEES* PRECEDENT, DANS UNE
00009 C     UNITE LOGIQUE DONNEE.
00010 C**
00011 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00012 C                KRANG  (ENTREE) ==> RANG ( DANS LA TABLE *LFI%NUMERO* )
00013 C                                    DE L'UNITE LOGIQUE CONCERNEE;
00014 C                KRGPIM (SORTIE) ==> RANG DANS LES TABLES LFI%CNOMAR,LFI%MLGPOS,
00015 C                                    ETC. DE LA P.P.I OU FIGURE
00016 C                                    L'ARTICLE ( 0 SI PAS TROUVE );
00017 C                KARTEX (SORTIE) ==> RANG ( DANS LA PAGE D'INDEX ) DE L'
00018 C                                    ARTICLE S'IL EXISTE ( 0 SINON );
00019 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00020 C
00021 #ifndef f77
00022 #include "precision.h"
00023 #endif
00024 C
00025       TYPE(LFICOM) :: LFI
00026       INTEGER KREP, KRANG, KRGPIM, KARTEX, IRANG, INBALO, INALPP, INTPPI
00027       INTEGER INPPIM, IDERGF, IRANGF, IRGPIF, IRGPIM, IRANGM, ILFORC, J
00028       INTEGER INPILE, IARTIK, IARTIC, IRETOU, INIMES, INUMER, KRETIN
00029       INTEGER IRETIN
00030 C
00031 #include "lficom2.h"
00032 #include "lficom_mt.h"
00033 C**
00034 C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
00035 C-----------------------------------------------------------------------
00036 C
00037       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00038       IF (LHOOK) CALL DR_HOOK('LFICAQ_MT',0,ZHOOK_HANDLE)
00039       IRETOU=0
00040 C
00041       IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI) THEN
00042         KREP=-16
00043         GOTO 1001
00044       ENDIF
00045 C
00046       IRANG=KRANG
00047       KREP=0
00048       KRGPIM=0
00049       KARTEX=0
00050       INBALO=LFI%MDES1D(IXM(LFI%JPNALO,IRANG))
00051       INALPP=LFI%JPNAPP*LFI%MFACTM(IRANG)
00052       INTPPI=(INBALO-1+INALPP)/INALPP
00053       INPPIM=LFI%NPPIMM(IRANG)
00054 C
00055       IF (LFI%NPRECF(IRANG).EQ.LFI%JPNIL) THEN
00056 C
00057 C           ON N'A DONC PAS ENCORE APPELE CE SOUS-PROGRAMME POUR
00058 C        RECHERCHER CET ARTICLE ( A PRIORI, VIA *LFICAP* ) .
00059 C
00060         IF (LFI%NDERGF(IRANG).EQ.LFI%JPNIL) THEN
00061           IDERGF=INBALO+1
00062         ELSE
00063           IDERGF=LFI%NDERGF(IRANG)
00064         ENDIF
00065 C
00066         IF (IDERGF.LE.1) THEN
00067           LFI%NPRECF(IRANG)=0
00068           GOTO 1001
00069         ENDIF
00070 C
00071         IRANGF=IDERGF-1
00072 C
00073       ELSEIF (LFI%NPRECF(IRANG).EQ.0) THEN
00074 C
00075 C        PLUS D'ARTICLE LOGIQUE "PRECEDENT" A LIRE .
00076 C
00077         GOTO 1001
00078       ELSEIF (LFI%NDERGF(IRANG).EQ.LFI%JPNIL.OR.
00079      S        LFI%NPRECF(IRANG).LT.LFI%NDERGF(IRANG)) THEN
00080         IRANGF=LFI%NPRECF(IRANG)
00081       ELSE
00082         KREP=-16
00083         GOTO 1001
00084       ENDIF
00085 C**
00086 C     2.  -  EXPLORATION DES (PAIRES DE) PAGES ET ARTICLES D'INDEX,
00087 C            A LA RECHERCHE DE L'ARTICLE LOGIQUE DEMANDE,
00088 C            DEFINI PAR SON RANG "A PRIORI" DANS LE FICHIER.
00089 C            ( MAIS IL FAUT "SAUTER" LES TROUS )
00090 C-----------------------------------------------------------------------
00091 C*
00092 C     2.1 -  RECHERCHE DANS LES PAGES D'INDEX .
00093 C-----------------------------------------------------------------------
00094 C
00095       IRGPIF=1+(IRANGF-1)/INALPP
00096 C
00097   211 CONTINUE
00098 C
00099       IF (IRANGF.LE.INALPP) THEN
00100         IRGPIM=LFI%MRGPIM(1,IRANG)
00101         GOTO 215
00102       ELSEIF (IRANGF.GT.INALPP*(INTPPI-1)) THEN
00103         IRGPIM=LFI%MRGPIM(LFI%NPODPI(IRANG),IRANG)
00104         GOTO 215
00105       ENDIF
00106 C
00107       DO 213 J=2,INPPIM
00108       IRGPIM=LFI%MRGPIM(J,IRANG)
00109       IF (LFI%MRGPIF(IRGPIM).EQ.IRGPIF) GOTO 215
00110   213 CONTINUE
00111 C
00112 C        MISE EN MEMOIRE DE L'ARTICLE D'INDEX "NOMS" CHERCHE.
00113 C
00114       ILFORC=1
00115       INPILE=1
00116       CALL LFIPIM_MT (LFI, KREP,IRANG,IRANGM,IRGPIM,IRGPIF,
00117      S                ILFORC,INPILE,IRETIN)
00118 C
00119       IF (IRETIN.EQ.1) THEN
00120         GOTO 903
00121       ELSEIF (IRETIN.EQ.2) THEN
00122         GOTO 904
00123       ELSEIF (IRETIN.NE.0) THEN
00124         GOTO 1001
00125       ENDIF
00126 C
00127       INPPIM=MAX0 (INPPIM,IRANGM)
00128 C
00129   215 CONTINUE
00130       IARTIK=IRANGF-INALPP*(IRGPIF-1)
00131 C
00132 C         ON CHERCHE LE PREMIER ARTICLE LOGIQUE *DE DONNEES* DE LA PAGE
00133 C       D'INDEX, A PARTIR DU RANG *IARTIK* DANS CETTE PAGE.
00134 C
00135       DO 216 J=IARTIK,1,-1
00136 C
00137       IF (LFI%CNOMAR(IXC(J,IRGPIM)).NE.' ') THEN
00138         IARTIC=J
00139         GOTO 220
00140       ENDIF
00141 C
00142   216 CONTINUE
00143 C
00144 C        CHOU BLANC POUR CETTE PAGE... A PRIORI, ON VA CHERCHER DANS
00145 C     LA P.A.I. PRECEDENTE, EN RANG DANS LE FICHIER.
00146 C
00147       IF (IRGPIF.GT.1) THEN
00148         IRGPIF=IRGPIF-1
00149         IRANGF=INALPP*IRGPIF
00150         GOTO 211
00151       ENDIF
00152 C
00153 C    SI ON ARRIVE ICI, C'EST QUE LE PREMIER ARTICLE LOGIQUE EST UN TROU
00154 C
00155       LFI%NPRECF(IRANG)=0
00156       GOTO 1001
00157 C*
00158 C     2.2 -  ARTICLE DE DONNEES REPERE, ON RENVOIE SES CARACTERISTIQUES.
00159 C-----------------------------------------------------------------------
00160 C
00161   220 CONTINUE
00162       KRGPIM=IRGPIM
00163       KARTEX=IARTIC
00164       LFI%NPRECF(IRANG)=(IRGPIF-1)*INALPP+IARTIC
00165       GOTO 1001
00166 C**
00167 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00168 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00169 C-----------------------------------------------------------------------
00170 C
00171   903 CONTINUE
00172       IRETOU=1
00173       CLACTI='WRITE'
00174       GOTO 909
00175 C
00176   904 CONTINUE
00177       IRETOU=2
00178       CLACTI='READ'
00179 C
00180   909 CONTINUE
00181       KREP=IABS (KREP)
00182 C**
00183 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00184 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00185 C-----------------------------------------------------------------------
00186 C
00187  1001 CONTINUE
00188       LLFATA=LLMOER (KREP,KRANG)
00189 C
00190       IF (KREP.EQ.0) THEN
00191         KRETIN=0
00192       ELSEIF (KREP.GT.0) THEN
00193         KRETIN=IRETOU
00194       ELSE
00195         KRETIN=3
00196       ENDIF
00197 C
00198       IF (LFI%LMISOP.OR.LLFATA) THEN
00199         INUMER=LFI%NUMERO(KRANG)
00200         INIMES=2
00201         CLNSPR='LFICAQ'
00202         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00203 ',I3,     S         '', KRGPIM='',I3,'', KARTEX='',I5,'', KRETIN='',I2)')
00204      S    KREP,KRANG,KRGPIM,KARTEX,KRETIN
00205         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00206      S                  CLMESS,CLNSPR,CLACTI)
00207       ENDIF
00208 C
00209       IF (LHOOK) CALL DR_HOOK('LFICAQ_MT',1,ZHOOK_HANDLE)
00210       END
00211