Télécharger lireca.eso

Retour à la liste

Numérotation des lignes :

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

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