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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFICAX_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* SUIVANT, 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, INALPI
00029       INTEGER KRETIN, 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('LFICAX_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%NSUIVF(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 *LFICAS* ) .
00059 C
00060         IF (LFI%NDERGF(IRANG).EQ.LFI%JPNIL) THEN
00061           IDERGF=0
00062         ELSE
00063           IDERGF=LFI%NDERGF(IRANG)
00064         ENDIF
00065 C
00066         IF (IDERGF.GE.INBALO) THEN
00067           LFI%NSUIVF(IRANG)=0
00068           GOTO 1001
00069         ENDIF
00070 C
00071         IRANGF=IDERGF+1
00072 C
00073       ELSEIF (LFI%NSUIVF(IRANG).EQ.0) THEN
00074 C
00075 C        PLUS D'ARTICLE LOGIQUE A LIRE "SEQUENTIELLEMENT".
00076 C
00077         GOTO 1001
00078       ELSEIF (LFI%NDERGF(IRANG).EQ.LFI%JPNIL.OR.
00079      S        LFI%NSUIVF(IRANG).GT.LFI%NDERGF(IRANG)) THEN
00080         IRANGF=LFI%NSUIVF(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       INALPI=MIN0 (INALPP,INBALO-(IRGPIF-1)*INALPP)
00132 C
00133 C         ON CHERCHE LE PREMIER ARTICLE LOGIQUE *DE DONNEES* DE LA PAGE
00134 C       D'INDEX, A PARTIR DU RANG *IARTIK* DANS CETTE PAGE.
00135 C
00136       DO 216 J=IARTIK,INALPI
00137 C
00138       IF (LFI%CNOMAR(IXC(J,IRGPIM)).NE.' ') THEN
00139         IARTIC=J
00140         GOTO 220
00141       ENDIF
00142 C
00143   216 CONTINUE
00144 C
00145 C        CHOU BLANC POUR CETTE PAGE... A PRIORI, ON VA CHERCHER DANS
00146 C     LA P.A.I. SUIVANTE, EN RANG DANS LE FICHIER.
00147 C
00148       IF (IRGPIF.LT.INTPPI) THEN
00149         IRANGF=INALPP*IRGPIF+1
00150         IRGPIF=IRGPIF+1
00151         GOTO 211
00152       ENDIF
00153 C
00154 C    SI ON ARRIVE ICI, C'EST QUE LE DERNIER ARTICLE LOGIQUE EST UN TROU.
00155 C
00156       LFI%NSUIVF(IRANG)=0
00157       GOTO 1001
00158 C*
00159 C     2.2 -  ARTICLE DE DONNEES REPERE, ON RENVOIE SES CARACTERISTIQUES.
00160 C-----------------------------------------------------------------------
00161 C
00162   220 CONTINUE
00163       KRGPIM=IRGPIM
00164       KARTEX=IARTIC
00165       LFI%NSUIVF(IRANG)=(IRGPIF-1)*INALPP+IARTIC
00166       GOTO 1001
00167 C**
00168 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00169 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00170 C-----------------------------------------------------------------------
00171 C
00172   903 CONTINUE
00173       IRETOU=1
00174       CLACTI='WRITE'
00175       GOTO 909
00176 C
00177   904 CONTINUE
00178       IRETOU=2
00179       CLACTI='READ'
00180 C
00181   909 CONTINUE
00182       KREP=IABS (KREP)
00183 C**
00184 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00185 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00186 C-----------------------------------------------------------------------
00187 C
00188  1001 CONTINUE
00189       LLFATA=LLMOER (KREP,KRANG)
00190 C
00191       IF (KREP.EQ.0) THEN
00192         KRETIN=0
00193       ELSEIF (KREP.GT.0) THEN
00194         KRETIN=IRETOU
00195       ELSE
00196         KRETIN=3
00197       ENDIF
00198 C
00199       IF (LFI%LMISOP.OR.LLFATA) THEN
00200         INUMER=LFI%NUMERO(KRANG)
00201         INIMES=2
00202         CLNSPR='LFICAX'
00203         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00204 ',I3,     S         '', KRGPIM='',I3,'', KARTEX='',I5,'', KRETIN='',I2)')
00205      S    KREP,KRANG,KRGPIM,KARTEX,KRETIN
00206         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00207      S                  CLMESS,CLNSPR,CLACTI)
00208       ENDIF
00209 C
00210       IF (LHOOK) CALL DR_HOOK('LFICAX_MT',1,ZHOOK_HANDLE)
00211       END
00212