Sources Esope | Cast3M

inierr
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