|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 C Jan-2011 P. Marguinaud Thread-safe LFI 00002 SUBROUTINE LFIREE_MT (LFI, KREP, KRANG, CDNOMA, KLONG, KRPIEX, 00003 S KARTEX, 00004 S KLONEX, KRPIEC, KARTEC, KPOSEC, KDTROU, 00005 S KLONUT, KRETIN ) 00006 USE LFIMOD, ONLY : LFICOM 00007 USE PARKIND1, ONLY : JPRB 00008 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00009 C**** 00010 C SOUS-PROGRAMME *INTERNE* DU LOGICIEL DE FICHIERS INDEXES LFI 00011 C RECHERCHE D'UN EMPLACEMENT OU ECRIRE UN ARTICLE LOGIQUE, DANS 00012 C L'UNITE LOGIQUE CONCERNEE. 00013 C** 00014 C ARGUMENTS : KREP (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME; 00015 C KRANG (ENTREE) ==> RANG ( DANS LA TABLE *LFI%NUMERO* ) 00016 C DE L'UNITE LOGIQUE CONCERNEE; 00017 C CDNOMA (ENTREE) ==> NOM DE L'ARTICLE A RECHERCHER; 00018 C KLONG (ENTREE) ==> LONGUEUR DE L'ARTICLE A ECRIRE; 00019 C KRPIEX (SORTIE) ==> RANG ( DANS LE FICHIER ) DE L'ARTI- 00020 C CLE S'IL EXISTAIT DEJA ( 0 SINON ); 00021 C KARTEX (SORTIE) ==> RANG ( DANS LA PAGE D'INDEX ) DE L' 00022 C ARTICLE S'IL EXISTAIT ( 0 SINON ); 00023 C KLONEX (SORTIE) ==> LONGUEUR DE L'ARTICLE S'IL EXISTAIT 00024 C DEJA ( 0 SINON ); 00025 C KRPIEC (SORTIE) ==> RANG ( DANS LE FICHIER ) DE L'ARTI- 00026 C CLE A ECRIRE; 00027 C KARTEC (SORTIE) ==> RANG ( DANS LA PAGE D'INDEX ) DE L' 00028 C ARTICLE A ECRIRE; 00029 C KPOSEC (SORTIE) ==> POSITION ( DANS LE FICHIER ) OU 00030 C COMMENCER A ECRIRE L'ARTICLE; 00031 C KDTROU (SORTIE) ==> VARIATION DU NOMBRE DE TROUS DANS 00032 C L'INDEX, DUE A CETTE ECRITURE; 00033 C KLONUT (SORTIE) ==> SI L'ON VA CREER UN TROU DANS L'IN- 00034 C DEX, LONGUEUR TOTALE UTILISABLE DE 00035 C CE TROU; 00036 C KRETIN (SORTIE) ==> CODE-RETOUR INTERNE. 00037 C* 00038 C METHODE: SI L'ARTICLE EXISTE DEJA DANS LE FICHIER, ON ESSAIE AUTANT 00039 C QUE POSSIBLE DE "REECRIRE" SUR PLACE, CE QUI EST POSSIBLE 00040 C SI L'ON A UNE LONGUEUR D'ARTICLE INFERIEURE OU EGALE A 00041 C CELLE EXISTANTE, MAIS EST AUSSI POSSIBLE PAR RECYCLAGE 00042 C DE "TROUS" DE 2 CATEGORIES: EN FIN D'ARTICLE EXISTANT 00043 C ( AVANT L'ARTICLE LOGIQUE OU L'ARTICLE D'INDEX SUIVANT ), 00044 C ET/OU S'IL EXISTE UN "TROU" REPERTORIE DANS L'INDEX CORRE- 00045 C SPONDANT A UN ARTICLE LOGIQUE JUSTE DERRIERE CELUI EXIS- 00046 C TANT. 00047 C SI LA REECRITURE N'EST PAS POSSIBLE, ON ESSAIE ALORS DE 00048 C REUTILISER UN EVENTUEL "TROU" REPERTORIE DANS L'INDEX; 00049 C EN DESESPOIR DE CAUSE, ON ECRIT EN FIN DE FICHIER. 00050 C 00051 #ifndef f77 00052 #include "precision.h" 00053 #endif 00054 C 00055 TYPE(LFICOM) :: LFI 00056 CHARACTER CDNOMA*(*) 00057 C 00058 INTEGER KREP, KRANG, KLONG, KRPIEX, KARTEX, KLONEX, KRPIEC, KARTEC 00059 INTEGER KPOSEC, KDTROU, KLONUT, ILCDNO, IRANG, ILTSUF, INTTRU, J 00060 INTEGER INBALO, INBPIR, IFACTM, ILARPH, INALPP, INTPPI, IRNGSU 00061 INTEGER INPPIM, INPIME, INTROU, INPPI1, IDEBEX, IARTIC, IRGPIF 00062 INTEGER INALPI, INPAGE, IRGPIM, IRPIFN, ILFORC, INBVAL, IPOSEX 00063 INTEGER IPOSDX, IRECPI, ILSUIV, IPOSUI, IRGPI, IRPIMS, INPILE 00064 INTEGER IRNGMS, INTRPI, ILTROU, IPTROU, IRPITR, IARTTR, IPOSTR 00065 INTEGER IRPIMD, IRPIFD, INALDP, IRETOU, INIMES, INUMER, IRANGM 00066 INTEGER IEXPLO (LFI%JPNPIA+LFI%JPNPIS+1), INDICE (LFI%JPNAPX), 00067 S KRETIN, IRETIN 00068 C 00069 LOGICAL LLTSUF, LLTOPT, LLTTRU, LLRCHA 00070 C 00071 #include "lficom2.h" 00072 #include "lficom_mt.h" 00073 C** 00074 C 1. - CONTROLES DES PARAMETRES D'APPEL ET INITIALISATIONS. 00075 C----------------------------------------------------------------------- 00076 C 00077 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00078 IF (LHOOK) CALL DR_HOOK('LFIREE_MT',0,ZHOOK_HANDLE) 00079 ILCDNO=LEN (CDNOMA) 00080 C 00081 IF (KRANG.LE.0.OR.KRANG.GT.LFI%JPNXFI.OR.KLONG.LE.0.OR. 00082 S ILCDNO.LE.0.OR.ILCDNO.GT.LFI%JPNCPN.OR.CDNOMA.EQ.' ') THEN 00083 KREP=-16 00084 GOTO 1001 00085 ENDIF 00086 C 00087 IRANG=KRANG 00088 KREP=0 00089 LLTSUF=.FALSE. 00090 LLTOPT=.FALSE. 00091 KARTEX=0 00092 KARTEC=0 00093 KRPIEC=0 00094 KRPIEX=0 00095 KLONEX=0 00096 KLONUT=LFI%JPNIL 00097 IRETOU=0 00098 ILTSUF=0 00099 INTTRU=LFI%MDES1D(IXM(LFI%JPNTRU,IRANG))+LFI%NBTROU(IRANG) 00100 INBALO=LFI%MDES1D(IXM(LFI%JPNALO,IRANG)) 00101 INBPIR=LFI%MDES1D(IXM(LFI%JPNPIR,IRANG)) 00102 LLTTRU=INTTRU.EQ.0 00103 IFACTM=LFI%MFACTM(IRANG) 00104 ILARPH=LFI%JPLARD*IFACTM 00105 INALPP=LFI%JPNAPP*IFACTM 00106 INTPPI=(INBALO-1+INALPP)/INALPP 00107 IF (LFI%LMISOP) WRITE (UNIT=LFI%NULOUT,FMT=*) 00108 S 'INBALO= ',INBALO,', INTTRU= ',INTTRU,', INTPPI= ',INTPPI, 00109 S ', INBPIR= ',INBPIR 00110 C 00111 IF (INBALO.EQ.0) GOTO 240 00112 C 00113 IRNGSU=0 00114 IRPIFN=1 00115 INPPIM=LFI%NPPIMM(IRANG) 00116 INPIME=0 00117 INTROU=0 00118 C 00119 C** 00120 C 2. - EXPLORATION DES (PAIRES DE) PAGES ET ARTICLES D'INDEX, 00121 C A LA RECHERCHE DE L'ARTICLE ET/OU D'UN "TROU" DANS L'INDEX, 00122 C SUFFISANT POUR Y "CASER" L'ARTICLE. ( ON COMMENCE 00123 C PAR EXPLORER LES PAGES D'INDEX ) 00124 C----------------------------------------------------------------------- 00125 C 00126 INPPI1=INPPIM 00127 LLRCHA=.TRUE. 00128 C 00129 IF (LFI%NPODPI(IRANG).EQ.2) THEN 00130 IDEBEX=3 00131 ELSE 00132 IDEBEX=2 00133 ENDIF 00134 C 00135 IF (LLTTRU) THEN 00136 C 00137 CALL LFIRAN_MT (LFI, KREP,IRANG,CDNOMA,IRGPIM,IARTIC,IRETIN) 00138 C 00139 IF (IRETIN.EQ.1) THEN 00140 GOTO 903 00141 ELSEIF (IRETIN.EQ.2) THEN 00142 GOTO 904 00143 ELSEIF (IRETIN.NE.0) THEN 00144 GOTO 1001 00145 ELSEIF (IARTIC.NE.0) THEN 00146 C 00147 C ARTICLE TROUVE. 00148 C 00149 IRGPIF=LFI%MRGPIF(IRGPIM) 00150 INALPI=MIN0 (INALPP,INBALO-(IRGPIF-1)*INALPP) 00151 C 00152 C La ligne ci-dessous sert a eviter les ennuis entre les 00153 C etiquettes 213 et 215. 00154 C 00155 INPAGE=INTPPI+1 00156 GOTO 212 00157 ELSE 00158 C 00159 C IL VA FALLOIR CREER UN ARTICLE SUPPLEMENTAIRE. 00160 C 00161 GOTO 240 00162 ENDIF 00163 C 00164 ENDIF 00165 C 00166 C ... DEBUT D'UNE STRUCTURE DE TYPE "BOUCLE" SUR INPAGE, 00167 C QUI NE PEUT PAS (PLUS) ETRE UNE BOUCLE "DO" A PARTIR DU 00168 C MOMENT OU ON VEUT UTILISER, DES QUE POSSIBLE, "LFIRAN" 00169 C POUR UNE RECHERCHE D'ARTICLE MOINS COUTEUSE, SURTOUT LORSQUE 00170 C L'ARTICLE QUE L'ON CHERCHE ETAIT LE DERNIER TRAITE ... 00171 C 00172 INPAGE=1 00173 C 00174 201 CONTINUE 00175 C 00176 IF (INPAGE.LE.INPPI1) THEN 00177 C 00178 C IL S'AGIT D'UNE EXPLORATION EN MEMOIRE ( PAGES D'INDEX ) . 00179 C 00180 IRGPIM=LFI%MRGPIM(INPAGE,IRANG) 00181 IRGPIF=LFI%MRGPIF(IRGPIM) 00182 INPIME=INPIME+1 00183 IEXPLO(INPIME)=IRGPIF 00184 IF (IRGPIF.EQ.(IRPIFN+1)) IRPIFN=IRGPIF 00185 ELSE 00186 C 00187 C IL S'AGIT D'UNE EXPLORATION "HORS MEMOIRE"; 00188 C ON CHERCHE LA PROCHAINE P.A.I. NON EXPLOREE . 00189 C 00190 IF (INPAGE.EQ.INPPI1+1) THEN 00191 C 00192 IF (IRNGSU.EQ.0) THEN 00193 IRGPIF=IRPIFN 00194 ELSE 00195 C 00196 C Cas ou il y a eu, dans la recherche "en memoire", 00197 C recyclage d'une P.P.I. que l'on avait exploree precedemment. 00198 C Cette P.P.I. est restee sur place, n'a pas ete exploree, 00199 C et il serait bete de l'oublier, au risque de la dupliquer... 00200 C 00201 IRGPIM=LFI%MRGPIM(IRNGSU,IRANG) 00202 IRGPIF=LFI%MRGPIF(IRGPIM) 00203 INPIME=INPIME+1 00204 IEXPLO(INPIME)=IRGPIF 00205 IF (IRGPIF.EQ.(IRPIFN+1)) IRPIFN=IRGPIF 00206 GOTO 210 00207 ENDIF 00208 C 00209 ENDIF 00210 C 00211 202 CONTINUE 00212 IRGPIF=IRGPIF+1 00213 C 00214 DO 203 J=IDEBEX,INPIME 00215 IF (IEXPLO(J).EQ.IRGPIF) GOTO 202 00216 203 CONTINUE 00217 C 00218 ILFORC=1 00219 INPILE=1 00220 CALL LFIPIM_MT (LFI, KREP,IRANG,IRANGM,IRGPIM,IRGPIF,ILFORC, 00221 S INPILE, IRETIN) 00222 C 00223 IF (IRETIN.EQ.1) THEN 00224 GOTO 903 00225 ELSEIF (IRETIN.EQ.2) THEN 00226 GOTO 904 00227 ELSEIF (IRETIN.NE.0) THEN 00228 GOTO 1001 00229 ENDIF 00230 C 00231 INPPIM=MAX0 (INPPIM,IRANGM) 00232 ENDIF 00233 C* 00234 C 2.1 - "BOUCLE" DE RECHERCHE SUR LES ARTICLES PRESENTS DANS 00235 C LA (PAIRE DE) PAGE D'INDEX DE RANG IRGPIF DANS LE FICHIER. 00236 C----------------------------------------------------------------------- 00237 C 00238 210 CONTINUE 00239 INALPI=MIN0 (INALPP,INBALO-(IRGPIF-1)*INALPP) 00240 IARTIC=0 00241 C 00242 IF (LLRCHA) THEN 00243 C 00244 DO 211 J=1,INALPI 00245 C 00246 IF (LFI%CNOMAR(IXC(J,IRGPIM)).EQ.CDNOMA) THEN 00247 IARTIC=J 00248 GOTO 212 00249 ENDIF 00250 C 00251 211 CONTINUE 00252 C 00253 ENDIF 00254 C 00255 212 CONTINUE 00256 C 00257 IF (IARTIC.NE.0) THEN 00258 C 00259 C ON A TROUVE DANS LE FICHIER UN ARTICLE DE MEME NOM QUE CELUI A 00260 C ECRIRE. 00261 C 00262 LLRCHA=.FALSE. 00263 C 00264 IF (.NOT.LFI%LPHASP(IRGPIM)) THEN 00265 C 00266 CALL LFIPHA_MT (LFI, KREP,IRANG,IRGPIM,IRETIN) 00267 C 00268 IF (IRETIN.EQ.1) THEN 00269 GOTO 903 00270 ELSEIF (IRETIN.EQ.2) THEN 00271 GOTO 904 00272 ELSEIF (IRETIN.NE.0) THEN 00273 GOTO 1001 00274 ENDIF 00275 C 00276 ENDIF 00277 C 00278 KRPIEX=IRGPIF 00279 KLONEX=LFI%MLGPOS(IXM(2*IARTIC-1,IRGPIM)) 00280 IPOSEX=LFI%MLGPOS(IXM(2*IARTIC,IRGPIM)) 00281 KARTEX=IARTIC 00282 C 00283 IF (KLONG.LE.KLONEX) THEN 00284 C 00285 C L'ARTICLE TROUVE EST AU MOINS AUSSI LONG QUE CELUI QUE L'ON VEUT 00286 C ECRIRE: UNE ECRITURE AU MEME EMPLACEMENT EST DONC POSSIBLE. 00287 C 00288 KRPIEC=IRGPIF 00289 KARTEC=IARTIC 00290 KPOSEC=IPOSEX 00291 GOTO 240 00292 ELSE 00293 C 00294 C CAS DE REECRITURE + LONGUE QUE L'ARTICLE EXISTANT SUR LE FICHIER. 00295 C 00296 IPOSDX=LFI%MLGPOS(IXM(2*IARTIC,IRGPIM))+KLONG-1 00297 C 00298 IF (IARTIC.EQ.1.AND.IRGPIF.GT.INBPIR) THEN 00299 C 00300 C IL Y A EU DEBORDEMENT DES P.A.I. PREALLOUEES, ET IL Y A 00301 C EN OUTRE UNE P.A.I. SUR LE FICHIER, JUSTE DERRIERE L'ARTICLE 00302 C LOGIQUE AUQUEL ON S'INTERESSE. ON REGARDE S'IL Y A ASSEZ DE 00303 C PLACE AVANT LA P.A.I. POUR UNE REECRITURE AU MEME ENDROIT. 00304 C ( P.A.I. = PAIRE D'ARTICLES D'INDEX ) 00305 C 00306 IRECPI=LFI%MDES1D(IXM(ILARPH+1-(IRGPIF-INBPIR),IRANG)) 00307 KLONUT=ILARPH*(IRECPI-1)-IPOSEX+1 00308 C 00309 IF (KLONG.LE.KLONUT) THEN 00310 KRPIEC=IRGPIF 00311 KARTEC=IARTIC 00312 KPOSEC=IPOSEX 00313 GOTO 240 00314 ELSE 00315 GOTO 216 00316 ENDIF 00317 C 00318 ELSEIF (IARTIC.EQ.INALPI.AND.IRGPIF.EQ.INTPPI) THEN 00319 C 00320 C CAS OU L'ARTICLE TROUVE EST LE DERNIER ARTICLE LOGIQUE DE 00321 C DONNEES, SANS P.A.I. JUSTE DERRIERE. IL Y A DE LA PLACE DONC... 00322 C 00323 KRPIEC=IRGPIF 00324 KARTEC=IARTIC 00325 KPOSEC=IPOSEX 00326 GOTO 240 00327 ENDIF 00328 C 00329 ENDIF 00330 C 00331 C EN ARRIVANT ICI, ON EST DONC SUR QUE L'ARTICLE TROUVE 00332 C N'EST PAS LE DERNIER ARTICLE LOGIQUE. 00333 C 00334 C ON VA REGARDER SI, PAR CHANCE, L'ARTICLE LOGIQUE SUIVANT N'EST 00335 C PAS UN TROU SUFFISANT POUR "CASER" L'EXCEDENT DE DONNEES, 00336 C OU S'IL N'Y A PAS UN TROU DE DONNEES ( NON ASSOCIE A UN TROU DANS 00337 C LA PARTIE "NOMS" DE L'INDEX ) SUFFISANT EN FIN D'ARTICLE EXISTANT, 00338 C AVANT L'ARTICLE LOGIQUE SUIVANT... 00339 C 00340 IF (IARTIC.NE.INALPI) THEN 00341 C 00342 C L'ARTICLE SUIVANT EST DANS LA MEME PAGE D'INDEX... 00343 C 00344 ILSUIV=LFI%MLGPOS(IXM(2*IARTIC+1,IRGPIM)) 00345 IPOSUI=LFI%MLGPOS(IXM(2*IARTIC+2,IRGPIM)) 00346 KLONUT=IPOSUI-IPOSEX 00347 C 00348 IF (KLONG.LE.KLONUT) THEN 00349 C 00350 C ... ET IL Y A UN "TROU" SUFFISANT AVANT CET ARTICLE POUR POUVOIR 00351 C ECRIRE LES DONNEES EXCEDENTAIRES. 00352 C 00353 KRPIEC=IRGPIF 00354 KARTEC=IARTIC 00355 KPOSEC=IPOSEX 00356 GOTO 240 00357 C 00358 ELSEIF (LFI%CNOMAR(IXC(IARTIC+1,IRGPIM)).EQ.' ' 00359 S .AND.KLONG.LE.(KLONUT+ILSUIV)) THEN 00360 C 00361 C ... ET C'EST UN TROU QUI PERMET, AVEC L'AIDE EVENTUELLE 00362 C D'UNE ZONE DE DONNEES "MORTE" ENTRE LES 2 ARTICLES, 00363 C DE MENAGER UNE PLACE SUFFISANTE POUR L'EXCES DE DONNEES. 00364 C 00365 LFI%MLGPOS(IXM(2*IARTIC+1,IRGPIM))=IPOSUI+ILSUIV-(IPOSDX+1) 00366 LFI%MLGPOS(IXM(2*IARTIC+2,IRGPIM))=IPOSDX+1 00367 LFI%LECRPI(IRGPIM,2)=.TRUE. 00368 KRPIEC=IRGPIF 00369 KARTEC=IARTIC 00370 KPOSEC=IPOSEX 00371 C 00372 IF (LFI%MLGPOS(IXM(2*IARTIC+1,IRGPIM)).EQ.0) THEN 00373 GOTO 230 00374 ELSE 00375 GOTO 240 00376 ENDIF 00377 C 00378 ENDIF 00379 C 00380 C ... L'ARTICLE SUIVANT N'EST PAS EXPLOITABLE POUR ECRIRE L'EXCES 00381 C DE DONNEES. 00382 C 00383 GOTO 216 00384 ELSE 00385 C 00386 C L'ARTICLE TROUVE EST CERTES TROP COURT, MAIS IL EST EN PLUS EN FIN 00387 C DE PAGE D'INDEX... 00388 C 00389 DO 213 J=2,INPPIM 00390 IRGPI=LFI%MRGPIM(J,IRANG) 00391 C 00392 IF (LFI%MRGPIF(IRGPI).EQ.(IRGPIF+1)) THEN 00393 C 00394 IRPIMS=IRGPI 00395 C 00396 IF (.NOT.LFI%LPHASP(IRPIMS)) THEN 00397 C 00398 CALL LFIPHA_MT (LFI, KREP,IRANG,IRPIMS,IRETIN) 00399 C 00400 IF (IRETIN.EQ.1) THEN 00401 GOTO 903 00402 ELSEIF (IRETIN.EQ.2) THEN 00403 GOTO 904 00404 ELSEIF (IRETIN.NE.0) THEN 00405 GOTO 1001 00406 ENDIF 00407 C 00408 ENDIF 00409 C 00410 GOTO 215 00411 C 00412 ENDIF 00413 C 00414 213 CONTINUE 00415 C 00416 C LA P.A.I. SUIVANTE (EN RANG DANS LE FICHIER) N'EST PAS 00417 C EN MEMOIRE; DECIDEMENT, CELA SE GATE ! ... ON L'Y MET. 00418 C 00419 C Noter que ce cas de figure ne peut se presenter q'une 00420 C seule fois par exploration de l'index. 00421 C 00422 INPILE=2 00423 CALL LFIPIM_MT (LFI, KREP,IRANG,IRNGMS,IRPIMS,IRGPIF+1,IRGPIF, 00424 S INPILE, IRETIN) 00425 C 00426 IF (IRETIN.EQ.1) THEN 00427 GOTO 903 00428 ELSEIF (IRETIN.EQ.2) THEN 00429 GOTO 904 00430 ELSEIF (IRETIN.NE.0) THEN 00431 GOTO 1001 00432 ENDIF 00433 C 00434 IF (INPAGE.LE.INPPIM) THEN 00435 C 00436 C On est dans le cadre d'une exploration "en memoire"... 00437 C 00438 IF (IRNGMS.GT.INPPIM) THEN 00439 C 00440 C ... et il y aura une P.P.I. a explorer en plus, 00441 C a la fin du balayage "en memoire". 00442 C 00443 INPPI1=INPPI1+1 00444 ELSEIF (IRNGMS.LT.INPAGE) THEN 00445 C 00446 C ... et il y aura une P.P.I. a explorer en plus, 00447 C mais apres le balayage "en memoire". 00448 C 00449 IRNGSU=IRNGMS 00450 ENDIF 00451 C 00452 ENDIF 00453 C 00454 INPPIM=MAX0 (INPPIM,IRNGMS) 00455 C 00456 215 CONTINUE 00457 C 00458 C LA PAIRE D'ARTICLES D'INDEX SUIVANTE EST EN MEMOIRE. 00459 C 00460 ILSUIV=LFI%MLGPOS(IXM(1,IRPIMS)) 00461 IPOSUI=LFI%MLGPOS(IXM(2,IRPIMS)) 00462 KLONUT=IPOSUI-IPOSEX 00463 C 00464 IF (KLONG.LE.KLONUT) THEN 00465 C 00466 C ... ET IL Y A UN "TROU" SUFFISANT AVANT CETTE PAIRE POUR POUVOIR 00467 C ECRIRE LES DONNEES EXCEDENTAIRES. 00468 C 00469 KRPIEC=IRGPIF 00470 KARTEC=IARTIC 00471 KPOSEC=IPOSEX 00472 GOTO 240 00473 C 00474 ELSEIF (LFI%CNOMAR(IXC(1,IRPIMS)).EQ.' ' 00475 S .AND.KLONG.LE.(KLONUT+ILSUIV)) THEN 00476 C 00477 C ... ET C'EST UN TROU QUI PERMET, AVEC L'AIDE EVENTUELLE 00478 C D'UNE ZONE DE DONNEES "MORTE" ENTRE LES 2 ARTICLES, 00479 C DE MENAGER UNE PLACE SUFFISANTE POUR L'EXCES DE DONNEES. 00480 C 00481 LFI%MLGPOS(IXM(1,IRPIMS))=IPOSUI+ILSUIV-(IPOSDX+1) 00482 LFI%MLGPOS(IXM(2,IRPIMS))=IPOSDX+1 00483 LFI%LECRPI(IRPIMS,2)=.TRUE. 00484 KRPIEC=IRGPIF 00485 KARTEC=IARTIC 00486 KPOSEC=IPOSEX 00487 C 00488 IF (LFI%MLGPOS(IXM(1,IRPIMS)).EQ.0) THEN 00489 GOTO 230 00490 ELSE 00491 GOTO 240 00492 ENDIF 00493 C 00494 ENDIF 00495 C 00496 C SI ON ARRIVE ICI, IL FAUT PASSER A LA PAGE SUIVANTE . 00497 C 00498 ENDIF 00499 C 00500 ENDIF 00501 C 00502 216 CONTINUE 00503 C 00504 C RECHERCHE EVENTUELLE DE TROUS D'INDEX DE LONGUEUR ADEQUATE. 00505 C 00506 IF (LLTTRU.OR.LLTOPT) THEN 00507 C 00508 IF (.NOT.LLRCHA) THEN 00509 GOTO 240 00510 ELSE 00511 GOTO 229 00512 ENDIF 00513 C 00514 ELSE 00515 INTRPI=0 00516 C 00517 DO 217 J=1,INALPI 00518 C 00519 IF (LFI%CNOMAR(IXC(J,IRGPIM)).EQ.' ') THEN 00520 INTRPI=INTRPI+1 00521 INDICE(INTRPI)=J 00522 ENDIF 00523 C 00524 217 CONTINUE 00525 C 00526 ENDIF 00527 C 00528 IF (INTRPI.NE.0) THEN 00529 C 00530 IF (.NOT.LFI%LPHASP(IRGPIM)) THEN 00531 C 00532 CALL LFIPHA_MT (LFI, KREP,IRANG,IRGPIM,IRETIN) 00533 C 00534 IF (IRETIN.EQ.1) THEN 00535 GOTO 903 00536 ELSEIF (IRETIN.EQ.2) THEN 00537 GOTO 904 00538 ELSEIF (IRETIN.NE.0) THEN 00539 GOTO 1001 00540 ENDIF 00541 C 00542 ENDIF 00543 C 00544 DO 218 J=1,INTRPI 00545 IARTIC=INDICE(J) 00546 ILTROU=LFI%MLGPOS(IXM(2*IARTIC-1,IRGPIM)) 00547 IPTROU=LFI%MLGPOS(IXM(2*IARTIC,IRGPIM)) 00548 C 00549 IF (ILTROU.GE.KLONG) THEN 00550 C 00551 C "TROU" D'INDEX DE LONGUEUR SUFFISANTE POUR L'ARTICLE. 00552 C 00553 IF (.NOT.LLTSUF) THEN 00554 LLTSUF=.TRUE. 00555 ILTSUF=ILTROU+1 00556 ENDIF 00557 C 00558 IF (ILTROU.LT.ILTSUF) THEN 00559 ILTSUF=ILTROU 00560 IRPITR=IRGPIF 00561 IARTTR=IARTIC 00562 IPOSTR=IPTROU 00563 ENDIF 00564 C 00565 LLTOPT=ILTSUF.EQ.KLONG 00566 ENDIF 00567 C 00568 218 CONTINUE 00569 C 00570 INTROU=INTROU+INTRPI 00571 LLTTRU=INTROU.EQ.INTTRU 00572 ENDIF 00573 C 00574 C SI L'ARTICLE A ETE TROUVE PRECEDEMMENT DANS LE FICHIER MAIS TROP 00575 C COURT, ET SI ON A EXPLORE TOUS LES TROUS REFERENCES DANS L'INDEX, 00576 C ON ARRETE L'EXPLORATION DE L'INDEX. 00577 C 00578 IF (LLTTRU.AND.KARTEX.NE.0) GOTO 240 00579 C 00580 C .... FIN DE "BOUCLE", ON REMONTE POUR UNE EVENTUELLE SUITE ... 00581 C 00582 229 CONTINUE 00583 INPAGE=INPAGE+1 00584 C 00585 IF (INPAGE.LE.INTPPI) THEN 00586 GOTO 201 00587 ELSE 00588 GOTO 240 00589 ENDIF 00590 C 00591 230 CONTINUE 00592 C* 00593 C 2.3 - CAS OU L'ON A CREE UN TROU DE LONGUEUR NULLE DANS L'INDEX 00594 C ON STOCKE DE QUOI S'EN OCCUPER PLUS TARD, A LA FERMETURE. 00595 C----------------------------------------------------------------------- 00596 C 00597 IF (LFI%NTRULZ(IRANG).EQ.0) THEN 00598 LFI%NRFPTZ(IRANG)=IPOSEX 00599 LFI%NRFDTZ(IRANG)=IPOSEX 00600 ELSE 00601 LFI%NRFPTZ(IRANG)=MIN0 (LFI%NRFPTZ(IRANG),IPOSEX) 00602 LFI%NRFDTZ(IRANG)=MAX0 (LFI%NRFDTZ(IRANG),IPOSEX) 00603 ENDIF 00604 C 00605 LFI%NTRULZ(IRANG)=LFI%NTRULZ(IRANG)+1 00606 C 00607 240 CONTINUE 00608 IF (LFI%LMISOP) 00609 S WRITE (UNIT=LFI%NULOUT,FMT=*)'LFIREE - APRES ETIQUETTE 240' 00610 C* 00611 C 2.4 - CALCUL DE LA VARIATION DU NOMBRE DE TROUS REFERENCES 00612 C DANS L'INDEX. 00613 C----------------------------------------------------------------------- 00614 C 00615 IF (KARTEX.NE.0.AND.KARTEC.EQ.0.AND..NOT.LLTSUF) THEN 00616 KDTROU=1 00617 ELSEIF (KARTEX.EQ.0.AND.LLTSUF) THEN 00618 KDTROU=-1 00619 ELSE 00620 KDTROU=0 00621 ENDIF 00622 C* 00623 C 2.5 - QUAND AUCUN EMPLACEMENT CONVENABLE N'A ETE TROUVE, 00624 C IL RESTE A DEFINIR LE RANG DE L'ARTICLE DANS LE FICHIER, 00625 C AINSI QUE LA POSITION DU PREMIER MOT DE DONNEES A ECRIRE. 00626 C----------------------------------------------------------------------- 00627 C 00628 IF (KARTEC.EQ.0) THEN 00629 C 00630 IF (LLTSUF) THEN 00631 KRPIEC=IRPITR 00632 KARTEC=IARTTR 00633 KPOSEC=IPOSTR 00634 ELSE 00635 KRPIEC=1+INBALO/INALPP 00636 KARTEC=INBALO+1-INALPP*(KRPIEC-1) 00637 C 00638 IF (LFI%NALDPI(IRANG).EQ.INALPP 00639 S .AND.INTPPI.EQ.(INBPIR+ILARPH-LFI%JPLDOC)) THEN 00640 KREP=-17 00641 GOTO 1001 00642 ENDIF 00643 C 00644 C DEFINITION DE LA POSITION OU ECRIRE, DANS LE CAS D'UN ARTICLE 00645 C LOGIQUE SUPPLEMENTAIRE. 00646 C 00647 IF (INBALO.EQ.0) THEN 00648 KPOSEC=(1+2*INBPIR)*ILARPH+1 00649 ELSE 00650 IRPIMD=LFI%MRGPIM(LFI%NPODPI(IRANG),IRANG) 00651 INALDP=LFI%NALDPI(IRANG) 00652 KPOSEC=LFI%MLGPOS(IXM(2*INALDP,IRPIMD)) 00653 S +LFI%MLGPOS(IXM(2*INALDP-1,IRPIMD)) 00654 C 00655 IF (INTPPI.GT.INBPIR) THEN 00656 IRPIFD=LFI%MDES1D(IXM(ILARPH+1-(INTPPI-INBPIR),IRANG))+1 00657 KPOSEC=MAX0 (KPOSEC,1+ILARPH*IRPIFD) 00658 ENDIF 00659 C 00660 ENDIF 00661 C 00662 ENDIF 00663 C 00664 ENDIF 00665 C 00666 GOTO 1001 00667 C** 00668 C 9. - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S. 00669 C AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF. 00670 C----------------------------------------------------------------------- 00671 C 00672 903 CONTINUE 00673 IRETOU=1 00674 CLACTI='WRITE' 00675 GOTO 909 00676 C 00677 904 CONTINUE 00678 IRETOU=2 00679 CLACTI='READ' 00680 C 00681 909 CONTINUE 00682 KREP=IABS (KREP) 00683 C** 00684 C 10. - PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE, 00685 C VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR. 00686 C----------------------------------------------------------------------- 00687 C 00688 1001 CONTINUE 00689 LLFATA=LLMOER (KREP,KRANG) 00690 C 00691 IF (KREP.EQ.0) THEN 00692 KRETIN=0 00693 ELSEIF (KREP.GT.0) THEN 00694 KRETIN=IRETOU 00695 ELSE 00696 KRETIN=3 00697 ENDIF 00698 C 00699 IF (LFI%LMISOP.OR.LLFATA) THEN 00700 INIMES=2 00701 CLNSPR='LFIREE' 00702 WRITE (UNIT=CLMESS, 00703 S FMT='(''ARGUMENTS='',I4,'','',I3,'',''''' 00704 ', S A,'''''','',I7,'','',I4,'','',I4,'','',I7,'','',I4,'',' 00705 ', S I4,'','',I9,'','',SP,I2,SS,'','',I7,'','',I2)') 00706 S KREP,KRANG,CDNOMA,KLONG,KRPIEX,KARTEX,KLONEX, 00707 S KRPIEC,KARTEC,KPOSEC,KDTROU,KLONUT,KRETIN 00708 INUMER=LFI%NUMERO(KRANG) 00709 CALL LFIEMS_MT (LFI, INUMER,INIMES,KREP,.FALSE., 00710 S CLMESS,CLNSPR,CLACTI) 00711 ENDIF 00712 C 00713 IF (LHOOK) CALL DR_HOOK('LFIREE_MT',1,ZHOOK_HANDLE) 00714 END 00715
1.8.0
