Télécharger erreu2.eso

Retour à la liste

erreu2
C ERREU2    SOURCE    OF166741  24/08/07    21:15:02     11981          
C  EDITION MESSAGE
C
      SUBROUTINE ERREU2(CHLU,CHER,NBLIG,ITYP)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
      EXTERNAL LONG
 
      CHARACTER*(*) CHLU(2),CHER(2)
      CHARACTER*12 CHAUX
      CHARACTER*11 NOMBRE
      LOGICAL ZTRIM
 
      DATA NOMBRE /'0123456789:'/
 
      CHER(1)=' '
      CHER(2)=' '
      DO 20 IL=1,NBLIG
          LG_CHLU = LONG(CHLU(IL))
          LN_CHER = LEN(CHER(IL))
          IIN=0
          IOUT=0
          LOUT=0
 100      CONTINUE
          IF (IIN.GE.LG_CHLU) GOTO 110
          IIN=IIN+1
          IOUTI=IOUT+1
          IF (CHLU(IL)(IIN:IIN).NE.'%') THEN
              LOUT =1
              IOUTF=IOUT+LOUT
              IF (IOUTF.GT.LN_CHER) GOTO 110
              CHER(IL)(IOUTI:IOUTF)=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
              LOUT = 12
              DO IAUX=1,12
                  IF (CHAUX(IAUX:IAUX).NE.' ') GOTO 40
                  LOUT = LOUT - 1
              ENDDO
  40          CONTINUE
              IF (LOUT.EQ.0) THEN
                LOUT = 1
                CHAUX(12:12) = '0'
              ENDIF
              IOUTF=IOUT+LOUT
              IF (IOUTF.GT.LN_CHER) GOTO 110
              IAUX = 12-LOUT+1
              CHER(IL)(IOUTI:IOUTF)=CHAUX(IAUX:12)
              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
              LOUT = 12
              DO IAUX=1,12
                  IF (CHAUX(IAUX:IAUX).NE.' ') GOTO 60
                  LOUT = LOUT - 1
              ENDDO
  60          CONTINUE
              IOUTF=IOUT+LOUT
              IF (IOUTF.GT.LN_CHER) GOTO 110
              IAUX = 12-LOUT+1
              CHER(IL)(IOUTI:IOUTF)=CHAUX(IAUX:12)
              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
              LOUT = 4
              IOUTF=IOUT+LOUT
              IF (IOUTF.GT.LN_CHER) GOTO 110
              CHER(IL)(IOUTI:IOUTF)=CHAUX(1: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
                  LOUT = 5
                  IOUTF=IOUT+LOUT
                  IF (IOUTF.GT.LN_CHER) GOTO 110
                  CHER(IL)(IOUTI:IOUTF)=LOCERR(1:5)
              ELSE
                  CALL LENCHA(MOTERR(IPOS:JPOS),LLMERR)
                  IF (LLMERR.GT.0.AND.ZTRIM) JPOS=IPOS+LLMERR-1
                  LOUT = JPOS-IPOS+1
                  IOUTF=IOUT+LOUT
                  IF (IOUTF.GT.LN_CHER) GOTO 110
                  CHER(IL)(IOUTI:IOUTF)=MOTERR(IPOS:JPOS)
              ENDIF
          ELSE
              LOUT = 1
              IOUTF=IOUT+LOUT
              IF (IOUTF.GT.LN_CHER) GOTO 110
              CHER(IL)(IOUTI:IOUTF)=CHLU(IL)(IIN:IIN)
          ENDIF
          IOUT=IOUTF
          GOTO 100
 110      CONTINUE
  20  CONTINUE
 
c      return
      END
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales