Sources Esope | Cast3M

lireca
C LIRECA    SOURCE    PV090527  23/01/24    21:15:04     11570          
C     ACQUISITION D'UNE CARTE (500 CARS) DE DONNEES
C
      SUBROUTINE LIRECA
 
C  LIT LES CARTES DE DONNEES. REVIENT AUTOMATIQUEMENT SUR
C  L'UNITE IOTER EN CAS DE FIN DE FICHIER,CE QUI PERMET D'EXECUTER
C  UN FICHIER PREPARE A L'AVANCE
C  RECOPIE TOUTES LES CARTES LUES SUR UNITE 98
 
          IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCREDLE
-INC CCOPTIO
-INC CCNOYAU
 
      CHARACTER*72  REP
C     LOCHAI et FMCHAI dans CCNOYAU.INC
      CHARACTER*(LOCHAI) IAERA,TMPLI
      CHARACTER*8   CHA8
      INTEGER IRET
      INTEGER LONGLU
      LOGICAL INIPAS
      SAVE IECHA,INIPAS
      DATA INIPAS/.TRUE./
 
C     On positionne JERR au MAXI entre l'erreur par ASSISTANT et l'erreur GLOBALE
      jerr=MAX(IERR,IERGLB)
 
      CHA8='INITIALE'
      sredle=iredle
      IF(INIPAS) THEN
          INIPAS=.FALSE.
          CALL PROCL2(CHA8,IRET)
          IF (IRET.NE.0)  THEN
              IOLEC=654321 + IOLEC
              CALL ERREUR(-305)
              IECHA=IECHO
              IECHO= max(0,iecho - 1)
              iproc=iret
              call procpo(iproc,iret)
          ENDIF
      ENDIF
      I1=IPOS
      I2=I1+71
   5  CONTINUE
      IF(IOLEC.LT.0. OR. IOLEC.GT.654321 )  THEN
          CALL PROCLI(IAERA,IRET)
          IF(IRET .EQ. 99999 ) THEN
              IF ( IOLEC.LT. 0) THEN
                  IOLEC = -IOLEC
                  call procl1(moterr(1:8))
                  CALL ERREUR(1134)
                  return
              ELSE
                  IOLEC=IOLEC-654321
                  CALL ERREUR (-306)
              ENDIF
              IECHO=IECHA
              GO TO 5
          ENDIF
 
          LONGLU=LEN(IAERA)
          longlu=min(500,longlu)
          DO WHILE ( LONGLU.NE.1.AND. IAERA(LONGLU:LONGLU) .EQ.' ')
            LONGLU = LONGLU -1
          ENDDO
          IF(I1+LONGLU.LE.LEN(TEXT)) THEN
          I2=I1+LONGLU
          TEXT(I1:I2)=IAERA(1:LONGLU)
          ELSE
          I2=LEN(TEXT)
          LONGLU=I2-I1
          TEXT(I1:I2)=IAERA(1:LONGLU)
          moterr(1:40)=IAERA(LONGLU+1:)
          CALL ERREUR (-358)
          ENDIF
      ELSE
          IF (IECHO.GT.0) CALL PROMPT
 
c          READ(IOLEC,FMT='(A72)',END=2,ERR=4) TMPLI
          READ(IOLEC,FMT=FMCHAI,END=2,ERR=4) TMPLI
          LONGLU=LEN(TMPLI)
          DO WHILE ( LONGLU.NE.1.AND. TMPLI(LONGLU:LONGLU) .EQ.' ')
          LONGLU = LONGLU -1
          ENDDO
          IF(I1+LONGLU.LE.LEN(TEXT)) THEN
          I2=I1+LONGLU
          TEXT(I1:I2)=TMPLI(1:LONGLU)
          ELSE
          I2=LEN(TEXT)
          LONGLU=I2-I1
          TEXT(I1:I2)=TMPLI(1:LONGLU)
          moterr(1:40)=TMPLI(LONGLU+1:)
          CALL ERREUR (-358)
          ENDIF
      ENDIF
C*******
      WRITE(98,*,ERR=6) TEXT(I1:I2)
      goto 7
   6  interr(1)=98
      moterr='fort.98 ?'
      call erreur (1066)
      return
C*******
   7  continue
      IF (IECHO.GE.1) WRITE(IOIMP,3) TEXT(I1:I2)
   3  FORMAT(1X,'* ',A)
      IF(TEXT(I1:I1).EQ.'*') THEN
          GO TO 5
      ENDIF
c          write(IOIMP,*) 'Sortie de lireca'
      IPOS=I2
      RETURN
C  traitement erreur en lecture
   4  continue
      if (jerr.eq.623) then
          ierr  =0
          IERGLB=0
          call erreur(623)
          call opterm(ioter)
          ierr  =0
          IERGLB=0
          goto 5
      endif
      interr(1)=ioter
      call erreur (624)
      call opterm(ioter)
      goto 5
c traitement fin de lecture
   2  IF (IOLEC.EQ.IOTER) THEN
          IF (IOGRA.EQ.3) THEN
              REWIND (IOLEC,err=7720)
              WRITE (IOIMP,7711)
              READ (IOLEC,7712,END=7720,ERR=7720) REP
              IF (REP(1:3).NE.'OUI') THEN
                  WRITE( IOIMP,7713)
                  GOTO 5
              ENDIF
          endif
 7720 CONTINUE
          RETURN
      ELSE
          WRITE (IOIMP,7714) IOLEC
          IOLEC=IOTER
          GOTO 5
      ENDIF
 7711 FORMAT (' VOULEZ-VOUS VRAIMENT SORTIR DE GIBI ?  OUI/NON')
 7712 FORMAT (A72)
 7713 FORMAT( ' LE PROGRAMME ATTEND LA SUITE DES DONNEES')
 7714 FORMAT(' FIN DE FICHIER SUR L''UNITE ',I2,/,
     #  ' LES DONNEES SONT MAINTENANT LUES SUR LE CLAVIER')
      END