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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIRAN_MT (LFI, KREP, KRANG, CDNOMA, KRGPIM, 
00003      S                      KARTEX, KRETIN )
00004       USE LFIMOD, ONLY : LFICOM
00005       USE PARKIND1, ONLY : JPRB
00006       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00007 C****
00008 C        SOUS-PROGRAMME *INTERNE* DU LOGICIEL DE FICHIERS INDEXES LFI
00009 C     RECHERCHE D'UN ARTICLE LOGIQUE PAR NOM, DANS UNE UNITE LOGIQUE.
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                CDNOMA (ENTREE) ==> NOM DE L'ARTICLE A RECHERCHER;
00015 C                KRGPIM (SORTIE) ==> RANG DANS LES TABLES LFI%CNOMAR,LFI%MLGPOS,
00016 C                                    ETC. DE LA P.P.I OU FIGURE
00017 C                                    L'ARTICLE ( 0 SI PAS TROUVE );
00018 C                KARTEX (SORTIE) ==> RANG ( DANS LA PAGE D'INDEX ) DE L'
00019 C                                    ARTICLE S'IL EXISTE ( 0 SINON );
00020 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00021 C
00022 #ifndef f77
00023 #include "precision.h"
00024 #endif
00025 C
00026       TYPE(LFICOM) :: LFI
00027       CHARACTER CDNOMA*(*)
00028 C
00029       INTEGER KREP, KRANG, KRGPIM, KARTEX, ILCDNO, IRANG, IFACTM, INALPP
00030       INTEGER INBALO, INTPPI, IRANGF, IRGPIF, J, ILFORC, INPILE, IRANGM
00031       INTEGER IRGPIM, IARTIC, INPIME, IRPIFN, INPPIM, IDEBEX, INUMER
00032       INTEGER JNPAGE, INALPI, IRETOU, INIMES, INBVAL, KRETIN, IRETIN
00033       INTEGER IEXPLO (LFI%JPNPIA+LFI%JPNPIS), INDICE (LFI%JPNAPX)
00034 C
00035 #include "lficom2.h"
00036 #include "lficom_mt.h"
00037 C**
00038 C     1.  -  PREAMBULES.
00039 C-----------------------------------------------------------------------
00040 C*
00041 C     1.1 - CONTROLES DES PARAMETRES D'APPEL ET INITIALISATIONS.
00042 C-----------------------------------------------------------------------
00043 C
00044       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00045       IF (LHOOK) CALL DR_HOOK('LFIRAN_MT',0,ZHOOK_HANDLE)
00046       ILCDNO=LEN (CDNOMA)
00047 C
00048       IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI.OR.
00049      S    ILCDNO.LE.0.OR.ILCDNO.GT.LFI%JPNCPN.OR.CDNOMA.EQ.' ') THEN
00050         KREP=-16
00051         GOTO 1001
00052       ENDIF
00053 C
00054       IRANG=KRANG
00055       KREP=0
00056       IFACTM=LFI%MFACTM(IRANG)
00057       INALPP=LFI%JPNAPP*IFACTM
00058       INBALO=LFI%MDES1D(IXM(LFI%JPNALO,IRANG))
00059       INTPPI=(INBALO-1+INALPP)/INALPP
00060       IF (LFI%LMISOP) 
00061      S    WRITE (UNIT=LFI%NULOUT,FMT=*)'LFIRAN - INBALO= ',INBALO,
00062      S                                 ', INTPPI= ',INTPPI
00063 C*
00064 C     1.2 - CAS "ELEMENTAIRES" OU CHANCEUX.
00065 C-----------------------------------------------------------------------
00066 C
00067       IF (INBALO.EQ.0) THEN
00068 C
00069 C          Fichier vide ou depourvu d'articles logiques de donnees.
00070 C
00071         GOTO 300
00072 C
00073       ELSEIF (LFI%NDERGF(IRANG).NE.LFI%JPNIL
00074      S        .AND.LFI%CNDERA(IRANG).EQ.CDNOMA) THEN
00075 C
00076 C          Le dernier article demande via LFINFO (cas le plus probable)
00077 C     ou LFILAS/LFILAP/LFICAS/LFICAP etait celui cherche !
00078 C
00079         IRANGF=LFI%NDERGF(IRANG)
00080         IRGPIF=1+(IRANGF-1)/INALPP
00081 C
00082         IF (IRANGF.LE.INALPP) THEN
00083           IRGPIM=LFI%MRGPIM(1,IRANG)
00084         ELSEIF (IRANGF.GT.INALPP*(INTPPI-1)) THEN
00085           IRGPIM=LFI%MRGPIM(LFI%NPODPI(IRANG),IRANG)
00086         ELSE
00087 C
00088           DO 121 J=2,LFI%NPPIMM(IRANG)
00089           IRGPIM=LFI%MRGPIM(J,IRANG)
00090           IF (LFI%MRGPIF(IRGPIM).EQ.IRGPIF) GOTO 122
00091   121     CONTINUE
00092 C
00093 C           MISE EN MEMOIRE DE L'ARTICLE D'INDEX "NOMS" CHERCHE.
00094 C
00095           ILFORC=1
00096           INPILE=1
00097           CALL LFIPIM_MT (LFI, KREP,IRANG,IRANGM,IRGPIM,
00098      S                    IRGPIF,ILFORC,INPILE, IRETIN)
00099 C
00100           IF (IRETIN.EQ.1) THEN
00101             GOTO 903
00102           ELSEIF (IRETIN.EQ.2) THEN
00103             GOTO 904
00104           ELSEIF (IRETIN.NE.0) THEN
00105             GOTO 1001
00106           ENDIF
00107 C
00108         ENDIF
00109 C
00110   122   CONTINUE
00111         IARTIC=IRANGF-INALPP*(IRGPIF-1)
00112 C
00113         IF (LFI%CNOMAR(IXC(IARTIC,IRGPIM)).EQ.CDNOMA) THEN
00114           KRGPIM=IRGPIM
00115           KARTEX=IARTIC
00116         ELSE
00117           KREP=-16
00118         ENDIF
00119 C
00120         GOTO 1001
00121 C
00122       ENDIF
00123 C
00124       INPIME=0
00125       IRPIFN=1
00126       INPPIM=LFI%NPPIMM(IRANG)
00127 C
00128       IF (LFI%NPODPI(IRANG).EQ.2) THEN
00129         IDEBEX=3
00130       ELSE
00131         IDEBEX=2
00132       ENDIF
00133 C**
00134 C     2.  -  EXPLORATION DES PAGES ET ARTICLES D'INDEX "NOMS",
00135 C            A LA RECHERCHE DE L'ARTICLE LOGIQUE. ( ON COMMENCE
00136 C            PAR EXPLORER LES PAGES D'INDEX )
00137 C-----------------------------------------------------------------------
00138 C
00139       DO 205 JNPAGE=1,INTPPI
00140 C
00141       IF (JNPAGE.LE.INPPIM) THEN
00142 C
00143 C           IL S'AGIT D'UNE EXPLORATION EN MEMOIRE ( PAGE D'INDEX ).
00144 C
00145         IRGPIM=LFI%MRGPIM(JNPAGE,IRANG)
00146         IRGPIF=LFI%MRGPIF(IRGPIM)
00147         INPIME=INPIME+1
00148         IEXPLO(INPIME)=IRGPIF
00149         IF (IRGPIF.EQ.(IRPIFN+1)) IRPIFN=IRGPIF
00150       ELSE
00151 C
00152 C           IL S'AGIT D'UNE EXPLORATION "HORS MEMOIRE";
00153 C         ON CHERCHE LA PROCHAINE P.A.I. NON EXPLOREE .
00154 C
00155         IF (JNPAGE.EQ.INPPIM+1) IRGPIF=IRPIFN
00156 C
00157   201   CONTINUE
00158         IRGPIF=IRGPIF+1
00159 C
00160         DO 202 J=IDEBEX,INPIME
00161         IF (IEXPLO(J).EQ.IRGPIF) GOTO 201
00162   202   CONTINUE
00163 C
00164         ILFORC=1
00165         INPILE=1
00166         CALL LFIPIM_MT (LFI, KREP,IRANG,IRANGM,IRGPIM,IRGPIF,
00167      S                  ILFORC,INPILE, IRETIN)
00168 C
00169         IF (IRETIN.EQ.1) THEN
00170           GOTO 903
00171         ELSEIF (IRETIN.EQ.2) THEN
00172           GOTO 904
00173         ELSEIF (IRETIN.NE.0) THEN
00174           GOTO 1001
00175         ENDIF
00176 C
00177       ENDIF
00178 C
00179       INALPI=MIN0 (INALPP,INBALO-(IRGPIF-1)*INALPP)
00180 C
00181       DO 204 J=1,INALPI
00182 C
00183       IF (LFI%CNOMAR(IXC(J,IRGPIM)).EQ.CDNOMA) THEN
00184         KRGPIM=IRGPIM
00185         KARTEX=J
00186         GOTO 1001
00187       ENDIF
00188 C
00189   204 CONTINUE
00190 C
00191   205 CONTINUE
00192 C
00193   300 CONTINUE
00194 C**
00195 C     3.  -  CAS OU L'ARTICLE N'A PAS ETE TROUVE.
00196 C-----------------------------------------------------------------------
00197 C
00198       KRGPIM=0
00199       KARTEX=0
00200       GOTO 1001
00201 C**
00202 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00203 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00204 C-----------------------------------------------------------------------
00205 C
00206   903 CONTINUE
00207       IRETOU=1
00208       CLACTI='WRITE'
00209       GOTO 909
00210 C
00211   904 CONTINUE
00212       IRETOU=2
00213       CLACTI='READ'
00214 C
00215   909 CONTINUE
00216       KREP=IABS (KREP)
00217 C**
00218 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00219 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00220 C-----------------------------------------------------------------------
00221 C
00222  1001 CONTINUE
00223       LLFATA=LLMOER (KREP,KRANG)
00224 C
00225       IF (KREP.EQ.0) THEN
00226         KRETIN=0
00227       ELSEIF (KREP.GT.0) THEN
00228         KRETIN=IRETOU
00229       ELSE
00230         KRETIN=3
00231       ENDIF
00232 C
00233       IF (LFI%LMISOP.OR.LLFATA) THEN
00234         INUMER=LFI%NUMERO(KRANG)
00235         INIMES=2
00236         CLNSPR='LFIRAN'
00237         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00238 ',I3,     S  '', CDNOMA='''''',A,'''''', KRGPIM='',I3,'', KARTEX='
00239 ',I5,     S  '', KRETIN='',I2)')
00240      S    KREP,KRANG,CDNOMA,KRGPIM,KARTEX,KRETIN
00241         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00242      S                  CLMESS,CLNSPR,CLACTI)
00243       ENDIF
00244 C
00245       IF (LHOOK) CALL DR_HOOK('LFIRAN_MT',1,ZHOOK_HANDLE)
00246       END
00247