|
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 LFIEFR_MT (LFI, KNUMER, KNIMES, KCODE, LDFATA, 00003 & CDMESS, CDNSPR, CDACTI ) 00004 USE LFIMOD, ONLY : LFICOM 00005 USE PARKIND1, ONLY : JPRB 00006 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00007 C**** 00008 C CE SOUS-PROGRAMME EST CHARGE DE FAIRE L'IMPRESSION DES MESSAGES 00009 C STANDARD EMIS PAR LE LOGICIEL DE FICHIERS INDEXES LFI, EN FAISANT 00010 C SI BESOIN EST L'"ABORT" DU PROGRAMME . 00011 C Les messages lies au mode "mise au point" sont emis directement 00012 C par les sous-programmes concernes. 00013 C 00014 C Ce sous-programme est la V.O. (Version Originale, francaise), 00015 C et est appele par le sous-programme "chapeau" LFIEMS. 00016 C Pour la version anglaise, voir LFIENG. 00017 C ( For english version see subroutine LFIENG ) 00018 C** 00019 C ARGUMENTS : KNUMER ==> Numero eventuel de l'Unite Logique; 00020 C ( tous ( si LFI%JPNIL ==> pas d'Unite Logique ) 00021 C d'Entree ) KNIMES ==> Niveau (0,1,2) du Message; 00022 C KCODE ==> Code correspondant a l'action en cause; 00023 C LDFATA ==> Vrai si on doit avorter le programme; 00024 C CDMESS ==> Si KNIMES#0, Message a emettre; 00025 C CDNSPR ==> Nom du sous-programme appelant LFIEMS; 00026 C CDACTI ==> Nom de l'action d'entree/sortie FORTRAN 00027 C si KCODE >0), sinon fourre-tout (!) . 00028 C* 00029 C !----------------------------------------------------------------! 00030 C ! TABLE DES VALEURS POSSIBLES DES CODES-REPONSES DU LOGICIEL LFI ! 00031 C !----------------------------------------------------------------! 00032 C 00033 C----------------------------------------------------------------------- 00034 C 0 ==> Aucune erreur n'a ete detectee, tout est OK. 00035 C----------------------------------------------------------------------- 00036 C valeur ==> Il s'agit (de la valeur absolue) du code-reponse FORTRAN 00037 C positive d'une instruction OPEN, READ, WRITE, CLOSE ou INQUIRE; pour 00038 C le sens exact voir le manuel de reference du constructeur. 00039 C----------------------------------------------------------------------- 00040 C -1 ==> Unite Logique non ouverte pour le logiciel. 00041 C----------------------------------------------------------------------- 00042 C -2 ==> Valeur d'un "NIVEAU" hors plage [0-2] . 00043 C----------------------------------------------------------------------- 00044 C -3 ==> Option de verrou erronee (s/p a usage interne "LFIVER") . 00045 C----------------------------------------------------------------------- 00046 C -4 ==> Changement explicite de mode Multi-Taches avec au moins une 00047 C unite logique ouverte-risque de problemes (s/p "LFIINI") . 00048 C----------------------------------------------------------------------- 00049 C -5 ==> Unite Logique deja ouverte (LFIOUV, LFIAFM, LFISFM) . 00050 C----------------------------------------------------------------------- 00051 C -6 ==> Pas assez de place dans les tables pour ouvrir l'Unite 00052 C Logique demandee (LFIOUV) . 00053 C----------------------------------------------------------------------- 00054 C -7 ==> Argument illicite de "STATUS" pour l'instruction FORTRAN 00055 C "OPEN" (LFIOUV) . 00056 C----------------------------------------------------------------------- 00057 C -8 ==> Incompatibilite entre "LDNOMM" et "CDSTTO" (LFIOUV) : 00058 C un fichier de "STATUS" 'OLD' ou 'NEW' doit etre nomme . 00059 C (CE CODE-REPONSE N'A PLUS DE SENS ACTUELLEMENT) 00060 C----------------------------------------------------------------------- 00061 C -9 ==> Incompatibilite entre le "STATUS" 'NEW' ou 'OLD' et (respe- 00062 C ctivement) l'existence ou non du fichier (LFIOUV) . 00063 C----------------------------------------------------------------------- 00064 C -10 ==> Le fichier considere n'est pas un fichier de type LFI, ou 00065 C ne peut pas etre traite par cette version du logiciel. 00066 C (LFIOUV) 00067 C----------------------------------------------------------------------- 00068 C -11 ==> Fichier non ferme apres une modification (LFIOUV): cette 00069 C erreur n'est pas fatale si "LDERFA" est .FALSE., mais alors 00070 C integrite et coherence des donnees ne sont pas garanties. 00071 C Noter qu'une fois qu'un fichier a ce type de probleme, ce 00072 C code-reponse restera meme apres modification ulterieure. 00073 C----------------------------------------------------------------------- 00074 C -12 ==> Fichier de "STATUS" 'OLD' mais erreur sur la lecture du 00075 C premier article physique du fichier (LFIOUV) . 00076 C----------------------------------------------------------------------- 00077 C -13 ==> Fichier deja ouvert pour une autre unite logique LFI. 00078 C (LFIOUV) 00079 C----------------------------------------------------------------------- 00080 C -14 ==> Argument d'appel de type ENTIER incorrect (souvent negatif) 00081 C----------------------------------------------------------------------- 00082 C -15 ==> Argument d'appel de type CARACTERE incorrect (longueur). 00083 C----------------------------------------------------------------------- 00084 C -16 ==> Incoherence Tables, Fichier, appels s/p internes, logiciel. 00085 C CETTE ERREUR NE PEUT PAS ETRE FILTREE. EST TOUJOURS FATALE. 00086 C----------------------------------------------------------------------- 00087 C -17 ==> Trop d'articles logiques sur le fichier pour un de plus. 00088 C (par articles logiques on entend ceux lisibles par l'utili- 00089 C sateur, mais aussi les trous reperes dans l'index... qui 00090 C sont crees lors de reecritures d'articles de donnees ne 00091 C pouvant se faire sur place, et lors de suppression d'arti- 00092 C cles; ces trous peuvent etre "recycles" - LFIECR) 00093 C----------------------------------------------------------------------- 00094 C -18 ==> Nom d'Article logique compose uniquement de BLANCS illicite 00095 C (pour le fonctionnement interne du logiciel LFI, 00096 C les trous d'index sont reperes par un nom d'article blanc) 00097 C----------------------------------------------------------------------- 00098 C -19 ==> Un fichier ouvert avec le "STATUS" 'SCRATCH' ne peut pas 00099 C etre conserve: "CDSTTC" a 'KEEP' est illicite (LFIFER) . 00100 C si cette erreur n'est pas fatale, alors on execute un 00101 C "CLOSE" FORTRAN sans parametre "STATUS", de la meme maniere 00102 C que lorsque "CDSTTC" n'est ni a 'KEEP' ni a 'DELETE'. 00103 C----------------------------------------------------------------------- 00104 C -20 ==> L'article logique demande n'existe pas dans le fichier. 00105 C (LFILEC, LFIREN, LFISUP) 00106 C----------------------------------------------------------------------- 00107 C -21 ==> L'article logique demande est PLUS LONG sur le fichier; 00108 C si cette erreur n'est pas fatale, le resultat est une 00109 C lecture PARTIELLE de l'article, a la longueur demandee. 00110 C (LFILAP, LFILAS, LFILEC) 00111 C----------------------------------------------------------------------- 00112 C -22 ==> L'article logique demande est PLUS COURT sur le fichier; 00113 C meme si cette erreur n'est pas fatale, AUCUNE LECTURE DE 00114 C DONNEES N'EST FAITE (LFILAP, LFILAS, LFILEC) . 00115 C----------------------------------------------------------------------- 00116 C -23 ==> Il n'y a pas ou plus d'article "SUIVANT" a lire (LFILAS) . 00117 C----------------------------------------------------------------------- 00118 C -24 ==> La variable caractere donnee en argument d'appel de sortie 00119 C est TROP COURTE pour y stocker le NOM de l'article, meme en 00120 C supprimant d'eventuels caracteres blancs en fin de nom. 00121 C (LFICAP, LFICAS, LFILAP, LFILAS) 00122 C----------------------------------------------------------------------- 00123 C -25 ==> Le nouveau nom de l'article logique est (deja) celui d'un 00124 C autre article logique du fichier (LFIREN). 00125 C----------------------------------------------------------------------- 00126 C -26 ==> Il n'y a pas ou plus d'article "PRECEDENT" a lire (LFILAP). 00127 C----------------------------------------------------------------------- 00128 C -27 ==> Espace CONTIGU insuffisant dans les tables pour gerer le 00129 C fichier "multiple" demande (LFIOUV) . 00130 C----------------------------------------------------------------------- 00131 C -28 ==> Facteur multiplicatif (de la longueur d'article physique 00132 C elementaire) trop grand pour la configuration du logiciel. 00133 C (LFIOUV, LFIAFM, LFIFMD) 00134 C----------------------------------------------------------------------- 00135 C -29 ==> Pas assez de place dans les tables pour definir le facteur 00136 C multiplicatif a associer a l'Unite Logique (LFIAFM) . 00137 C----------------------------------------------------------------------- 00138 C -30 ==> Numero d'Unite Logique FORTRAN illicite. 00139 C----------------------------------------------------------------------- 00140 C -31 ==> Numero d'Unite Logique sans facteur multiplicatif predefini 00141 C (LFISFM) 00142 C----------------------------------------------------------------------- 00143 C 00144 #ifndef f77 00145 USE SDL_MOD , ONLY : SDL_SRLABORT 00146 #endif 00147 #ifndef f77 00148 #include "precision.h" 00149 #endif 00150 C 00151 TYPE(LFICOM) :: LFI 00152 INTEGER KNUMER, KNIMES, KCODE, ILDMES, ILBLAN, INLNOM, INUMER 00153 INTEGER IDECBL, IPOSBL, ILACTI, ILACT2, ILNSPR, ILMESU, IJL, J, IJ 00154 INTEGER INBALO, ILMESA, INLIGN, IDECAL 00155 C 00156 LOGICAL LDFATA 00157 C 00158 CHARACTER CDNSPR*(*), CLJOLI*6, CDMESS*(*), CLMESA*80, CDACTI*(*) 00159 C 00160 #include "lficom2.h" 00161 #include "lficom_mt.h" 00162 C** 00163 C 1. - INITIALISATIONS. 00164 C----------------------------------------------------------------------- 00165 C 00166 C Recherche de la longueur "utile" de l'argument CDACTI. 00167 C (c'est-a-dire sans tenir compte des blancs terminaux eventuels) 00168 C 00169 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00170 IF (LHOOK) CALL DR_HOOK('LFIEFR_MT',0,ZHOOK_HANDLE) 00171 IDECBL=0 00172 C 00173 101 CONTINUE 00174 IPOSBL=IDECBL+INDEX (CDACTI(IDECBL+1:),' ') 00175 C 00176 IF (IPOSBL.LE.IDECBL) THEN 00177 ILACTI=LEN (CDACTI) 00178 ELSEIF (CDACTI(IPOSBL:).EQ.' ') THEN 00179 ILACTI=IPOSBL-1 00180 ELSE 00181 IDECBL=IPOSBL 00182 GOTO 101 00183 ENDIF 00184 C 00185 ILACT2=MIN0 (ILACTI,LFI%JPNCPN) 00186 ILACTI=MIN0 (ILACT2,8) 00187 ILNSPR=MIN0 (LEN (CDNSPR),LFI%JPLSPX) 00188 C 00189 C Prefixe (et eventuellement suffixe) pour le(s) message(s). 00190 C 00191 IF (LDFATA) THEN 00192 CLJOLI=' *****' 00193 ELSEIF (KNIMES.EQ.0.OR.KCODE.NE.0) THEN 00194 CLJOLI=' */*/*' 00195 ELSE 00196 CLJOLI=' /////' 00197 ENDIF 00198 C 00199 IF (KNIMES.NE.0) THEN 00200 C** 00201 C 2. - ON IMPRIME LE MESSAGE PREPARE PAR LE S/P APPELLANT LFIEMS. 00202 C----------------------------------------------------------------------- 00203 C 00204 ILMESU=MIN0 (LEN (CLMESS)-LEN (CLJOLI)-ILNSPR-4, 00205 S LEN (CDMESS)) 00206 CLMESS=CLJOLI//' '//CDNSPR(1:ILNSPR)//' - '// 00207 S CDMESS(1:ILMESU) 00208 WRITE (UNIT=LFI%NULOUT,FMT='(A)') CLMESS 00209 ENDIF 00210 C 00211 IF (KNIMES.EQ.0.OR.LDFATA) THEN 00212 C** 00213 C 3. - CONSTITUTION D'UN MESSAGE "AD HOC", EN FONCTION DE *KCODE*. 00214 C----------------------------------------------------------------------- 00215 C 00216 C En preambule, on cherche si l'unite logique concernee correspond 00217 C ou non a une unite logique ouverte pour le logiciel LFI. 00218 C 00219 IF (KNUMER.EQ.LFI%JPNIL) THEN 00220 IJL=0 00221 ELSE 00222 C 00223 DO 301 J=1,LFI%NBFIOU 00224 IJL=LFI%NUMIND(J) 00225 IF (KNUMER.EQ.LFI%NUMERO(IJL)) GOTO 302 00226 301 CONTINUE 00227 C 00228 IJL=0 00229 ENDIF 00230 C 00231 302 CONTINUE 00232 C 00233 IF (KCODE.GT.0) THEN 00234 C 00235 IF ((CDACTI.EQ.'READ'.OR.CDACTI.EQ.'WRITE') 00236 S .AND.LFI%NUMAPH(IJL).GT.0) THEN 00237 WRITE (UNIT=CLMESS,FMT='(''ERREUR "'',A,''"' 00238 ',I7, S '',UNITE'',I3,'',NUM.ART'',I6,'',*' 00239 ',I6, S '' MOTS'')') CDACTI(1:ILACTI),KCODE,KNUMER, 00240 S LFI%NUMAPH(IJL), 00241 S LFI%JPLARD*LFI%MFACTM(IJL) 00242 ELSE 00243 WRITE (UNIT=CLMESS, 00244 S FMT='(''ERREUR "'',A,''" FORTRAN, CODE=' 00245 ' S ,I7,'', UNITE='',I3)') CDACTI(1:ILACTI),KCODE,KNUMER 00246 ENDIF 00247 C 00248 ELSEIF (KCODE.EQ.-1) THEN 00249 WRITE (UNIT=CLMESS,FMT='(''UNITE LOGIQUE' 00250 ',I3, S '' NON OUVERTE POUR LE LOGICIEL LFI'')') KNUMER 00251 C 00252 ELSEIF (KCODE.EQ.-2) THEN 00253 C 00254 IF (KNUMER.EQ.LFI%JPNIL) THEN 00255 CLMESS='PARAMETRE DE NIVEAU "KNIVAU" HORS PLAGE [0-2]' 00256 ELSE 00257 WRITE (UNIT=CLMESS,FMT= 00258 S '(''NIVEAU DE MESSAGERIE HORS PLAGE [0-2], UNITE'',I3)') KNUMER 00259 ENDIF 00260 C 00261 ELSEIF (KCODE.EQ.-3) THEN 00262 ILDMES=MIN0 (8,LEN (CDMESS)) 00263 CLMESS='ACTION '''//CDMESS(1:ILDMES) 00264 S //''' INCONNUE SUR LES VERROUS' 00265 C 00266 ELSEIF (KCODE.EQ.-4) THEN 00267 CLMESS='CHANGEMENT MODE MULTI-TACHES AVEC ' 00268 S //'UNITE(S) OUVERTE(S)' 00269 C 00270 ELSEIF (KCODE.EQ.-5) THEN 00271 WRITE (UNIT=CLMESS,FMT='(''UNITE LOGIQUE' 00272 ',I3, S '' DEJA OUVERTE POUR LFI - NE DEVRAIT PAS.'')') KNUMER 00273 C 00274 ELSEIF (KCODE.EQ.-6) THEN 00275 WRITE (UNIT=CLMESS,FMT='(I3,'' ENTREES,' 00276 ', S '' PLUS ASSEZ DE PLACE DANS LES TABLES, UNITE'',I3)') 00277 S LFI%JPNXFI,KNUMER 00278 C 00279 ELSEIF (KCODE.EQ.-7) THEN 00280 WRITE (UNIT=CLMESS,FMT='(''STATUS FORTRAN ''''' 00281 ',A, S '''''' INCONNU, UNITE'',I3)') CDACTI(1:ILACTI),KNUMER 00282 C 00283 ELSEIF (KCODE.EQ.-8) THEN 00284 WRITE (UNIT=CLMESS, 00285 S FMT='(''L''''UNITE'',I3,'' DE STATUS ''''' 00286 ' S,A,'''''' DOIT AVOIR UN NOM EXPLICITE'')') KNUMER,CDACTI(1:ILACTI) 00287 C 00288 ELSEIF (KCODE.EQ.-9) THEN 00289 C 00290 IF (CDACTI.EQ.'OLD') THEN 00291 WRITE (UNIT=CLMESS,FMT= 00292 S'(''STATUS ''''OLD'''' MAIS LE FICHIER N''''EXISTE PAS, UNITE' 00293 ', S I3)') KNUMER 00294 ELSE 00295 ILBLAN=INDEX (CDACTI(1:ILACTI),' ') 00296 IF (ILBLAN.GT.1) ILACTI=ILBLAN-1 00297 WRITE (UNIT=CLMESS,FMT= 00298 S'(''STATUS '''''',A,'''''' MAIS LE FICHIER EXISTE DEJA, UNITE' 00299 ', S I3)') CDACTI(1:ILACTI),KNUMER 00300 ENDIF 00301 C 00302 ELSEIF (KCODE.EQ.-10) THEN 00303 WRITE (UNIT=CLMESS,FMT='(''INCOMPATIBILITE' 00304 ', S '' FICHIER / LOGICIEL, UNITE'',I3)') KNUMER 00305 C 00306 ELSEIF (KCODE.EQ.-11) THEN 00307 WRITE (UNIT=CLMESS, 00308 S FMT='(''UNITE'',I3,'' NON FERMEE APRES ' 00309 ', S ''LA DERNIERE MODIFICATION'')') KNUMER 00310 C 00311 ELSEIF (KCODE.EQ.-12) THEN 00312 WRITE (UNIT=CLMESS,FMT='(''UNITE' 00313 ',I3, S '' DE STATUS ''''OLD'''' - ERREUR LECTURE PREMIER ARTICLE'')') 00314 S KNUMER 00315 C 00316 ELSEIF (KCODE.EQ.-13) THEN 00317 INLNOM=1 00318 INUMER=LFI%JPNIL 00319 C 00320 DO 131 J=1,LFI%NBFIOU 00321 IJ=LFI%NUMIND(J) 00322 C 00323 IF (CDACTI.EQ.LFI%CNOMFI(IJ)) THEN 00324 INUMER=LFI%NUMERO(IJ) 00325 INLNOM=MIN0 (LFI%NLNOMF(IJ),LEN (CLMESS)-3) 00326 GOTO 132 00327 ENDIF 00328 C 00329 131 CONTINUE 00330 C 00331 132 CONTINUE 00332 CLMESS=' '''//CDACTI(1:INLNOM)//'''' 00333 WRITE (UNIT=LFI%NULOUT,FMT='(A)') CLMESS 00334 WRITE (UNIT=CLMESS,FMT='(''UNITE'',I3,'' - FICHIER ' 00335 ', S ''DEJA OUVERT POUR L''''UNITE'',I3)') KNUMER,INUMER 00336 C 00337 ELSEIF (KCODE.EQ.-14) THEN 00338 C 00339 IF (CDNSPR.EQ.'LFIECR'.OR.CDNSPR.EQ.'LFILEC'.OR. 00340 S CDNSPR.EQ.'LFILAS'.OR.CDNSPR.EQ.'LFILAP') THEN 00341 WRITE (UNIT=CLMESS,FMT= 00342 S '(''LONGUEUR D''''ARTICLE INCORRECTE, UNITE'',I3)') KNUMER 00343 ELSEIF (KNUMER.EQ.LFI%JPNIL) THEN 00344 CLMESS='RANG DANS LA TABLE *LFI%NUMERO* INCORRECT' 00345 ELSE 00346 WRITE (UNIT=CLMESS,FMT= 00347 S '(''ARGUMENT DE TYPE ENTIER INCORRECT, UNITE'',I3)') KNUMER 00348 ENDIF 00349 C 00350 ELSEIF (KCODE.EQ.-15) THEN 00351 WRITE (UNIT=CLMESS, 00352 S FMT='(''NOM D''''ARTICLE INCORRECT OU ' 00353 ', S ''TROP LONG, UNITE'',I3)') KNUMER 00354 C 00355 ELSEIF (KCODE.EQ.-16) THEN 00356 WRITE (UNIT=CLMESS, 00357 S FMT='(''INCOHERENCE (TABLES, FICHIER, ' 00358 ', S ''APPELS S/P INT, LOGICIEL), UNITE'',I3)') KNUMER 00359 C 00360 ELSEIF (KCODE.EQ.-17) THEN 00361 C 00362 IF (IJL.NE.0) THEN 00363 INBALO=LFI%MDES1D(IXM(LFI%JPNALO,IJL)) 00364 ELSE 00365 INBALO=LFI%JPNIL 00366 ENDIF 00367 C 00368 WRITE (UNIT=CLMESS, 00369 S FMT='(I6,'' ARTICLES, INDEX PLEIN, UNITE' 00370 ', S I3)') INBALO,KNUMER 00371 C 00372 ELSEIF (KCODE.EQ.-18) THEN 00373 WRITE (UNIT=CLMESS, 00374 S FMT='(''ARTICLE DE NOM BLANC ILLICITE' 00375 ', S '', UNITE'',I3)') KNUMER 00376 C 00377 ELSEIF (KCODE.EQ.-19) THEN 00378 WRITE (UNIT=CLMESS,FMT='(''UNITE' 00379 ',I3, S '' ''''SCRATCH'''', NE PEUT ETRE CONSERVEE'')') KNUMER 00380 C 00381 ELSEIF (KCODE.EQ.-20) THEN 00382 WRITE (UNIT=CLMESS,FMT='(''ARTICLE "' 00383 ',A, S ''" NON TROUVE, UNITE'',I3)') CDACTI(1:ILACT2),KNUMER 00384 C 00385 ELSEIF (KCODE.EQ.-21) THEN 00386 WRITE (UNIT=CLMESS,FMT='(''ARTICLE "' 00387 ',A, S ''" + *LONG* QUE DEMANDE, UNITE'',I3)') 00388 S CDACTI(1:ILACT2),KNUMER 00389 C 00390 ELSEIF (KCODE.EQ.-22) THEN 00391 WRITE (UNIT=CLMESS,FMT='(''ARTICLE "' 00392 ',A, S ''" + *COURT* QUE DEMANDE, UNITE'',I3)') 00393 S CDACTI(1:ILACT2),KNUMER 00394 C 00395 ELSEIF (KCODE.EQ.-23) THEN 00396 WRITE (UNIT=CLMESS, 00397 S FMT='(''PAS OU PLUS D''''ARTICLE SUIVANT' 00398 ', S '' A LIRE, UNITE'',I3)') KNUMER 00399 C 00400 ELSEIF (KCODE.EQ.-24) THEN 00401 WRITE (UNIT=CLMESS,FMT='(''VARIABLE CAR.TROP COURTE ' 00402 ', S ''POUR "'',A,''", UNITE'',I3)') 00403 S CDACTI(1:ILACT2),KNUMER 00404 C 00405 ELSEIF (KCODE.EQ.-25) THEN 00406 WRITE (UNIT=CLMESS, 00407 S FMT='(''NOUVEAU NOM D''''ARTICLE: "' 00408 ',A, S ''" DEJA UTILISE, UNITE'',I3)') 00409 S CDACTI(1:ILACT2),KNUMER 00410 C 00411 ELSEIF (KCODE.EQ.-26) THEN 00412 WRITE (UNIT=CLMESS,FMT='(''PAS OU PLUS D''''ARTICLE ' 00413 ', S '' PRECEDENT A LIRE, UNITE'',I3)') KNUMER 00414 C 00415 ELSEIF (KCODE.EQ.-27) THEN 00416 WRITE (UNIT=CLMESS, 00417 S FMT='(''ESPACE CONTIGU INSUFFISANT DANS ' 00418 ', S '' LES TABLES, UNITE'',I3)') KNUMER 00419 C 00420 ELSEIF (KCODE.EQ.-28) THEN 00421 C 00422 IF (KNUMER.EQ.LFI%JPNIL) THEN 00423 WRITE (UNIT=CLMESS,FMT='(''FACTEUR MULTIPLICATIF PAR ' 00424 ', S ''DEFAUT SUPERIEUR AU MAXIMUM('',I3,'')'')') LFI%JPFACX 00425 ELSE 00426 WRITE (UNIT=CLMESS,FMT='(''FACTEUR MULTIPLICATIF ' 00427 ', S ''DEMANDE SUPERIEUR AU MAXIMUM ('',I3,''), UNITE'',I3)') 00428 S LFI%JPFACX,KNUMER 00429 ENDIF 00430 C 00431 ELSEIF (KCODE.EQ.-29) THEN 00432 WRITE (UNIT=CLMESS,FMT='(I3,'' ENTREES,' 00433 ', S '' PAS DE PLACE POUR FACTEUR MULTIPLIC, UNITE'',I3)') 00434 S LFI%JPXUFM,KNUMER 00435 C 00436 ELSEIF (KCODE.EQ.-30) THEN 00437 WRITE (UNIT=CLMESS, 00438 S FMT='(''LFI%NUMERO D''''UNITE LOGIQUE FORTRAN' 00439 ' S ,I8,'' ILLICITE'')') KNUMER 00440 C 00441 ELSEIF (KCODE.EQ.-31) THEN 00442 WRITE (UNIT=CLMESS,FMT='(''LFI%NUMERO UNITE LOGIQ' 00443 ',I3, S '' SANS FACTEUR MULTIPLICATIF PREDEFINI'')') KNUMER 00444 C 00445 C Pour les codes d'erreur non prevus... 00446 C 00447 ELSEIF (KNUMER.EQ.LFI%JPNIL) THEN 00448 WRITE (UNIT=CLMESS, 00449 S FMT='(''ERREUR GLOBALE *INCONNUE* LFI%NUMERO' 00450 ', S I6)') KCODE 00451 ELSE 00452 WRITE (UNIT=CLMESS, 00453 S FMT='(''ERREUR *INCONNUE* LFI%NUMERO' 00454 ',I6, S '' SUR UNITE LOGIQUE'',I3)') KCODE,KNUMER 00455 ENDIF 00456 C 00457 ILMESA=LEN (CLMESA) 00458 ILMESU=ILMESA-1-2*LEN (CLJOLI)-ILNSPR-4 00459 CLMESA=CLJOLI//' '//CDNSPR(1:ILNSPR)//' - ' 00460 S //CLMESS(1:ILMESU)//CLJOLI 00461 WRITE (UNIT=LFI%NULOUT,FMT='(A)') CLMESA 00462 C 00463 C Si l'unite logique correspond a une unite logique LFI 00464 C deja ouverte, on en imprime le nom. 00465 C 00466 IF (IJL.NE.0) THEN 00467 C 00468 IF (LFI%NLNOMF(IJL).LE.LFI%JPLFTX) THEN 00469 WRITE (UNIT=LFI%NULOUT,FMT='(A,/)') CLJOLI 00470 S //' NOM - APPARENT MAIS' 00471 S //' COMPLET - DE L''UNITE LOGIQUE LFI CONCERNEE:' 00472 ELSE 00473 WRITE (UNIT=CLMESS,FMT= 00474 '(A, S '' NOM - APPARENT, ET TRONQUE DE' 00475 ',I4, S '' CARACTERES - DE L''''UNITE LOGIQUE LFI CONCERNEE:'')') 00476 S CLJOLI,LFI%NLNOMF(IJL)-LFI%JPLFTX 00477 WRITE (UNIT=LFI%NULOUT,FMT='(A,/)') CLMESS 00478 ENDIF 00479 C 00480 INLIGN=(LFI%NLNOMF(IJL)-1)/LFI%JPLFIX 00481 IDECAL=0 00482 C 00483 DO 801 J=1,INLIGN 00484 WRITE (UNIT=LFI%NULOUT,FMT='(A)') 00485 S LFI%CNOMFI(IJL)(IDECAL+1:IDECAL+LFI%JPLFIX)//'...' 00486 IDECAL=IDECAL+LFI%JPLFIX 00487 801 CONTINUE 00488 C 00489 IF (LFI%NLNOMF(IJL).LE.LFI%JPLFTX) THEN 00490 WRITE (UNIT=LFI%NULOUT,FMT='(A,/)') 00491 S LFI%CNOMFI(IJL)(IDECAL+1:LFI%NLNOMF(IJL)) 00492 ELSE 00493 WRITE (UNIT=LFI%NULOUT,FMT='(A,/)') 00494 S LFI%CNOMFI(IJL)(IDECAL+1:LFI%JPLFTX)//'...' 00495 ENDIF 00496 C 00497 IF (LFI%CNOMSY(IJL).NE.LFI%CNOMFI(IJL)) THEN 00498 WRITE (UNIT=LFI%NULOUT,FMT='(A,/)') CLJOLI// 00499 S ' NOM *SYSTEME* (APPARENT) DE L''UNITE LOGIQUE LFI CONCERNEE:' 00500 INLIGN=(LFI%NLNOMS(IJL)-1)/LFI%JPLFIX 00501 IDECAL=0 00502 C 00503 DO 802 J=1,INLIGN 00504 WRITE (UNIT=LFI%NULOUT,FMT='(A)') 00505 S LFI%CNOMSY(IJL)(IDECAL+1:IDECAL+LFI%JPLFIX)//'...' 00506 IDECAL=IDECAL+LFI%JPLFIX 00507 802 CONTINUE 00508 C 00509 WRITE (UNIT=LFI%NULOUT,FMT='(A,/)') 00510 S LFI%CNOMSY(IJL)(IDECAL+1:LFI%NLNOMS(IJL)) 00511 ENDIF 00512 C 00513 ENDIF 00514 C 00515 WRITE (UNIT=LFI%NULOUT,FMT='(A)') CLMESA 00516 IF (LDFATA.AND.KCODE.NE.0) THEN 00517 C 00518 C Saborde le programme. 00519 C 00520 CALL SDL_SRLABORT 00521 ENDIF 00522 C 00523 ENDIF 00524 C 00525 IF (LHOOK) CALL DR_HOOK('LFIEFR_MT',1,ZHOOK_HANDLE) 00526 END 00527
1.8.0
