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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFILED_MT (LFI, KREP, KRANG, KTAB, KLONG, KRGPIM, 
00003      S                      KPOSEX, 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     LECTURE DES DONNEES PROPREMENT DITES, UNE FOIS L'ARTICLE LOGIQUE
00010 C     DEFINI (PAR NOM, OU PAR POSITION) .
00011 C**
00012 C    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
00013 C                KRANG  (ENTREE) ==> RANG ( DANS LA TABLE *LFI%NUMERO* )
00014 C                                    DE L'UNITE LOGIQUE CONCERNEE;
00015 C                KTAB   (ENTREE) ==> PREMIER MOT A LIRE;
00016 C                KLONG  (ENTREE) ==> LONGUEUR DE L'ARTICLE A LIRE;
00017 C                KRGPIM (ENTREE) ==> RANG DANS LES TABLES LFI%CNOMAR,LFI%MLGPOS,
00018 C                                    ETC. DE LA P.P.I. OU FIGURE
00019 C                                    L'ARTICLE;
00020 C                KPOSEX (ENTREE) ==> POSITION ( DANS LE FICHIER ) OU
00021 C                                    COMMENCER A LIRE L'ARTICLE;
00022 C                KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
00023 C
00024 #ifndef f77
00025 #include "precision.h"
00026 #endif
00027 C
00028       TYPE(LFICOM) :: LFI
00029       INTEGER KREP, KRANG, KLONG, KRGPIM, KPOSEX, KRETIN
00030 #ifndef f77
00031       INTEGER (KIND=JPDBLE)  KTAB (KLONG), IFOURT (LFI%JPLARX)
00032 #else
00033       INTEGER KTAB (KLONG), IFOURT (LFI%JPLARX)
00034 #endif
00035       INTEGER INUCPL (LFI%JPNPDF), INAPHY, INUMER, ILARPH, IPODEB, IPOFIN
00036       INTEGER IARDEB, IARFIN, IDCDEB, IDCFIN, ICPLTI, ICPLTF, ICPTTN
00037       INTEGER ICPTTX, INCPLT, INUMAP, J, JD, IDECDE, IPAREC, ITAMLI
00038       INTEGER INUMPJ, INUMPD, IARTIC, INPDRE, INPDTA, INPDIS, INDIK1
00039       INTEGER INDIK2, INDIC1, INDIC2, JI, IFACTM, IRETOU, INIMES
00040       INTEGER IRETIN
00041 C
00042       LOGICAL LLADON, LLDERN
00043 C
00044 #include "lficom2.h"
00045 #include "lficom_mt.h"
00046 C**
00047 C     1.  -  CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
00048 C-----------------------------------------------------------------------
00049 C
00050       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00051       IF (LHOOK) CALL DR_HOOK('LFILED_MT',0,ZHOOK_HANDLE)
00052       IRETOU=0
00053 C
00054       IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI
00055      S    .OR.KRGPIM.LE.0.OR.KPOSEX.EQ.0)
00056      S     THEN
00057         KREP=-16
00058         GOTO 1001
00059       ENDIF
00060 C
00061 C        ON COMPLETE LES CARACTERISTIQUES DE L'ARTICLE.
00062 C
00063       INAPHY=0
00064 C
00065       IF (.NOT.LFI%LPHASP(KRGPIM)) THEN
00066 C
00067         CALL LFIPHA_MT (LFI, KREP,KRANG,KRGPIM,IRETIN)
00068 C
00069         IF (IRETIN.EQ.1) THEN
00070           GOTO 903
00071         ELSEIF (IRETIN.EQ.2) THEN
00072           GOTO 904
00073         ELSEIF (IRETIN.NE.0) THEN
00074           GOTO 1001
00075         ENDIF
00076 C
00077       ENDIF
00078 C
00079       INUMER=LFI%NUMERO(KRANG)
00080       IFACTM=LFI%MFACTM(KRANG)
00081       ILARPH=LFI%JPLARD*IFACTM
00082       KREP=0
00083 C**
00084 C     2.  -   LECTURE DES DONNEES .
00085 C-----------------------------------------------------------------------
00086 C*
00087 C     2.1 - UTILISATION DES ARTICLES PHYSIQUES PRESENTS EN MEMOIRE,
00088 C           ET QUE L'ON S'APPRETE A LIRE *EN ENTIER*;
00089 C-----------------------------------------------------------------------
00090 C
00091       IPODEB=KPOSEX
00092       IPOFIN=KPOSEX+KLONG-1
00093       IARDEB=1+(IPODEB-1)/ILARPH
00094       IARFIN=1+(IPOFIN-1)/ILARPH
00095       IDCDEB=MOD (IPODEB-1,ILARPH)
00096       IDCFIN=MOD (IPOFIN  ,ILARPH)
00097       LLDERN=IDCFIN.NE.0.AND.((IARFIN.NE.IARDEB)
00098      S                        .OR.(IARFIN.EQ.IARDEB.AND.IDCDEB.EQ.0))
00099       ICPLTI=IARDEB+(IDCDEB+ILARPH-1)/ILARPH
00100       ICPLTF=IARFIN-1+(ILARPH-IDCFIN)/ILARPH
00101       ICPTTN=ICPLTF+1
00102       ICPTTX=ICPLTI-1
00103       INCPLT=0
00104 C
00105       IF (LFI%LMISOP) THEN
00106        WRITE (UNIT=LFI%NULOUT,FMT=*)'KPOSEX= ',KPOSEX,', IPODEB= ',
00107      S                               IPODEB,', IPOFIN= ',IPOFIN
00108        WRITE (UNIT=LFI%NULOUT,FMT=*)'IARDEB= ',IARDEB,', IARFIN= ',
00109      S                               IARFIN,', IDCDEB= ',IDCDEB
00110        WRITE (UNIT=LFI%NULOUT,FMT=*)'IDCFIN= ',IDCFIN,', ICPLTI= ',
00111      S                               ICPLTI,', ICPLTF= ',ICPLTF
00112        WRITE (UNIT=LFI%NULOUT,FMT=*)'ICPTTN= ',ICPTTN,', ICPTTX= ',
00113      S                               ICPTTX,', LLDERN= ',LLDERN
00114       ENDIF
00115 C
00116       IF (ICPLTF.GE.ICPLTI) THEN
00117 C
00118         DO 213 J=0,LFI%JPNPDF-1
00119         INUMAP=LFI%NUMAPD(J,KRANG)
00120 C
00121         IF (INUMAP.GE.ICPLTI.AND.INUMAP.LE.ICPLTF) THEN
00122           INCPLT=INCPLT+1
00123           INUCPL(INCPLT)=INUMAP
00124           ICPTTN=MIN0 (ICPTTN,INUMAP)
00125           ICPTTX=MAX0 (ICPTTX,INUMAP)
00126           IDECDE=(INUMAP-IARDEB)*ILARPH-IDCDEB
00127 C
00128           IF (LFI%NLONPD(J,KRANG).LT.ILARPH) THEN
00129 C
00130             IF (INUMAP.GT.LFI%MDES1D(IXM(LFI%JPAXPD,KRANG)).OR.
00131      S          .NOT.LFI%LECRPD(J,KRANG)) THEN
00132               KREP=-16
00133               GOTO 1001
00134             ELSE
00135               INAPHY=INUMAP
00136               CALL LFILDO_MT (LFI, KREP,INUMER,INUMAP,
00137      S                        IFOURT,LFI%NBREAD(KRANG),
00138      S                        IFACTM,IRETIN)
00139 C
00140               IF (IRETIN.NE.0) THEN
00141                 GOTO 904
00142               ENDIF
00143 C
00144               DO 211 JD=LFI%NLONPD(J,KRANG)+1,ILARPH
00145               LFI%MTAMPD(IXT(JD,J,KRANG))=IFOURT(JD)
00146   211         CONTINUE
00147 C
00148             ENDIF
00149 C
00150             LFI%NLONPD(J,KRANG)=ILARPH
00151           ENDIF
00152 C
00153           DO 212 JD=1,ILARPH
00154           KTAB(IDECDE+JD)=LFI%MTAMPD(IXT(JD,J,KRANG))
00155   212     CONTINUE
00156 C
00157           IF (INCPLT.GT.(ICPLTF-ICPLTI)) THEN
00158             GOTO 220
00159           ENDIF
00160 C
00161         ENDIF
00162 C
00163   213   CONTINUE
00164 C
00165       ENDIF
00166 C
00167   220 CONTINUE
00168 C*
00169 C     2.2 - TRAITEMENT DE LA PREMIERE PAGE DE DONNEES, SI L'ARTICLE
00170 C           LOGIQUE NE COMMENCE PAS JUSTE EN DEBUT D'ARTICLE PHYSIQUE.
00171 C           CETTE PAGE EST CONSERVEE... DES FOIS QUE L'ACCES
00172 C           SUIVANT AU FICHIER SOIT POUR L'ARTICLE LOGIQUE IMMEDIATEMENT
00173 C           DEVANT (CAS DE BALAYAGE INVERSE DU FICHIER, PAR EXEMPLE) .
00174 C-----------------------------------------------------------------------
00175 C
00176       IDECDE=0
00177 C
00178       IF (IDCDEB.EQ.0) THEN
00179         IPAREC=0
00180         ITAMLI=LFI%JPNPDF
00181       ELSE
00182         IPAREC=MIN0 (ILARPH*IARDEB,IPOFIN)-KPOSEX+1
00183         ITAMLI=LFI%JPNPDF-1
00184 C
00185 C           L'ARTICLE DE DONNEES A LIRE NE COMMENCE PAS AU DEBUT D'UN
00186 C         ARTICLE PHYSIQUE. IL FAUT DONC AVOIR CET ARTICLE PHYSIQUE
00187 C         EN MEMOIRE POUR LE COMPLETER.
00188 C
00189         DO 222 J=0,LFI%JPNPDF-1
00190         INUMPJ=MOD (LFI%NDERPD(KRANG)+J,LFI%JPNPDF)
00191 C
00192         IF (LFI%NUMAPD(INUMPJ,KRANG).EQ.IARDEB) THEN
00193 C
00194 C           ARTICLE PHYSIQUE CHERCHE EN MEMOIRE.
00195 C
00196           IF (LFI%NLONPD(INUMPJ,KRANG).LT.(IDCDEB+IPAREC)) THEN
00197 C
00198             IF (IARDEB.GT.LFI%MDES1D(IXM(LFI%JPAXPD,KRANG))) THEN
00199               KREP=-16
00200               GOTO 1001
00201             ELSEIF (LFI%LECRPD(INUMPJ,KRANG)) THEN
00202               INAPHY=IARDEB
00203               CALL LFILDO_MT (LFI, KREP,INUMER,IARDEB,IFOURT,
00204      S                     LFI%NBREAD(KRANG),IFACTM,IRETIN)
00205 C
00206               IF (IRETIN.NE.0) THEN
00207                 GOTO 904
00208               ENDIF
00209 C
00210               DO 221 JD=LFI%NLONPD(INUMPJ,KRANG)+1,ILARPH
00211               LFI%MTAMPD(IXT(JD,INUMPJ,KRANG))=IFOURT(JD)
00212   221         CONTINUE
00213 C
00214             ELSE
00215               LFI%NUMAPD(INUMPJ,KRANG)=LFI%JPNIL
00216               INAPHY=IARDEB
00217               CALL LFILDO_MT (LFI, KREP,INUMER,IARDEB,
00218      S                     LFI%MTAMPD(IXT(1,INUMPJ,KRANG)),
00219      S                     LFI%NBREAD(KRANG),IFACTM,IRETIN)
00220 C
00221               IF (IRETIN.NE.0) THEN
00222                 GOTO 904
00223               ENDIF
00224 C
00225               LFI%NUMAPD(INUMPJ,KRANG)=IARDEB
00226             ENDIF
00227 C
00228             LFI%NLONPD(INUMPJ,KRANG)=ILARPH
00229           ENDIF
00230 C
00231           INUMPD=INUMPJ
00232           GOTO 223
00233         ENDIF
00234 C
00235   222   CONTINUE
00236 C
00237 C     ARTICLE PHYSIQUE CHERCHE PAS EN MEMOIRE... ON DOIT DONC LE LIRE.
00238 C
00239         INUMPD=MOD (1+LFI%NDERPD(KRANG),LFI%JPNPDF)
00240         INAPHY=0
00241 C
00242         IF (LFI%LECRPD(INUMPD,KRANG)) THEN
00243 C
00244           CALL LFIVID_MT (LFI, KREP,KRANG,INUMPD,IFOURT,IRETIN)
00245 C
00246           IF (IRETIN.EQ.1) THEN
00247             GOTO 903
00248           ELSEIF (IRETIN.EQ.2) THEN
00249             GOTO 904
00250           ELSEIF (IRETIN.NE.0) THEN
00251             GOTO 1001
00252           ENDIF
00253 C
00254         ENDIF
00255 C
00256         LFI%NUMAPD(INUMPD,KRANG)=LFI%JPNIL
00257         INAPHY=IARDEB
00258         CALL LFILDO_MT (LFI, KREP,INUMER,IARDEB,
00259      S                  LFI%MTAMPD(IXT(1,INUMPD,KRANG)),
00260      S                  LFI%NBREAD(KRANG),IFACTM,IRETIN)
00261 C
00262         IF (IRETIN.NE.0) THEN
00263           GOTO 904
00264         ENDIF
00265 C
00266         LFI%NUMAPD(INUMPD,KRANG)=IARDEB
00267         LFI%NLONPD(INUMPD,KRANG)=ILARPH
00268 C
00269   223   CONTINUE
00270 C
00271 C         TRANSFERT DE LA PARTIE UTILE DES DONNEES POUR CE DEBUT
00272 C       D'ARTICLE LOGIQUE.
00273 C
00274         DO 224 JD=1,IPAREC
00275         KTAB(JD)=LFI%MTAMPD(IXT(IDCDEB+JD,INUMPD,KRANG))
00276   224   CONTINUE
00277 C
00278         LFI%NDERPD(KRANG)=INUMPD
00279       ENDIF
00280 C*
00281 C     2.3 - LECTURE DES ARTICLES PHYSIQUES COMPLETS NE TENANT PAS OU NE
00282 C           DEVANT PAS ETRE STOCKES DANS LES PAGES DE DONNEES "TAMPON".
00283 C-----------------------------------------------------------------------
00284 C
00285       IF (.NOT.LFI%LTAMPL(KRANG)) THEN
00286         ITAMLI=0
00287       ELSEIF (LLDERN) THEN
00288         ITAMLI=ITAMLI-1
00289       ENDIF
00290 C
00291       IARTIC=ICPLTI-1
00292       INPDRE=(KLONG-IPAREC-IDCFIN+ILARPH-1)/ILARPH-INCPLT
00293       INPDTA=MIN0 (INPDRE,ITAMLI)
00294       INPDIS=INPDRE-ITAMLI
00295       INDIK1=1
00296       INDIK2=INCPLT
00297       LLADON=.TRUE.
00298 C
00299       DO 235 J=1,INPDIS
00300 C
00301   231 CONTINUE
00302       IARTIC=IARTIC+1
00303       IF (LFI%LMISOP) WRITE (UNIT=LFI%NULOUT,FMT=*)
00304      S      'BOUCLE 235, J= ',J,', IARTIC= ',IARTIC,', IDECDE= ',IDECDE
00305 C
00306       IF (IARTIC.GE.ICPTTN.AND.IARTIC.LE.ICPTTX) THEN
00307         IF (IARTIC.EQ.ICPTTN) ICPTTN=ICPTTN+1
00308         IF (IARTIC.EQ.ICPTTX) ICPTTX=ICPTTX-1
00309         INDIC1=INDIK1
00310         INDIC2=INDIK2
00311 C
00312 C          ON FILTRE LES ARTICLES PHYSIQUES DEJA STOCKES DANS DES PAGES
00313 C        DE DONNEES LORS DE LA PARTIE 2.1 ...
00314 C
00315         DO 232 JI=INDIC1,INDIC2
00316 C
00317         IF (IARTIC.EQ.INUCPL(JI)) THEN
00318           IF (JI.EQ.INDIK1) INDIK1=INDIK1+1
00319           IF (JI.EQ.INDIK2) INDIK2=INDIK2-1
00320           GOTO 231
00321         ENDIF
00322 C
00323   232   CONTINUE
00324 C
00325       ENDIF
00326 C
00327       IDECDE=(IARTIC-IARDEB)*ILARPH-IDCDEB
00328       INAPHY=IARTIC
00329       CALL LFILDO_MT (LFI, KREP,INUMER,IARTIC,KTAB(IDECDE+1),
00330      S             LFI%NBREAD(KRANG),IFACTM,IRETIN)
00331 C
00332       IF (IRETIN.NE.0) THEN
00333         GOTO 904
00334       ENDIF
00335 
00336   235 CONTINUE
00337 C*
00338 C     2.4 - LECTURE DES ARTICLES PHYSIQUES COMPLETS QUE L'ON PEUT STOC-
00339 C           KER DANS LES PAGES DE DONNEES "TAMPON".
00340 C           ( TOUT EN PRESERVANT LES EMPLACEMENTS DE LA PREMIERE ET/OU
00341 C             DE LA DERNIERE PAGE DE DONNEES, SI INCOMPLETE(S) )
00342 C-----------------------------------------------------------------------
00343 C
00344       DO 246 J=1,INPDTA
00345       INUMPD=MOD (LFI%NDERPD(KRANG)+J,LFI%JPNPDF)
00346 C
00347   241 CONTINUE
00348       IARTIC=IARTIC+1
00349 C
00350       IF (IARTIC.GE.ICPTTN.AND.IARTIC.LE.ICPTTX) THEN
00351         IF (IARTIC.EQ.ICPTTN) ICPTTN=ICPTTN+1
00352         IF (IARTIC.EQ.ICPTTX) ICPTTX=ICPTTX-1
00353         INDIC1=INDIK1
00354         INDIC2=INDIK2
00355 C
00356 C          ON FILTRE LES ARTICLES PHYSIQUES DEJA STOCKES DANS DES PAGES
00357 C        DE DONNEES LORS DE LA PARTIE 2.1 ...
00358 C
00359         DO 242 JI=INDIC1,INDIC2
00360 C
00361         IF (IARTIC.EQ.INUCPL(JI)) THEN
00362           IF (JI.EQ.INDIK1) INDIK1=INDIK1+1
00363           IF (JI.EQ.INDIK2) INDIK2=INDIK2-1
00364           GOTO 241
00365         ENDIF
00366 C
00367   242   CONTINUE
00368 C
00369       ENDIF
00370 C
00371 C         SI NECESSAIRE, "VIDAGE" SUR FICHIER DE LA PAGE A UTILISER.
00372 C
00373       INAPHY=0
00374 C
00375       IF (LFI%LECRPD(INUMPD,KRANG)) THEN
00376 C
00377         CALL LFIVID_MT (LFI, KREP,KRANG,INUMPD,IFOURT,IRETIN)
00378 C
00379         IF (IRETIN.EQ.1) THEN
00380           GOTO 903
00381         ELSEIF (IRETIN.EQ.2) THEN
00382           GOTO 904
00383         ELSEIF (IRETIN.NE.0) THEN
00384           GOTO 1001
00385         ENDIF
00386 C
00387       ENDIF
00388 C
00389 C         LECTURE SUR FICHIER DE LA PAGE DE DONNEES TAMPON.
00390 C
00391       LFI%NUMAPD(INUMPD,KRANG)=LFI%JPNIL
00392       INAPHY=IARTIC
00393       CALL LFILDO_MT (LFI, KREP,INUMER,IARTIC,
00394      S                LFI%MTAMPD(IXT(1,INUMPD,KRANG)),
00395      S                LFI%NBREAD(KRANG),IFACTM,IRETIN)
00396 C
00397       IF (IRETIN.NE.0) THEN
00398         GOTO 904
00399       ENDIF
00400 C
00401       LFI%NUMAPD(INUMPD,KRANG)=IARTIC
00402       LFI%NLONPD(INUMPD,KRANG)=ILARPH
00403       IDECDE=(IARTIC-IARDEB)*ILARPH-IDCDEB
00404 C
00405 C         TRANSFERT DANS LA ZONE UTILISATEUR.
00406 C
00407       DO 245 JD=1,ILARPH
00408       KTAB(IDECDE+JD)=LFI%MTAMPD(IXT(JD,INUMPD,KRANG))
00409   245 CONTINUE
00410 C
00411   246 CONTINUE
00412 C
00413       LFI%NDERPD(KRANG)=MOD (LFI%NDERPD(KRANG)+INPDTA,LFI%JPNPDF)
00414 C*
00415 C     2.5 - TRAITEMENT DE LA DERNIERE PAGE DE DONNEES SI ELLE EST
00416 C           INCOMPLETE, ET SI ON EST DANS L'UN DES 2 CAS SUIVANTS
00417 C           SOIT ELLE DIFFERE DE LA PREMIERE, SOIT C'EST LA MEME QUE LA
00418 C           PREMIERE ET ELLE COMMENCE JUSTE EN DEBUT D'ARTICLE.
00419 C           CETTE PAGE EST CONSERVEE... CAR ON ESPERE QUE L'ACCES
00420 C           SUIVANT AU FICHIER SERA POUR L'ARTICLE LOGIQUE IMMEDIATEMENT
00421 C           DERRIERE ( LECTURE SEQUENTIELLE DU FICHIER, PAR EXEMPLE ) .
00422 C-----------------------------------------------------------------------
00423 C
00424       IF (LLDERN) THEN
00425 C
00426         DO 252 J=1,LFI%JPNPDF
00427         INUMPJ=MOD (LFI%NDERPD(KRANG)+J,LFI%JPNPDF)
00428 C
00429         IF (LFI%NUMAPD(INUMPJ,KRANG).EQ.IARFIN) THEN
00430 C
00431 C           ARTICLE PHYSIQUE CHERCHE EN MEMOIRE.
00432 C
00433           IF (LFI%NLONPD(INUMPJ,KRANG).LT.IDCFIN) THEN
00434 C
00435             IF (IARFIN.GT.LFI%MDES1D(IXM(LFI%JPAXPD,KRANG))) THEN
00436               KREP=-16
00437               GOTO 1001
00438             ELSEIF (LFI%LECRPD(INUMPJ,KRANG)) THEN
00439               INAPHY=IARFIN
00440               CALL LFILDO_MT (LFI, KREP,INUMER,IARFIN,IFOURT,
00441      S                     LFI%NBREAD(KRANG),IFACTM,IRETIN)
00442 C
00443               IF (IRETIN.NE.0) THEN
00444                 GOTO 904
00445               ENDIF
00446 C
00447               DO 251 JD=LFI%NLONPD(INUMPJ,KRANG)+1,ILARPH
00448               LFI%MTAMPD(IXT(JD,INUMPJ,KRANG))=IFOURT(JD)
00449   251         CONTINUE
00450 C
00451             ELSE
00452               LFI%NUMAPD(INUMPJ,KRANG)=LFI%JPNIL
00453               INAPHY=IARFIN
00454               CALL LFILDO_MT (LFI, KREP,INUMER,IARFIN,
00455      S                     LFI%MTAMPD(IXT(1,INUMPJ,KRANG)),
00456      S                     LFI%NBREAD(KRANG),IFACTM,IRETIN)
00457 C
00458               IF (IRETIN.NE.0) THEN
00459                 GOTO 904
00460               ENDIF
00461 C
00462               LFI%NUMAPD(INUMPJ,KRANG)=IARFIN
00463             ENDIF
00464 C
00465             LFI%NLONPD(INUMPJ,KRANG)=ILARPH
00466           ENDIF
00467 C
00468           INUMPD=INUMPJ
00469           GOTO 253
00470         ENDIF
00471 C
00472   252   CONTINUE
00473 C
00474 C           ARTICLE PHYSIQUE CHERCHE PAS EN MEMOIRE...
00475 C
00476         INUMPD=MOD (1+LFI%NDERPD(KRANG),LFI%JPNPDF)
00477         INAPHY=0
00478 C
00479         IF (LFI%LECRPD(INUMPD,KRANG)) THEN
00480 C
00481           CALL LFIVID_MT (LFI, KREP,KRANG,INUMPD,IFOURT,IRETIN)
00482 C
00483           IF (IRETIN.EQ.1) THEN
00484             GOTO 903
00485           ELSEIF (IRETIN.EQ.2) THEN
00486             GOTO 904
00487           ELSEIF (IRETIN.NE.0) THEN
00488             GOTO 1001
00489           ENDIF
00490 C
00491         ENDIF
00492 C
00493         IF (IARFIN.LE.LFI%MDES1D(IXM(LFI%JPAXPD,KRANG))) THEN
00494           LFI%NUMAPD(INUMPD,KRANG)=LFI%JPNIL
00495           INAPHY=IARFIN
00496           CALL LFILDO_MT (LFI, KREP,INUMER,IARFIN,
00497      S                    LFI%MTAMPD(IXT(1,INUMPD,KRANG)),
00498      S                    LFI%NBREAD(KRANG),IFACTM,IRETIN)
00499 C
00500           IF (IRETIN.NE.0) THEN
00501             GOTO 904
00502           ENDIF
00503 C
00504           LFI%NLONPD(INUMPD,KRANG)=ILARPH
00505         ELSE
00506           LFI%NLONPD(INUMPD,KRANG)=0
00507         ENDIF
00508 C
00509         LFI%NUMAPD(INUMPD,KRANG)=IARFIN
00510 C
00511   253   CONTINUE
00512         IDECDE=(IARFIN-IARDEB)*ILARPH-IDCDEB
00513 C
00514 C         COMPLEMENT DE LA PAGE DE DONNEES ASSOCIEE AU DERNIER ARTICLE
00515 C       PHYSIQUE OU DOIVENT ETRE STOCKEES LES DONNEES A ECRIRE.
00516 C
00517         DO 254 JD=1,IDCFIN
00518         KTAB(IDECDE+JD)=LFI%MTAMPD(IXT(JD,INUMPD,KRANG))
00519   254   CONTINUE
00520 C
00521         LFI%NDERPD(KRANG)=INUMPD
00522       ENDIF
00523 C
00524       GOTO 1001
00525 C**
00526 C     9.  - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
00527 C      AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
00528 C-----------------------------------------------------------------------
00529 C
00530   903 CONTINUE
00531       IRETOU=1
00532       CLACTI='WRITE'
00533       GOTO 909
00534 C
00535   904 CONTINUE
00536       IRETOU=2
00537       CLACTI='READ'
00538 C
00539   909 CONTINUE
00540       KREP=IABS (KREP)
00541       IF (INAPHY.NE.0) LFI%NUMAPH(KRANG)=INAPHY
00542 C**
00543 C    10.  -  PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
00544 C            VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
00545 C-----------------------------------------------------------------------
00546 C
00547  1001 CONTINUE
00548       LLFATA=LLMOER (KREP,KRANG)
00549 C
00550       IF (KREP.EQ.0) THEN
00551         KRETIN=0
00552       ELSEIF (KREP.GT.0) THEN
00553         KRETIN=IRETOU
00554       ELSE
00555         KRETIN=3
00556       ENDIF
00557 C
00558       IF (LFI%LMISOP.OR.LLFATA) THEN
00559         INIMES=2
00560         CLNSPR='LFILED'
00561         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='
00562 ',I3,     S  '', KLONG='',I7,'', KRGPIM='',I3,'', KPOSEX='
00563 ',I8,     S  '', KRETIN='',I2)') KREP,KRANG,KLONG,KRGPIM,KPOSEX,KRETIN
00564         CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE.,
00565      S                  CLMESS,CLNSPR,CLACTI)
00566       ENDIF
00567 C
00568       IF (LHOOK) CALL DR_HOOK('LFILED_MT',1,ZHOOK_HANDLE)
00569       END
00570