1 : C INIERR SOURCE CHAT 06/03/16 21:19:05 5336 2 : * 3 : * INITIALISATION DES SEGMENTS DES ERREURS ET AUTRES MESSAGES 4 : * 5 : SUBROUTINE INIERR 6 : IMPLICIT INTEGER(I-N) 7 : -INC CCNOYAU 8 : -INC CCOPTIO 9 : external long 10 : CHARACTER*4 MLAN 11 : CHARACTER*80 CHTMP1,CHTMP2 12 : LEPETI=1000000 13 : NMESSA=0 14 : iprec=0 15 : 10 CONTINUE 16 : READ (35,FMT='(I4,1X,I1,1X,A4/,A80)',ERR=102,END=900) 17 : $ I,J,MLAN,CHTMP1 18 : 15 CONTINUE 19 : IF(I.EQ.9995) THEN 20 : LANGUE=CHTMP1(1:4) 21 : GO TO 10 22 : ENDIF 23 : IF(I.EQ.9996) GO TO 900 24 : IF(I.EQ.9999) GOTO 10 25 : IF(I.EQ.9998) THEN 26 : NLANG=0 27 : DO 58 MP=1,14 28 : IF(CHTMP1(MP*5-4:MP*5-1).EQ.' ') GO TO 59 29 : NLANG=NLANG+1 30 : 58 CONTINUE 31 : 59 CONTINUE 32 : NMESS=1000 33 : SEGINI MESSER 34 : DO 56 MP=1,NLANG 35 : LANGUA(MP)= CHTMP1(MP*5-4:MP*5-1) 36 : 56 CONTINUE 37 : LANGUE=LANGUA(1) 38 : GO TO 10 39 : ENDIF 40 : IF(I.EQ.9997) THEN 41 : DO 57 MP=1,NLANG 42 : ILAN=MP 43 : IF(CHTMP1(1:4).EQ.LANGUA(MP)) THEN 44 : IF(ILAN.NE.1) THEN 45 : IDEB=1 46 : ENDIF 47 : GO TO 10 48 : ENDIF 49 : 57 CONTINUE 50 : WRITE(IOIMP,54) 51 : 54 FORMAT(' ERREUR DE LANGUE DANS LE FICHIER D''ERREUR') 52 : NMESS=0 53 : SEGADJ MESSER 54 : RETURN 55 : ENDIF 56 : IF(ILAN.EQ.1) THEN 57 : NMESSA=NMESSA+1 58 : IFIN=NMESSA 59 : IF (NMESSA.GT.NMESS) THEN 60 : NMESS=NMESS+1000 61 : SEGADJ MESSER 62 : ENDIF 63 : ELSE 64 : * 65 : * on commence par chercher la position dans le tableau 66 : * 67 : DO 210 IO = IDEB,IFIN 68 : IF(I.EQ.NUMERR(IO) ) THEN 69 : NMESSA=IO 70 : IDEB=IO 71 : GO TO 211 72 : ENDIF 73 : 210 CONTINUE 74 : WRITE (6,*) 'MESSAGE ',I,' NON TROUVE' 75 : GO TO 100 76 : 211 CONTINUE 77 : ENDIF 78 : NUMERR(NMESSA)=I 79 : if (niverr(nmessa).ne.0.and.niverr(nmessa).ne.j) then 80 : write (ioimp,103) i 81 : 103 format(' ######### INCOHERENCE DE NIVEAU POUR LE MESSAGE ',i6) 82 : endif 83 : NIVERR(NMESSA)=J 84 : LCHER1=LONG(CHTMP1) 85 : iprec=i 86 : I=-9999 87 : READ (35,FMT='(I4,1X,I1,1X,A4/,A80)',ERR=102,END=900) 88 : $ I,J,MLAN,CHTMP2 89 : IF (I.NE.NUMERR(NMESSA)) GOTO 20 90 : LCHER2=LONG(CHTMP2) 91 : SEGINI MCHERR 92 : CHERR1=CHTMP1(1:LCHER1) 93 : CHERR2=CHTMP2(1:LCHER2) 94 : * SEGDES MCHERR 95 : 96 : IPMESS(NMESSA,ILAN)=MCHERR 97 : GO TO 10 98 : 20 CONTINUE 99 : LCHER2=0 100 : SEGINI MCHERR 101 : CHERR1=CHTMP1(1:LCHER1) 102 : * SEGDES MCHERR 103 : IPMESS(NMESSA,ILAN)=MCHERR 104 : CHTMP1=CHTMP2 105 : IF (I.NE.-9999) GOTO 15 106 : 900 CONTINUE 107 : NMESS=IFIN 108 : SEGADJ MESSER 109 : * SEGDES MESSER 110 : * SEGACT MESSER 111 : RETURN 112 : 102 WRITE(IOIMP,*) ' IPREC,I,J ',IPREC,I,J,' ==>' 113 : 100 WRITE(IOIMP,101) 114 : 101 FORMAT(' ERREUR DANS LA LECTURE DU FICHIER ERREUR||| ') 115 : NMESS=IFIN-1 116 : SEGADJ MESSER 117 : RETURN 118 : END 119 :
© Cast3M 2003 - All rights reserved.
Disclaimer