Télécharger lireca.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRECA SOURCE CB215821 18/01/23 21:15:23 9704
  2. C ACQUISITION D'UNE CARTE (500 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*500 IAERA
  15. CHARACTER*540 TMPLI
  16. CHARACTER*8 CHA8
  17. INTEGER IRET
  18. INTEGER LONGLU
  19. LOGICAL INIPAS
  20. SAVE IECHA,INIPAS
  21. DATA INIPAS/.TRUE./
  22.  
  23. CHA8='INITIALE'
  24. sredle=iredle
  25. IF(INIPAS) THEN
  26. INIPAS=.FALSE.
  27. CALL PROCL2(CHA8,IRET)
  28. IF(IRET .EQ. 999 ) THEN
  29. IOLEC=654321 + IOLEC
  30. CALL ERREUR(-305)
  31. IECHA=IECHO
  32. IECHO= max(0,iecho - 1)
  33. ENDIF
  34. ENDIF
  35. I1=IPOS
  36. I2=I1+71
  37. 5 CONTINUE
  38. IF(IOLEC.LT.0. OR. IOLEC.GT.654321 ) THEN
  39. CALL PROCLI(IAERA,IRET)
  40. IF(IRET .EQ. 9999 ) THEN
  41. IF ( IOLEC.LT. 0) THEN
  42. IOLEC = -IOLEC
  43. ELSE
  44. IOLEC=IOLEC-654321
  45. CALL ERREUR (-306)
  46. ENDIF
  47. IECHO=IECHA
  48. GO TO 5
  49. ENDIF
  50.  
  51. LONGLU=LEN(IAERA)
  52. DO WHILE ( LONGLU.NE.1.AND. IAERA(LONGLU:LONGLU) .EQ.' ')
  53. LONGLU = LONGLU -1
  54. ENDDO
  55. IF(I1+LONGLU.LE.LEN(TEXT)) THEN
  56. I2=I1+LONGLU
  57. TEXT(I1:I2)=IAERA(1:LONGLU)
  58. ELSE
  59. I2=LEN(TEXT)
  60. LONGLU=I2-I1
  61. TEXT(I1:I2)=IAERA(1:LONGLU)
  62. moterr(1:40)=IAERA(LONGLU+1:)
  63. CALL ERREUR (-358)
  64. ENDIF
  65. ELSE
  66. IF (IECHO.GT.0) CALL PROMPT
  67.  
  68. c READ(IOLEC,FMT='(A72)',END=2,ERR=4) TMPLI
  69. READ(IOLEC,FMT='(A540)',END=2,ERR=4) TMPLI
  70. LONGLU=LEN(TMPLI)
  71. DO WHILE ( LONGLU.NE.1.AND. TMPLI(LONGLU:LONGLU) .EQ.' ')
  72. LONGLU = LONGLU -1
  73. ENDDO
  74. IF(I1+LONGLU.LE.LEN(TEXT)) THEN
  75. I2=I1+LONGLU
  76. TEXT(I1:I2)=TMPLI(1:LONGLU)
  77. ELSE
  78. I2=LEN(TEXT)
  79. LONGLU=I2-I1
  80. TEXT(I1:I2)=TMPLI(1:LONGLU)
  81. moterr(1:40)=TMPLI(LONGLU+1:)
  82. CALL ERREUR (-358)
  83. ENDIF
  84. ENDIF
  85. C*******
  86. WRITE(98,*) TEXT(I1:I2)
  87. C*******
  88. IF (IECHO.GE.1) WRITE(IOIMP,3) TEXT(I1:I2)
  89. 3 FORMAT(1X,'* ',A)
  90. IF(TEXT(I1:I1).EQ.'*') THEN
  91. GO TO 5
  92. ENDIF
  93. c write(IOIMP,*) 'Sortie de lireca'
  94. IPOS=I2
  95. RETURN
  96. C traitement erreur en lecture
  97. 4 continue
  98. if (ierr.eq.623) then
  99. ierr=0
  100. call erreur(623)
  101. call opterm(ioter)
  102. ierr=0
  103. goto 5
  104. endif
  105. interr(1)=ioter
  106. call erreur (624)
  107. call opterm(ioter)
  108. goto 5
  109. c traitement fin de lecture
  110. 2 IF (IOLEC.EQ.IOTER) THEN
  111. IF (IOGRA.EQ.3) THEN
  112. REWIND IOLEC
  113. WRITE (IOIMP,7711)
  114. READ (IOLEC,7712,END=7720) REP
  115. IF (REP(1:3).NE.'OUI') THEN
  116. WRITE( IOIMP,7713)
  117. GOTO 5
  118. ENDIF
  119. endif
  120. 7720 CONTINUE
  121. RETURN
  122. ELSE
  123. WRITE (IOIMP,7714) IOLEC
  124. IOLEC=IOTER
  125. GOTO 5
  126. ENDIF
  127. 7711 FORMAT (' VOULEZ-VOUS VRAIMENT SORTIR DE GIBI ? OUI/NON')
  128. 7712 FORMAT (A72)
  129. 7713 FORMAT( ' LE PROGRAMME ATTEND LA SUITE DES DONNEES')
  130. 7714 FORMAT(' FIN DE FICHIER SUR L''UNITE ',I2,/,
  131. # ' LES DONNEES SONT MAINTENANT LUES SUR LE CLAVIER')
  132. END
  133.  
  134.  
  135.  

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