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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIPIM_MT (LFI, KREP ,KRANG, KRANGM, KRGPIM, 
00003      S                      KRGPIF, KRGFOR, KNPILE, 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     GESTION DES REQUETES D'ALLOCATION D'UNE PAIRE DE PAGES D'INDEX
00010 C     SUPPLEMENTAIRE ( APPELS PAR LFIECR, LFILEC... ), ET LECTURE
00011 C     EVENTUELLE SUR FICHIER D'ARTICLE(S) D'INDEX CORRESPONDANT(S) .
00012 C**
00013 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00014 C                KRANG  (ENTREE) ==> RANG ( DANS LA TABLE *LFI%NUMERO* )
00015 C                                    DE L'UNITE LOGIQUE CONCERNEE;
00016 C                KRANGM (SORTIE) ==> RANG ( DANS LA TABLE *LFI%MRGPIM* )
00017 C                                    DE LA P.P.I. AFFECTEE;
00018 C                                    ( ZERO SI PAS DE P.P.I. ALLOUEE )
00019 C                KRGPIM (SORTIE) ==> RANG ( DANS LES TABLES DECRIVANT
00020 C                                    LES PAIRES DE PAGES D'INDEX ) DE
00021 C                                    LA P.P.I. SUPPLEMENTAIRE ALLOUEE,
00022 C                                    ZERO SI PAS DE P.P.I. ALLOUEE;
00023 C                KRGPIF (ENTREE) ==> RANG ( DANS LE FICHIER ) DE LA
00024 C                                    P.P.I. SUPPLEMENTAIRE;
00025 C                KRGFOR (ENTREE) ==> RANG ( DANS LE FICHIER ) D'UNE
00026 C                                    EVENTUELLE P.P.I. A CONSERVER;
00027 C                KNPILE (ENTREE) ==> NOMBRE D'ARTICLES D'INDEX A LIRE
00028 C                                    ( 0==>RIEN, 1==>NOMS, 2==>LES 2 );
00029 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00030 C
00031 C     SI L'ON NE TROUVE PLUS DE P.P.I. LIBRE, ON "RECYCLE" LA P.P.I.
00032 C     ASSOCIEE AU PLUS GRAND RANG DANS LA TABLE *LFI%MRGPIM*,
00033 C         EXCEPTION FAITE DE LA PREMIERE, DE LA DERNIERE, ET DE CELLE
00034 C     DE RANG *KRGFOR* DANS LE FICHIER,
00035 C     CECI POUR ASSURER QUE LORS D'UNE EXPLORATION DES P.P.I.,
00036 C     ON NE REUTILISE PAS L'EMPLACEMENT D'UNE P.P.I. QU'ON A DEJA
00037 C     EXPLOREE, OU QU'ON DOIT GARDER POUR LA LOGIQUE DU TRAITEMENT.
00038 C        LE "FORCAGE" N'EST EFFECTIF QUE SI LE RANG DANS LE FICHIER EST
00039 C     BIEN CELUI D'UNE P.P.I, MAIS NI LA PREMIERE NI LA DERNIERE
00040 C     EN RANG DANS LE FICHIER.
00041 C*
00042 C         LE VERROUILLAGE EVENTUEL DE L'UNITE LOGIQUE DE RANG *KRANG*
00043 C     DOIT AVOIR ETE FAIT EN AMONT, AVANT L'APPEL A CE SOUS-PROGRAMME.
00044 C
00045 C        Noter que la P.P.I. peut etre "multiple", et qu'elle occupe
00046 C     autant de P.P.I. "elementaires" (de longueur LFI%JPLARD par page) ,
00047 C     ces P.P.I. "elementaires" etant necessairement consecutives...
00048 C        Dans ce cas KRGPIM designe le rang de la PREMIERE P.P.I. ele-
00049 C     mentaire concernee.
00050 C
00051 #ifndef f77
00052 #include "precision.h"
00053 #endif
00054 C
00055       TYPE(LFICOM) :: LFI
00056       INTEGER KREP ,KRANG, KRANGM, KRGPIM, KRGPIF, KRGFOR, KNPILE
00057       INTEGER IRANG, INUMER, INPPIM, IFACTM, IRGPIM, IRANGM, ICOMPT, J
00058       INTEGER JR, IREC, INAPHY, IRETOU, INIMES, KRETIN, IRETIN
00059 C
00060       LOGICAL LLAUX1, LLAUX2, LLADON
00061 C
00062 #include "lficom2.h"
00063 #include "lficom_mt.h"
00064 C**
00065 C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
00066 C-----------------------------------------------------------------------
00067 C
00068       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00069       IF (LHOOK) CALL DR_HOOK('LFIPIM_MT',0,ZHOOK_HANDLE)
00070       KRANGM=0
00071       KRGPIM=0
00072       IRETOU=0
00073       INAPHY=0
00074       LLADON=.FALSE.
00075 C
00076       IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI.OR.KRGPIF.LE.0.OR.
00077      S    KNPILE.LT.0.OR.KNPILE.GT.2) THEN
00078         KREP=-16
00079         GOTO 1001
00080       ELSE
00081         IRANG=KRANG
00082         INUMER=LFI%NUMERO(KRANG)
00083 C
00084         IF (INUMER.LT.0) THEN
00085           KREP=-16
00086           GOTO 1001
00087         ENDIF
00088 C
00089       ENDIF
00090 C
00091       INPPIM=LFI%NPPIMM(IRANG)
00092       IFACTM=LFI%MFACTM(IRANG)
00093 C**
00094 C     2.  -  RECHERCHE D'UNE P.P.I. SUPPLEMENTAIRE .
00095 C-----------------------------------------------------------------------
00096 C
00097       IF (INPPIM.LE.0) THEN
00098         KREP=-16
00099         GOTO 1001
00100       ELSEIF (INPPIM.LT.LFI%JPNPIA) THEN
00101 C*
00102 C     2.1 - CAS OU L'UNE DES P.P.I. PREALLOUEES AU FICHIER EST
00103 C           DISPONIBLE.
00104 C-----------------------------------------------------------------------
00105 C
00106         IRGPIM=IRANG+INPPIM*LFI%JPNXFI
00107         INPPIM=INPPIM+1
00108         IRANGM=INPPIM
00109         LFI%NPPIMM(IRANG)=INPPIM
00110         GOTO 300
00111       ELSEIF (LFI%JPNPIS.GT.0) THEN
00112 C*
00113 C     2.2 - PLUS DE P.P.I. PREALLOUEE LIBRE; RECHERCHE DANS
00114 C           LES P.P.I. ALLOUABLES DYNAMIQUEMENT.
00115 C-----------------------------------------------------------------------
00116 C
00117 C           VERROUILLAGE EVENTUEL POUR L'UTILISATION DE *LFI%NPISAF*
00118 C
00119          IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'ON')
00120 C
00121         IF (LFI%NPISAF.LT.LFI%JPNPIS) THEN
00122           ICOMPT=0
00123 C
00124           DO 221 J=LFI%JPNPIA*LFI%JPNXFI+1,LFI%JPNXPI
00125 C
00126           IF (LFI%MCOPIF(J).EQ.LFI%JPNIL) THEN
00127             ICOMPT=ICOMPT+1
00128 C
00129             IF (ICOMPT.EQ.IFACTM) THEN
00130               IRGPIM=J+1-IFACTM
00131               GOTO 222
00132             ENDIF
00133 C
00134           ELSE
00135             ICOMPT=0
00136           ENDIF
00137 C
00138   221     CONTINUE
00139 C
00140 C              Chou blanc... on deverrouille globalement.
00141 C
00142            IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'OFF')
00143           IF (IFACTM.GT.1) GOTO 230
00144 C
00145 C              CAS D'INCOHERENCE DES TABLES DU LOGICIEL !
00146 C
00147           KREP=-16
00148           GOTO 1001
00149 C
00150   222     CONTINUE
00151 C
00152 C            UNE P.P.I. "LIBRE", eventuellement Multiple, A ETE TROUVEE.
00153 C
00154           LFI%NPISAF=LFI%NPISAF+IFACTM
00155 C
00156           DO 223 JR=IRGPIM,IRGPIM+IFACTM-1
00157           LFI%MCOPIF(JR)=IRANG
00158   223     CONTINUE
00159 C
00160 C         ON DEVERROUILLE "GLOBALEMENT", CAR CE QUI SUIT ALORS
00161 C         NE CONCERNE PLUS QUE LE FICHIER.
00162 C
00163            IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'OFF')
00164           INPPIM=INPPIM+1
00165           IRANGM=INPPIM
00166           LFI%NPPIMM(IRANG)=INPPIM
00167           LFI%MRGPIM(INPPIM,IRANG)=IRGPIM
00168           GOTO 300
00169 C
00170         ELSE
00171 C
00172 C            CAS OU IL N'Y A PLUS DE P.P.I. "LIBRE" .
00173 C         ON DEVERROUILLE "GLOBALEMENT", CAR CE QUI SUIT ALORS
00174 C         NE CONCERNE PLUS QUE LE FICHIER.
00175 C
00176            IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'OFF')
00177         ENDIF
00178 C
00179       ENDIF
00180 C
00181   230 CONTINUE
00182 C*
00183 C     2.3 - PLUS DE P.P.I. ( PREALLOUEE OU NON ) LIBRE.
00184 C-----------------------------------------------------------------------
00185 C
00186 C         ON VA DONC RECYCLER LA P.P.I. ALLOUEE AU FICHIER
00187 C       QUI SOIT ASSOCIEE AU PLUS GRAND RANG DANS LA TABLE *LFI%MRGPIM*,
00188 C       TOUT EN N'ETANT NI LA PREMIERE, NI LA DERNIERE, NI CELLE DE
00189 C       RANG *KRGFOR* DANS LE FICHIER .
00190 C        C'est pour etre sur de trouver une telle page que l'on a besoin
00191 C     d'avoir LFI%JPNPIA superieur ou egal a 4.
00192 C
00193       IRANGM=INPPIM
00194 C
00195   231 CONTINUE
00196 C
00197       IF (IRANGM.EQ.LFI%NPODPI(IRANG).OR.
00198      S    LFI%MRGPIF(LFI%MRGPIM(IRANGM,IRANG)).EQ.KRGFOR) THEN
00199         IRANGM=IRANGM-1
00200         GOTO 231
00201       ENDIF
00202 C
00203       IRGPIM=LFI%MRGPIM(IRANGM,IRANG)
00204       LLAUX1=LFI%LECRPI(IRGPIM,1)
00205       LLAUX2=LFI%LECRPI(IRGPIM,2).AND.LFI%LPHASP(IRGPIM)
00206 C
00207 C          SI NECESSAIRE, ON REECRIT SUR LE FICHIER
00208 C       LA OU LES PAGES D'INDEX qu'on va reutiliser.
00209 C
00210       IF (LLAUX1.OR.LLAUX2) THEN
00211         CALL LFIREC_MT (LFI, LFI%MRGPIF(IRGPIM),IRANG,IREC)
00212 C
00213         IF (LLAUX1) THEN
00214           INAPHY=IREC
00215           CALL LFIECC_MT (LFI, KREP,INUMER,IREC,
00216      S                    LFI%CNOMAR(IXC(1,IRGPIM)),
00217      S                    LFI%NBWRIT(IRANG),IFACTM,IRETIN)
00218 C
00219           IF (IRETIN.NE.0) THEN
00220             GOTO 903
00221           ENDIF
00222 C
00223           INAPHY=0
00224         ENDIF
00225 C
00226         IF (LLAUX2) THEN
00227           CALL LFIECX_MT (LFI, KREP,IRANG,IREC+1,
00228      S                    LFI%MLGPOS(IXM(1,IRGPIM)),LLADON,
00229      S                    IRETIN)
00230 C
00231           IF (IRETIN.EQ.1) THEN
00232             GOTO 903
00233           ELSEIF (IRETIN.EQ.2) THEN
00234             GOTO 904
00235           ELSEIF (IRETIN.NE.0) THEN
00236             GOTO 1001
00237           ENDIF
00238 C
00239         ENDIF
00240 C
00241       ENDIF
00242 C
00243   300 CONTINUE
00244 C**
00245 C     3.  -  MISE A JOUR DE TABLES, NE NECESSITANT PAS LA PROTECTION DU
00246 C            VERROU GLOBAL; A PARTIR DU MOMENT OU *LFI%MCOPIF* A ETE MIS A
00247 C            JOUR, LE SIMPLE VERROUILLAGE DE L'UNITE LOGIQUE SUFFIT.
00248 C             ( ET EST CENSE AVOIR ETE FAIT DANS LE SOUS-PROGRAMME
00249 C               APPELANT, EN MODE MULTI )
00250 C-----------------------------------------------------------------------
00251 C
00252       LFI%LECRPI(IRGPIM,1)=.FALSE.
00253       LFI%LECRPI(IRGPIM,2)=.FALSE.
00254       LFI%LPHASP(IRGPIM)=.FALSE.
00255       LFI%MRGPIF(IRGPIM)=KRGPIF
00256 C**
00257 C     4.  -  MISE EN MEMOIRE EVENTUELLE D'ARTICLE(S) D'INDEX
00258 C            CORRESPONDANT A LA NOUVELLE P.P.I.
00259 C-----------------------------------------------------------------------
00260 C
00261       IF (KNPILE.NE.0) THEN
00262         CALL LFIREC_MT (LFI, KRGPIF,IRANG,IREC)
00263         INAPHY=IREC
00264         CALL LFILCC_MT (LFI, KREP,INUMER,IREC,LFI%CNOMAR(IXC(1,IRGPIM)),
00265      S               LFI%NBREAD(IRANG),IFACTM,IRETIN)
00266 C
00267         IF (IRETIN.NE.0) THEN
00268           GOTO 904
00269         ENDIF
00270 C
00271         IF (KNPILE.EQ.2) THEN
00272 C
00273 C             PHASAGE DIRECT, SANS APPEL AU SOUS-PROGRAMME "LFIPHA" .
00274 C
00275           INAPHY=IREC+1
00276           CALL LFILDO_MT (LFI, KREP,INUMER,IREC+1,
00277      S                    LFI%MLGPOS(IXM(1,IRGPIM)),
00278      S                    LFI%NBREAD(IRANG),IFACTM,IRETIN)
00279 C
00280           IF (IRETIN.NE.0) THEN
00281             GOTO 904
00282           ENDIF
00283 C
00284           LFI%LPHASP(IRGPIM)=.TRUE.
00285 C
00286         ENDIF
00287 C
00288       ENDIF
00289 C
00290       KREP=0
00291       KRANGM=IRANGM
00292       KRGPIM=IRGPIM
00293       GOTO 1001
00294 C**
00295 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00296 C-----------------------------------------------------------------------
00297 C
00298   903 CONTINUE
00299       IRETOU=1
00300       CLACTI='WRITE'
00301       GOTO 909
00302 C
00303   904 CONTINUE
00304 C
00305 C        "DESALLOCATION" DE LA P.P.I. SUITE A ERREUR EN LECTURE
00306 C     DE L'ARTICLE D'INDEX "NOMS".
00307 C
00308       IF (INPPIM.GT.LFI%JPNPIA) THEN
00309          IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'ON')
00310         LFI%NPISAF=LFI%NPISAF-IFACTM
00311 C
00312         DO 906 JR=IRGPIM,IRGPIM+IFACTM-1
00313         LFI%MCOPIF(JR)=LFI%JPNIL
00314   906   CONTINUE
00315 C
00316          IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'OFF')
00317       ENDIF
00318 C
00319       LFI%NPPIMM(IRANG)=INPPIM-1
00320       IRETOU=2
00321       CLACTI='READ'
00322 C
00323   909 CONTINUE
00324 C
00325 C       ON FORCE LE CODE-REPONSE A ETRE POSITIF.
00326 C
00327       KREP=IABS (KREP)
00328       IF (INAPHY.NE.0) LFI%NUMAPH(IRANG)=INAPHY
00329 C**
00330 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00331 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00332 C-----------------------------------------------------------------------
00333 C
00334  1001 CONTINUE
00335       LLFATA=LLMOER (KREP,KRANG)
00336 C
00337       IF (KREP.EQ.0) THEN
00338         KRETIN=0
00339       ELSEIF (KREP.GT.0) THEN
00340         KRETIN=IRETOU
00341       ELSE
00342         KRETIN=3
00343       ENDIF
00344 C
00345       IF (LFI%LMISOP.OR.LLFATA) THEN
00346         INIMES=2
00347         CLNSPR='LFIPIM'
00348         WRITE (UNIT=CLMESS,FMT='(''KREP='',I5,'', KRANG='
00349 ',I3,     S       '', KRANGM='',I3,'', KRGPIM='',I3,'', KRGPIF='
00350 ',I4,     S       '', KRGFOR='',I4,'', KNPILE='',I2,'', KRETIN='',I2)')
00351      S    KREP,KRANG,KRANGM,KRGPIM,KRGPIF,KRGFOR,KNPILE,KRETIN
00352         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00353      S                  CLMESS,CLNSPR,CLACTI)
00354       ENDIF
00355 C
00356       IF (LHOOK) CALL DR_HOOK('LFIPIM_MT',1,ZHOOK_HANDLE)
00357       END
00358