Esope source files

   1 : C LIRECA    SOURCE    CHAT      06/06/01    21:17:47     5450           
   2 : C     ACQUISITION D'UNE CARTE (72 CARS) DE DONNEES                 
   3 : C                                                                  
   4 :       SUBROUTINE LIRECA                                            
   5 : C  LIT LES CARTES DE DONNEES. REVIENT AUTOMATIQUEMENT SUR          
   6 : C  L'UNITE IOTER EN CAS DE FIN DE FICHIER,CE QUI PERMET D'EXECUTER 
   7 : C  UN FICHIER PREPARE A L'AVANCE                                   
   8 : C  RECOPIE TOUTES LES CARTES LUES SUR UNITE 98                     
   9 :       IMPLICIT INTEGER(I-N)
  10 : -INC CCREDLE
  11 : -INC CCOPTIO                                                        
  12 : -INC CCNOYAU
  13 :       CHARACTER*72 REP                                             
  14 :       CHARACTER*72 IAERA                                           
  15 :       CHARACTER*4 IRET                                             
  16 :       SAVE NCART,NCARTP,IECHA,IPASS                                 
  17 :       DATA NCART/0/,NCARTP/0/,IPASS/0/
  18 :       sredle=iredle
  19 :       IF(IPASS.EQ.0) THEN
  20 :           IPASS=1
  20 :           CALL PROCL2('INITIALE',IRET)
  21 :           IF(IRET(1:3).EQ.'999')  THEN
  22 :              IOLEC=654321 + IOLEC
  22 :              CALL ERREUR(-305)
  23 :              IECHA=IECHO
  24 : *             write(6,*) ' on passe ici'
  25 :              IECHO= max(0,iecho - 1)
  26 :           ENDIF   
  27 :       ENDIF                                                        
  28 :       I1=IPOS                                                      
  29 :       I2=I1+71                                                     
  30 :    5  CONTINUE                                                     
  31 :       IF(IOLEC.LT.0. OR. IOLEC.GT.654321 )  THEN                    
  32 :           NCARTP=NCARTP+1                                          
  32 :           CALL PROCLI(IAERA,IRET)                                  
  33 :           IF(IRET.EQ.'9999') THEN
  34 :                    IF ( IOLEC.LT. 654321) THEN
  35 :                         IOLEC = -IOLEC
  36 :                    ELSE
  37 :                         IOLEC=IOLEC-654321
  37 :                         CALL ERREUR (-306)
  38 :                   ENDIF
  39 :                         IECHO=IECHA
  40 :                         GO TO 5
  41 :           ENDIF                                            
  42 :           TEXT(I1:I2)=IAERA                                        
  43 :           NBCART=NCARTP                                            
  44 :       ELSE                                                         
  45 :                                           
  45 :          IF (IECHO.NE.0) CALL PROMPT                               
  46 :           READ(IOLEC,FMT='(A72)',END=2,ERR=4) TEXT(I1:I2)                                                          
  47 :           NCARTP=0                                                              
  48 :           NCART=NCART+1                                                         
  49 :           NBCART=NCART                                                          
  50 :       ENDIF                                                                     
  51 : C*******                                                                        
  52 :       WRITE(98,FMT='(A72)') TEXT(I1:I2)                                         
  53 : C*******                                                                        
  54 :       IF (IECHO.GE.1) WRITE(IOIMP,3) TEXT(I1:I2)                                
  55 :    3  FORMAT(1X,'* ',A72)                                                       
  56 :       IF(TEXT(I1:I1).EQ.'*') GO TO 5                                            
  57 :       IPOS=I2 
  58 :       RETURN                                                                    
  59 : *  traitement erreur en lecture
  60 :    4  continue
  61 :       if (ierr.eq.623) then
  62 :        ierr=0
  62 :        call erreur(623)
  62 :        call opterm(ioter)
  63 :        ierr=0
  64 :        goto 5
  65 :       endif
  66 :       interr(1)=ioter
  66 :       call erreur (624)
  66 :       call opterm(ioter)
  67 :       goto 5
  68 :    2  IF (IOLEC.EQ.IOTER) THEN                                                  
  69 :        IF (IOGRA.NE.3) THEN
  70 :           return
  71 :        endif
  72 :        REWIND IOLEC                                                             
  73 :        WRITE (IOIMP,7711)                                                       
  74 :  7711 FORMAT (' VOULEZ-VOUS VRAIMENT SORTIR DE GIBI ?  OUI/NON')                
  75 :        READ (IOLEC,7712,END=7720) REP                                           
  76 :  7712  FORMAT (A72)                                                             
  77 :        IF (REP(1:3).NE.'OUI') WRITE( IOIMP,7713)                                
  78 :  7713  FORMAT( ' LE PROGRAMME ATTEND LA SUITE DES DONNEES')                     
  79 :        IF (REP(1:3).NE.'OUI') GOTO 5                                            
  80 :  7720  CONTINUE 
  81 :        RETURN                                                                   
  82 :       ELSE                                                                      
  83 :        WRITE (IOIMP,7714) IOLEC                                                 
  84 :  7714 FORMAT(' FIN DE FICHIER SUR L''UNITE ',I2,/,                              
  85 :      #  ' LES DONNEES SONT MAINTENANT LUES SUR LE CLAVIER')                     
  86 :        IOLEC=IOTER                                                              
  87 :        GOTO 5                                                                   
  88 :       ENDIF                                                                     
  89 :       END                              
  90 :  
  91 :  
  92 :