|
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 LFILAF_MT (LFI, KREP, KNUMER, LDTOUT ) 00003 USE LFIMOD, ONLY : LFICOM 00004 USE PARKIND1, ONLY : JPRB 00005 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00006 C**** 00007 C Sous-programme donnant, pour une unite logique ouverte au sens 00008 C du logiciel de fichiers indexes *LFI*, la Liste des Articles logi- 00009 C ques de donnees presents dans le Fichier, liste donnee toutefois 00010 C dans l'ordre PHYSIQUE ou ceux-ci figurent dans le fichier. 00011 C Sur option on donne aussi des renseignements sur les articles 00012 C (physiques) de gestion propres au logiciel, ainsi que sur les 00013 C trous repertories dans l'index. 00014 C** 00015 C Arguments : KREP (Sortie) ==> Code-reponse du sous-programme; 00016 C KNUMER (Entree) ==> Numero de l'unite logique; 00017 C LDTOUT (Entree) ==> Vrai si on doit donner les rensei- 00018 C gnements optionnels (qui ne concer- 00019 C nent pas directement les articles 00020 C logiques de donnees). 00021 C 00022 #ifndef f77 00023 #include "precision.h" 00024 #endif 00025 C 00026 TYPE(LFICOM) :: LFI 00027 INTEGER KREP, KNUMER, IMDESC, IREP, IRANG, INTROU, INBPIR, INBALO 00028 INTEGER INALDO, IFACTM, ILARPH, INALPP, INTPPI, INPPIM, INIMES, J 00029 INTEGER INAGES, IRESER, INUTIL, IPERTE, IPOSFI, IPOSDE, INEXCE 00030 INTEGER INABAL, INALDI, INTROI, INPIMD, INPIMF, INPILE, JRGPIF 00031 INTEGER IRGPFS, IRGPIM, IRANGM, IRPIMS, INALPI, ILONGA, IRECPI 00032 INTEGER IDERPU, IREC, IRETIN 00033 C 00034 LOGICAL LDTOUT 00035 C 00036 #include "lficom2.h" 00037 #include "lficom_mt.h" 00038 C** 00039 C 1. - CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS. 00040 C----------------------------------------------------------------------- 00041 C 00042 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00043 IF (LHOOK) CALL DR_HOOK('LFILAF_MT',0,ZHOOK_HANDLE) 00044 IREP=0 00045 IRANG=0 00046 CLNSPR='LFILAF' 00047 CALL LFINUM_MT (LFI, KNUMER,IRANG) 00048 C 00049 IF (IRANG.EQ.0) THEN 00050 IREP=-1 00051 GOTO 1001 00052 ENDIF 00053 C 00054 IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'ON') 00055 INTROU=LFI%MDES1D(IXM(LFI%JPNTRU,IRANG))+LFI%NBTROU(IRANG) 00056 INBPIR=LFI%MDES1D(IXM(LFI%JPNPIR,IRANG)) 00057 INBALO=LFI%MDES1D(IXM(LFI%JPNALO,IRANG)) 00058 INALDO=INBALO-INTROU 00059 IFACTM=LFI%MFACTM(IRANG) 00060 ILARPH=LFI%JPLARD*IFACTM 00061 INALPP=LFI%JPNAPP*IFACTM 00062 INTPPI=(INBALO-1+INALPP)/INALPP 00063 INPPIM=LFI%NPPIMM(IRANG) 00064 C 00065 C Envoi d'une banniere. 00066 C 00067 WRITE (UNIT=LFI%NULOUT,FMT='(///)') 00068 C 00069 IF (LFI%LFRANC) THEN 00070 WRITE (UNIT=CLMESS, 00071 S FMT='(''Catalogue de l''''Unite Logique LFI' 00072 ' S ,I3,'' dans l''''ordre *PHYSIQUE* (sequentiel) des articles'')') 00073 S KNUMER 00074 ELSE 00075 WRITE (UNIT=CLMESS,FMT='(''Catalog of LFI Logical Unit' 00076 ',I3, S '' in *PHYSICAL* (sequential) record order'')') KNUMER 00077 ENDIF 00078 C 00079 INIMES=2 00080 LLFATA=.FALSE. 00081 CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA, 00082 S CLMESS,CLNSPR,CLACTI) 00083 C** 00084 C 2. - SUR OPTION, RENSEIGNEMENTS SUR LES ARTICLES "DE GESTION". 00085 C (ARTICLE DOCUMENTAIRE, PAIRES D'ARTICLES D'INDEX) 00086 C----------------------------------------------------------------------- 00087 C 00088 IF (LDTOUT) THEN 00089 INAGES=1+2*INBPIR 00090 IRESER=ILARPH*INAGES 00091 C 00092 IF (LFI%LFRANC) THEN 00093 WRITE (UNIT=LFI%NULOUT,FMT= 00094 '(//,TR1,I6, S '' article(s) "physique(s)" de gestion,' 00095 ',I6, S '' mots chacun, occupant donc'',I7,'' mots; detail:' 00096 ', S /,TR10,''Article documentaire de la position 1 a' 00097 ',I6,/,TR10,I6, S'' paire(s) d''''articles d''''index prereserves, de la position' 00098 ' S ,I6,'' a'',I7)') 00099 S INAGES,ILARPH,IRESER,ILARPH,INBPIR,ILARPH+1,IRESER 00100 ELSE 00101 WRITE (UNIT=LFI%NULOUT,FMT= 00102 '(//,TR1,I6, S '' "physical" records for file handling,' 00103 ',I6, S '' words each, occupying then'',I7,'' words; detail:' 00104 ', S /,TR10,''Documentary record from position 1 to' 00105 ',I6,/,TR10,I6, S'' pair(s) of pre-reserved index records, from position' 00106 ' S ,I6,'' to'',I7)') 00107 S INAGES,ILARPH,IRESER,ILARPH,INBPIR,ILARPH+1,IRESER 00108 ENDIF 00109 C 00110 IF (INTPPI.LT.INBPIR) THEN 00111 INUTIL=INBPIR-INTPPI 00112 IPERTE=ILARPH*INUTIL*2 00113 C 00114 IF (LFI%LFRANC) THEN 00115 WRITE (UNIT=LFI%NULOUT, 00116 S FMT='(/,TR10,5(''=''),''> Il y a' 00117 ',I3, S '' paire(s) d''''articles d''''index inutilises, representant' 00118 ', S I8,'' mots'')') INUTIL,IPERTE 00119 ELSE 00120 WRITE (UNIT=LFI%NULOUT, 00121 S FMT='(/,TR10,5(''=''),''> There is (are)' 00122 ',I3, S '' pair(s) of unused index records, leading to a loss of' 00123 ', S I8,'' words'')') INUTIL,IPERTE 00124 ENDIF 00125 C 00126 ELSEIF (INTPPI.EQ.INBPIR) THEN 00127 C 00128 IF (LFI%LFRANC) THEN 00129 WRITE (UNIT=LFI%NULOUT, 00130 S FMT='(TR15,5(''-''),TR3,''pas de paire ' 00131 ', S ''d''''articles d''''index inutilises ni excedentaires' 00132 ', S TR3,5(''-''))') 00133 ELSE 00134 WRITE (UNIT=LFI%NULOUT, 00135 S FMT='(TR15,5(''-''),TR3,''no pair of ' 00136 ', S ''unused or overflow pages' 00137 ', S TR3,5(''-''))') 00138 ENDIF 00139 C 00140 ELSEIF (INTPPI.EQ.(INBPIR+1)) THEN 00141 IPOSFI=ILARPH*(LFI%MDES1D(IXM(ILARPH,IRANG))+1) 00142 IPOSDE=IPOSFI-2*ILARPH+1 00143 C 00144 IF (LFI%LFRANC) THEN 00145 WRITE (UNIT=LFI%NULOUT, 00146 S FMT='(TR10,''une paire d''''articles ' 00147 ', S ''d''''index excedentaires, de la position' 00148 ', S I9,'' a'',I9)') 00149 S IPOSDE,IPOSFI 00150 ELSE 00151 WRITE (UNIT=LFI%NULOUT, 00152 S FMT='(TR10,''one pair of overflow index ' 00153 ', S ''pages ,from position' 00154 ', S I9,'' to'',I9)') 00155 S IPOSDE,IPOSFI 00156 ENDIF 00157 C 00158 ELSE 00159 INEXCE=INTPPI-INBPIR 00160 C 00161 IF (LFI%LFRANC) THEN 00162 WRITE (UNIT=LFI%NULOUT, 00163 S FMT='(TR10,I6,'' paires d''''articles ' 00164 ', S ''d''''index excedentaires, des positions:'')') INEXCE 00165 C 00166 DO 201 J=1,INEXCE 00167 IPOSFI=ILARPH*(LFI%MDES1D(IXM(ILARPH+1-J,IRANG))+1) 00168 IPOSDE=IPOSFI-2*ILARPH+1 00169 WRITE (UNIT=LFI%NULOUT,FMT='(TR20,I9,'' a'',I9)') 00170 S IPOSDE,IPOSFI 00171 201 CONTINUE 00172 C 00173 ELSE 00174 WRITE (UNIT=LFI%NULOUT, 00175 S FMT='(TR10,I6,'' pairs of overflow index ' 00176 ', S ''pages, from positions:'')') INEXCE 00177 C 00178 DO 202 J=1,INEXCE 00179 IPOSFI=ILARPH*(LFI%MDES1D(IXM(ILARPH+1-J,IRANG))+1) 00180 IPOSDE=IPOSFI-2*ILARPH+1 00181 WRITE (UNIT=LFI%NULOUT,FMT='(TR20,I9,'' to'',I9)') 00182 S IPOSDE,IPOSFI 00183 202 CONTINUE 00184 C 00185 ENDIF 00186 C 00187 ENDIF 00188 C 00189 ENDIF 00190 C 00191 WRITE (UNIT=LFI%NULOUT,FMT='(//)') 00192 C** 00193 C 3. - RENSEIGNEMENTS INDIVIDUALISES SUR LES ARTICLES LOGIQUES. 00194 C (DONNEES, ET SUR OPTION TROUS REPERTORIES DANS L'INDEX) 00195 C----------------------------------------------------------------------- 00196 C 00197 IF (LFI%LFRANC) THEN 00198 C 00199 IF (INBALO.EQ.0) THEN 00200 WRITE (UNIT=LFI%NULOUT, 00201 S FMT='(/,TR10,5(''=''),''> L''''unite logique' 00202 ', S I3,'' ne contient AUCUN ARTICLE LOGIQUE (ni donnees, ni trous)' 00203 ', S //)') KNUMER 00204 GOTO 1001 00205 ELSEIF (INBALO.EQ.INTROU) THEN 00206 WRITE (UNIT=LFI%NULOUT, 00207 S FMT='(/,TR10,5(''=''),''> L''''unite logique' 00208 ', S I3,'' ne contient QUE DES TROUS, pas de donnees)'',//)') KNUMER 00209 IF (.NOT.LDTOUT) GOTO 1001 00210 ENDIF 00211 C 00212 ELSE 00213 C 00214 IF (INBALO.EQ.0) THEN 00215 WRITE (UNIT=LFI%NULOUT, 00216 S FMT='(/,TR10,5(''=''),''> The logical unit' 00217 ',I3, S '' contains NO LOGICAL RECORD AT ALL (neither data, nor holes)' 00218 ', S //)') KNUMER 00219 GOTO 1001 00220 ELSEIF (INBALO.EQ.INTROU) THEN 00221 WRITE (UNIT=LFI%NULOUT, 00222 S FMT='(/,TR10,5(''=''),''> The logical unit' 00223 ',I3, S '' contains ONLY HOLES, no dat)'',//)') KNUMER 00224 IF (.NOT.LDTOUT) GOTO 1001 00225 ENDIF 00226 C 00227 ENDIF 00228 C* 00229 C 3.1 - BALAYAGE DES PAIRES D'ARTICLES D'INDEX, PAR ORDRE CROISSANT 00230 C----------------------------------------------------------------------- 00231 C 00232 INABAL=0 00233 INALDI=0 00234 INTROI=0 00235 INPIMD=2 00236 INPIMF=INPPIM 00237 IF (LFI%NPODPI(IRANG).EQ.2) INPIMD=3 00238 IF (LFI%NPODPI(IRANG).EQ.INPPIM) INPIMF=INPPIM-1 00239 INPILE=2 00240 C 00241 DO 319 JRGPIF=1,INTPPI 00242 IRGPFS=JRGPIF+1 00243 C 00244 C On fait en sorte que la P.A.I. concernee, ainsi que sa suivante 00245 C eventuelle, soient toutes les deux en memoire. 00246 C 00247 IF (JRGPIF.EQ.INTPPI) THEN 00248 IRGPIM=LFI%MRGPIM(LFI%NPODPI(IRANG),IRANG) 00249 GOTO 314 00250 C 00251 ELSEIF (JRGPIF.NE.1) THEN 00252 C 00253 C Recherche de la P.A.I. dans les Paires de Pages d'Index memoire. 00254 C 00255 DO 311 J=INPIMD,INPIMF 00256 IRGPIM=LFI%MRGPIM(J,IRANG) 00257 C 00258 IF (LFI%MRGPIF(IRGPIM).EQ.JRGPIF) THEN 00259 C 00260 IF (.NOT.LFI%LPHASP(IRGPIM)) THEN 00261 C 00262 CALL LFIPHA_MT (LFI, IREP,IRANG,IRGPIM,IRETIN) 00263 C 00264 IF (IRETIN.EQ.1) THEN 00265 GOTO 903 00266 ELSEIF (IRETIN.EQ.2) THEN 00267 GOTO 904 00268 ELSEIF (IRETIN.NE.0) THEN 00269 GOTO 1001 00270 ENDIF 00271 C 00272 ENDIF 00273 C 00274 GOTO 312 00275 C 00276 ENDIF 00277 C 00278 311 CONTINUE 00279 C 00280 C Mise en memoire de la Paire d'Articles d'Index cherchee. 00281 C 00282 CALL LFIPIM_MT (LFI, IREP,IRANG,IRANGM,IRGPIM,JRGPIF,IRGPFS, 00283 S INPILE,IRETIN) 00284 C 00285 IF (IRETIN.EQ.1) THEN 00286 GOTO 903 00287 ELSEIF (IRETIN.EQ.2) THEN 00288 GOTO 904 00289 ELSEIF (IRETIN.NE.0) THEN 00290 GOTO 1001 00291 ELSEIF (IRANGM.GT.INPPIM) THEN 00292 INPPIM=IRANGM 00293 INPIMF=INPPIM 00294 ENDIF 00295 C 00296 ELSE 00297 IRGPIM=LFI%MRGPIM(1,IRANG) 00298 C 00299 ENDIF 00300 C 00301 312 CONTINUE 00302 C 00303 IF (IRGPFS.EQ.INTPPI) THEN 00304 IRPIMS=LFI%MRGPIM(LFI%NPODPI(IRANG),IRANG) 00305 C 00306 ELSE 00307 C 00308 C Recherche de la P.A.I. dans les Paires de Pages d'Index memoire. 00309 C 00310 DO 313 J=INPIMD,INPIMF 00311 IRPIMS=LFI%MRGPIM(J,IRANG) 00312 C 00313 IF (LFI%MRGPIF(IRPIMS).EQ.IRGPFS) THEN 00314 C 00315 IF (.NOT.LFI%LPHASP(IRPIMS)) THEN 00316 C 00317 CALL LFIPHA_MT (LFI, IREP,IRANG,IRPIMS,IRETIN) 00318 C 00319 IF (IRETIN.EQ.1) THEN 00320 GOTO 903 00321 ELSEIF (IRETIN.EQ.2) THEN 00322 GOTO 904 00323 ELSEIF (IRETIN.NE.0) THEN 00324 GOTO 1001 00325 ENDIF 00326 C 00327 ENDIF 00328 C 00329 GOTO 314 00330 C 00331 ENDIF 00332 C 00333 313 CONTINUE 00334 C 00335 C Mise en memoire de la Paire d'Articles d'Index cherchee. 00336 C 00337 CALL LFIPIM_MT (LFI, IREP,IRANG,IRANGM,IRPIMS,IRGPFS,JRGPIF, 00338 S INPILE,IRETIN) 00339 C 00340 IF (IRETIN.EQ.1) THEN 00341 GOTO 903 00342 ELSEIF (IRETIN.EQ.2) THEN 00343 GOTO 904 00344 ELSEIF (IRETIN.NE.0) THEN 00345 GOTO 1001 00346 ELSEIF (IRANGM.GT.INPPIM) THEN 00347 INPPIM=IRANGM 00348 INPIMF=INPPIM 00349 ENDIF 00350 C 00351 ENDIF 00352 C 00353 314 CONTINUE 00354 INALPI=MIN0 (INALPP,INBALO-INABAL) 00355 C 00356 C Balayage de la Paire d'Article d'Index concernee. 00357 C 00358 DO 318 J=1,INALPI 00359 C 00360 IF (LFI%CNOMAR(IXC(J,IRGPIM)).NE.' ') THEN 00361 C 00362 C Il s'agit d'un article logique de donnees; en plus de ses 00363 C caracteristiques tabulees, on verifie s'il n'y a pas de la 00364 C place "perdue" juste derriere les donnees, place recuperable 00365 C eventuellement en cas de reecriture plus longue de l'article 00366 C logique. 00367 C 00368 INALDI=INALDI+1 00369 ILONGA=LFI%MLGPOS(IXM(2*J-1,IRGPIM)) 00370 IPOSDE=LFI%MLGPOS(IXM(2*J ,IRGPIM)) 00371 IPOSFI=IPOSDE+ILONGA-1 00372 C 00373 IF (J.EQ.1.AND.JRGPIF.GT.INBPIR) THEN 00374 C 00375 C Cas du premier article logique d'une P.A.I. excedentaire; 00376 C dans ce cas, la P.A.I. est situee derriere l'article logique, 00377 C en occupant deux articles physiques. 00378 C 00379 IRECPI=LFI%MDES1D(IXM(ILARPH+1-(JRGPIF-INBPIR),IRANG)) 00380 IDERPU=ILARPH*(IRECPI-1) 00381 C 00382 ELSEIF (J.EQ.INALPI.AND.JRGPIF.EQ.INTPPI) THEN 00383 C 00384 C Cas du dernier article logique du fichier, sans P.A.I. situee 00385 C derriere: la derniere position utilisable sans modifier le nombre 00386 C d'articles physiques du fichier correspond a la fin du dernier 00387 C article physique contenant des donnees, ou a la fin du dernier 00388 C article physique ecrit sur le fichier. 00389 C 00390 IMDESC=LFI%MDES1D(IXM(LFI%JPNAPH,IRANG)) 00391 IREC=MAX0 (1+(IPOSFI-1)/ILARPH,IMDESC) 00392 IDERPU=ILARPH*IREC 00393 C 00394 C Si on arrive au test ci-dessous, on est sur que l'article lo- 00395 C gique n'est pas le dernier du fichier. 00396 C 00397 ELSEIF (J.NE.INALPP) THEN 00398 C 00399 C Cas general, ou l'article logique n'est pas le dernier de sa 00400 C (Paire de) Page(s) d'Index. 00401 C 00402 IDERPU=LFI%MLGPOS(IXM(2*J+2,IRGPIM))-1 00403 C 00404 ELSE 00405 C 00406 C Cas particulier ou l'article logique est le dernier de sa 00407 C (Paire de) Page(s) d'Index. 00408 C 00409 IDERPU=LFI%MLGPOS(IXM(2,IRPIMS))-1 00410 ENDIF 00411 C 00412 IF (IDERPU.EQ.IPOSFI) THEN 00413 C 00414 IF (LFI%LFRANC) THEN 00415 WRITE (UNIT=LFI%NULOUT, 00416 S FMT='(I7,''-eme article de donnees: "' 00417 ',A, S ''",'',I7,'' mots, position'',I9,'' a'',I9)') 00418 S INALDI,LFI%CNOMAR(IXC(J,IRGPIM)),ILONGA,IPOSDE,IPOSFI 00419 ELSE 00420 WRITE (UNIT=LFI%NULOUT, 00421 S FMT='(I7,''-th data record: "'',A,''",' 00422 ',I7, S '' words, position'',I9,'' to'',I9)') 00423 S INALDI,LFI%CNOMAR(IXC(J,IRGPIM)),ILONGA,IPOSDE,IPOSFI 00424 ENDIF 00425 C 00426 ELSE 00427 C 00428 C On visualise en plus la place "perdue" derriere l'article. 00429 C 00430 IF (LFI%LFRANC) THEN 00431 WRITE (UNIT=LFI%NULOUT, 00432 S FMT='(I7,''-eme article de donnees: "' 00433 ',A, S ''",'',I7,'' mots, position'',I9,'' a'',I9,'' <' 00434 ',SP, S I8,'' >'')') 00435 S INALDI,LFI%CNOMAR(IXC(J,IRGPIM)),ILONGA,IPOSDE, 00436 S IPOSFI,IDERPU-IPOSFI 00437 ELSE 00438 WRITE (UNIT=LFI%NULOUT, 00439 S FMT='(I7,''-th data record: ''''' 00440 ',A, S '''''','',I7,'' words, position'',I9,'' to'',I9,'' <' 00441 ', S SP,I8,'' >'')') 00442 S INALDI,LFI%CNOMAR(IXC(J,IRGPIM)),ILONGA,IPOSDE, 00443 S IPOSFI,IDERPU-IPOSFI 00444 ENDIF 00445 C 00446 ENDIF 00447 C 00448 ELSEIF (LDTOUT) THEN 00449 INTROI=INTROI+1 00450 ILONGA=LFI%MLGPOS(IXM(2*J-1,IRGPIM)) 00451 IPOSDE=LFI%MLGPOS(IXM(2*J ,IRGPIM)) 00452 IPOSFI=IPOSDE+ILONGA-1 00453 C 00454 IF (LFI%LFRANC) THEN 00455 WRITE (UNIT=LFI%NULOUT,FMT='(TR1,5(''=''),''>' 00456 ',T10,I6, S ''-eme TROU repertorie dans l''''index, longueur reutilisable:' 00457 ', S I7,'' mots, position'',I9,'' a'',I9)') 00458 S INTROI,ILONGA,IPOSDE,IPOSFI 00459 ELSE 00460 WRITE (UNIT=LFI%NULOUT,FMT='(TR1,5(''=''),''>' 00461 ',T10,I6, S ''-th HOLE cataloged within index, re-usable length:' 00462 ', S I7,'' words, position'',I9,'' to'',I9)') 00463 S INTROI,ILONGA,IPOSDE,IPOSFI 00464 ENDIF 00465 C 00466 ENDIF 00467 C 00468 318 CONTINUE 00469 C 00470 INABAL=INABAL+INALPI 00471 319 CONTINUE 00472 C* 00473 C 3.2 - ENVOI DE MESSAGES RECAPITULATIFS. 00474 C----------------------------------------------------------------------- 00475 C 00476 IF (LFI%LFRANC) THEN 00477 C 00478 IF (LDTOUT) THEN 00479 WRITE (UNIT=LFI%NULOUT,FMT='(//,T5,8(''-' 00480 '),TR3,I7, S '' articles logiques de donnees et' 00481 ',I6, S '' trous repertories listes'',TR3,8(''-''),//)') 00482 S INALDI,INTROI 00483 ELSE 00484 WRITE (UNIT=LFI%NULOUT,FMT='(//,T5,8(''-' 00485 '),TR3,I7, S '' articles logiques de donnees listes'',TR3,8(''-''),//)') 00486 S INALDI 00487 ENDIF 00488 C 00489 ELSE 00490 C 00491 IF (LDTOUT) THEN 00492 WRITE (UNIT=LFI%NULOUT,FMT='(//,T5,8(''-' 00493 '),TR3,I7, S '' logical records of data and' 00494 ',I6, S '' holes within index listed'',TR3,8(''-''),//)') 00495 S INALDI,INTROI 00496 ELSE 00497 WRITE (UNIT=LFI%NULOUT,FMT='(//,T5,8(''-' 00498 '),TR3,I7, S '' logical records of data listed'',TR3,8(''-''),//)') 00499 S INALDI 00500 ENDIF 00501 C 00502 ENDIF 00503 C 00504 IF (INALDI.EQ.INALDO.AND.(.NOT.LDTOUT.OR.INTROI.EQ.INTROU)) THEN 00505 C 00506 IF (LFI%LFRANC) THEN 00507 WRITE (UNIT=CLMESS,FMT= 00508 S '(''Fin du catalogue de l''''Unite Logique'',I3,'' ---' 00509 ',I7, S '' Articles logiques en tout'')') KNUMER,INBALO 00510 ELSE 00511 WRITE (UNIT=CLMESS,FMT= 00512 S '(''End of catalog of Logical Unit'',I3,'' ---' 00513 ',I7, S '' logical Records for whole file'')') KNUMER,INBALO 00514 ENDIF 00515 C 00516 CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA, 00517 S CLMESS,CLNSPR,CLACTI) 00518 WRITE (UNIT=LFI%NULOUT,FMT='(///)') 00519 ELSE 00520 IREP=-16 00521 ENDIF 00522 C 00523 GOTO 1001 00524 C** 00525 C 9. - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S. 00526 C----------------------------------------------------------------------- 00527 C 00528 903 CONTINUE 00529 CLACTI='WRITE' 00530 GOTO 909 00531 C 00532 904 CONTINUE 00533 CLACTI='READ' 00534 C 00535 909 CONTINUE 00536 C 00537 C AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF. 00538 C 00539 IREP=IABS (IREP) 00540 C** 00541 C 10. - PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL, 00542 C VIA LE SOUS-PROGRAMME "LFIEMS" . 00543 C----------------------------------------------------------------------- 00544 C 00545 1001 CONTINUE 00546 KREP=IREP 00547 LLFATA=LLMOER (IREP,IRANG) 00548 C 00549 IF (IRANG.NE.0) THEN 00550 LFI%NDEROP(IRANG)=18 00551 LFI%NDERCO(IRANG)=IREP 00552 IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERRUE(IRANG),'OFF') 00553 ENDIF 00554 C 00555 IF (LLFATA.OR.IXNIMS (IRANG).EQ.2) THEN 00556 INIMES=2 00557 ELSE 00558 IF (LHOOK) CALL DR_HOOK('LFILAF_MT',1,ZHOOK_HANDLE) 00559 RETURN 00560 ENDIF 00561 C 00562 WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER=' 00563 ',I3, S '', LDTOUT= '',L1)') KREP,KNUMER,LDTOUT 00564 CALL LFIEMS_MT (LFI, KNUMER,INIMES,IREP,LLFATA, 00565 S CLMESS,CLNSPR,CLACTI) 00566 C 00567 IF (LHOOK) CALL DR_HOOK('LFILAF_MT',1,ZHOOK_HANDLE) 00568 END 00569
1.8.0
