Sources Esope | Cast3M

erreu2
C ERREU2    SOURCE    PV        16/12/08    21:15:01     9245           
C  EDITION MESSAGE
C
      SUBROUTINE ERREU2(CHLU,CHER,NBLIG,ITYP)
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
      CHARACTER*(*) CHLU(2),CHER(2)
      CHARACTER*12 CHAUX
      CHARACTER*11 NOMBRE
      LOGICAL ZTRIM
      REAL*8 RNOMB
      DATA NOMBRE /'0123456789:'/
      CHER(1)=' '
      CHER(2)=' '
      CHER(1)=CHLU(1)
      CHER(2)=CHLU(2)
      DO 20 IL=1,NBLIG
          IOUT=0
          IIN=0
 100      CONTINUE
          IIN=IIN+1
          IF (IIN.GT.LEN(CHLU(IL))) GOTO 110
          IF (CHLU(IL)(IIN:IIN).NE.'%') THEN
              IOUT=IOUT+1
              CHER(IL)(IOUT:IOUT)=CHLU(IL)(IIN:IIN)
          ELSEIF (CHLU(IL)(IIN+1:IIN+1).EQ.'i') THEN
              INUM=INDEX(NOMBRE,CHLU(IL)(IIN+2:IIN+2))-1
              IF (INUM.EQ.0) THEN
                  INOMB=ITYP
              ELSE
                  INOMB=INTERR(INUM)
              ENDIF
              WRITE (CHAUX,FMT='(I12)') INOMB
C  NE GARDER QUE LES SIGNES SIGNIFICATIFS
              DO 30 IAUX=1,12
                  IF (CHAUX(IAUX:IAUX).NE.' ') GOTO 40
  30          CONTINUE
              IAUX=12
  40          CONTINUE
              CHER(IL)(IOUT+1:IOUT+13-IAUX)=CHAUX(IAUX:12)
              IOUT=IOUT+13-IAUX
              IIN=IIN+2
          ELSEIF (CHLU(IL)(IIN+1:IIN+1).EQ.'r') THEN
              INUM=INDEX(NOMBRE,CHLU(IL)(IIN+2:IIN+2))-1
              RNOMB=REAERR(INUM)
              WRITE (CHAUX,FMT='(1PG12.5)') RNOMB
C  NE GARDER QUE LES SIGNES SIGNIFICATIFS
              DO 50 IAUX=1,12
                  IF (CHAUX(IAUX:IAUX).NE.' ') GOTO 60
  50          CONTINUE
              IAUX=12
  60          CONTINUE
              CHER(IL)(IOUT+1:IOUT+13-IAUX)=CHAUX(IAUX:12)
              IOUT=IOUT+13-IAUX
              IIN=IIN+2
          ELSEIF (CHLU(IL)(IIN+1:IIN+1).EQ.'b') THEN
              INUM=INDEX(NOMBRE,CHLU(IL)(IIN+2:IIN+2))-1
              IF (BOOERR(INUM)) THEN
                  CHAUX(1:4)='VRAI'
              ELSE
                  CHAUX(1:4)='FAUX'
              ENDIF
              CHER(IL)(IOUT+1:IOUT+4)=CHAUX(1:4)
              IOUT=IOUT+4
              IIN=IIN+2
          ELSEIF ((CHLU(IL)(IIN+1:IIN+1).EQ.'m').OR.
     &            (CHLU(IL)(IIN+1:IIN+1).EQ.'M')) THEN
              ZTRIM=(CHLU(IL)(IIN+1:IIN+1).EQ.'M')
              IIN=IIN+1
              IPOS=INDEX(NOMBRE,CHLU(IL)(IIN+1:IIN+1))-1
              IIN=IIN+1
              IPOS1=INDEX(NOMBRE,CHLU(IL)(IIN+1:IIN+1))-1
              IF (IPOS1.NE.10) THEN
                  IPOS=10*IPOS+IPOS1
                  IIN=IIN+1
                  IPOS1=INDEX(NOMBRE,CHLU(IL)(IIN+1:IIN+1))-1
                  IF (IPOS1.NE.10) THEN
                      IPOS=10*IPOS+IPOS1
                      IIN=IIN+1
                  ENDIF
              ENDIF
C  LA IL Y A UN % ON LE SAUTE
              IIN=IIN+1
              JPOS=INDEX(NOMBRE,CHLU(IL)(IIN+1:IIN+1))-1
              IIN=IIN+1
              JPOS1=INDEX(NOMBRE,CHLU(IL)(IIN+1:IIN+1))-1
              IF (JPOS1.NE.-1) THEN
                  JPOS=10*JPOS+JPOS1
                  IIN=IIN+1
                  JPOS1=INDEX(NOMBRE,CHLU(IL)(IIN+1:IIN+1))-1
                  IF (JPOS1.NE.-1) THEN
                      JPOS=10*JPOS+JPOS1
                      IIN=IIN+1
                  ENDIF
              ENDIF
              IF (IPOS.EQ.0.AND.JPOS.EQ.0) THEN
                  CHER(IL)(IOUT+1:IOUT+5)=LOCERR
                  IOUT=IOUT+5
              ELSE
                  CALL LENCHA(MOTERR(IPOS:JPOS),LLMERR)
                  IF (LLMERR.GT.0.AND.ZTRIM) JPOS=IPOS+LLMERR-1
                  CHER(IL)(IOUT+1:IOUT+1+JPOS-IPOS)=MOTERR(IPOS:JPOS)
                  IOUT=IOUT+1+JPOS-IPOS
              ENDIF
          ELSE
              IOUT=IOUT+1
              CHER(IL)(IOUT:IOUT)=CHLU(IL)(IIN:IIN)
          ENDIF
          GOTO 100
 110      CONTINUE
  20  CONTINUE
      END