C INIERR SOURCE PV 21/10/31 00:30:53 11162 * * INITIALISATION DES SEGMENTS DES ERREURS ET AUTRES MESSAGES * SUBROUTINE INIERR IMPLICIT INTEGER(I-N) -INC CCNOYAU -INC PPARAM -INC CCOPTIO external long CHARACTER*4 MLAN CHARACTER*500 CHTMP1,CHTMP2 LEPETI=1000000 NMESSA=0 iprec=0 ifin=0 MESSER=0 NMESS=0 NLANG=0 SEGINI MESSER 10 CONTINUE IF(UTIFI3(5).EQ.0) RETURN READ (35,FMT='(I4,1X,I1,1X,A4/,A500)',ERR=102,END=900) $ I,J,MLAN,CHTMP1 15 CONTINUE IF(I.EQ.9995) THEN if (langue.eq.'FRANC') LANGUE=CHTMP1(1:4) GO TO 10 ENDIF IF(I.EQ.9996) GO TO 900 IF(I.EQ.9999) GOTO 10 IF(I.EQ.9998) THEN NLANG=0 DO 58 MP=1,14 IF(CHTMP1(MP*5-4:MP*5-1).EQ.' ') GO TO 59 NLANG=NLANG+1 58 CONTINUE 59 CONTINUE NMESS=1000 SEGADJ MESSER ilang=0 DO 56 MP=1,NLANG LANGUA(MP)= CHTMP1(MP*5-4:MP*5-1) if(langua(mp).eq.langue) ilang=mp 56 CONTINUE if (ilang.eq.0) LANGUE=LANGUA(1) GO TO 10 ENDIF IF(I.EQ.9997) THEN DO 57 MP=1,NLANG ILAN=MP IF(CHTMP1(1:4).EQ.LANGUA(MP)) THEN IF(ILAN.NE.1) THEN IDEB=1 ENDIF GO TO 10 ENDIF 57 CONTINUE WRITE(IOIMP,54) 54 FORMAT(' ERREUR DE LANGUE DANS LE FICHIER D''ERREUR') NMESS=0 SEGADJ MESSER RETURN ENDIF IF(ILAN.EQ.1) THEN NMESSA=NMESSA+1 IFIN=NMESSA IF (NMESSA.GT.NMESS) THEN NMESS=NMESS+1000 SEGADJ MESSER ENDIF ELSE * * on commence par chercher la position dans le tableau * DO 210 IO = IDEB,IFIN IF(I.EQ.NUMERR(IO) ) THEN NMESSA=IO IDEB=IO GO TO 211 ENDIF 210 CONTINUE WRITE (6,*) 'MESSAGE ',I,' NON TROUVE' GO TO 100 211 CONTINUE ENDIF NUMERR(NMESSA)=I if (niverr(nmessa).ne.0.and.niverr(nmessa).ne.j) then write (ioimp,103) i 103 format(' ######### INCOHERENCE DE NIVEAU POUR LE MESSAGE ',i6) endif NIVERR(NMESSA)=J LCHER1=LONG(CHTMP1) iprec=i I=-9999 READ (35,FMT='(I4,1X,I1,1X,A4/,A500)',ERR=102,END=900) $ I,J,MLAN,CHTMP2 IF (I.NE.NUMERR(NMESSA)) GOTO 20 LCHER2=LONG(CHTMP2) SEGINI MCHERR CHERR1=CHTMP1(1:LCHER1) CHERR2=CHTMP2(1:LCHER2) * SEGDES MCHERR IPMESS(NMESSA,ILAN)=MCHERR GO TO 10 20 CONTINUE LCHER2=0 SEGINI MCHERR CHERR1=CHTMP1(1:LCHER1) * SEGDES MCHERR IPMESS(NMESSA,ILAN)=MCHERR CHTMP1=CHTMP2 IF (I.NE.-9999) GOTO 15 900 CONTINUE NMESS=IFIN SEGADJ MESSER * SEGDES MESSER * SEGACT MESSER RETURN 102 WRITE(IOIMP,*) ' IPREC,I,J ',IPREC,I,J,' ==>' 100 WRITE(IOIMP,101) 101 FORMAT(' ERREUR DANS LA LECTURE DU FICHIER ERREUR||| ') NMESS=IFIN-1 SEGADJ MESSER RETURN END