Télécharger lireca.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRECA SOURCE CB215821 15/02/12 21:15:06 8396
  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
  21. CALL PROCL2('INITIALE',IRET)
  22. IF(IRET(1:3).EQ.'999') THEN
  23. IOLEC=654321 + IOLEC
  24. CALL ERREUR(-305)
  25. IECHA=IECHO
  26. C write(6,*) ' on passe ici'
  27. IECHO= max(0,iecho - 1)
  28. ENDIF
  29. ENDIF
  30. I1=IPOS
  31. I2=I1+71
  32. 5 CONTINUE
  33. IF(IOLEC.LT.0. OR. IOLEC.GT.654321 ) THEN
  34. NCARTP=NCARTP+1
  35. CALL PROCLI(IAERA,IRET)
  36. IF(IRET.EQ.'9999') THEN
  37. IF ( IOLEC.LT. 654321) THEN
  38. IOLEC = -IOLEC
  39. ELSE
  40. IOLEC=IOLEC-654321
  41. CALL ERREUR (-306)
  42. ENDIF
  43. IECHO=IECHA
  44. GO TO 5
  45. ENDIF
  46. TEXT(I1:I2)=IAERA
  47. NBCART=NCARTP
  48. ELSE
  49.  
  50. IF (IECHO.GT.0) CALL PROMPT
  51. READ(IOLEC,FMT='(A72)',END=2,ERR=4) TEXT(I1:I2)
  52. NCARTP=0
  53. NCART=NCART+1
  54. NBCART=NCART
  55. ENDIF
  56. C*******
  57. WRITE(98,FMT='(A72)') TEXT(I1:I2)
  58. C*******
  59. IF (IECHO.GE.1) WRITE(IOIMP,3) TEXT(I1:I2)
  60. 3 FORMAT(1X,'* ',A72)
  61. IF(TEXT(I1:I1).EQ.'*') GO TO 5
  62. IPOS=I2
  63. RETURN
  64. C traitement erreur en lecture
  65. 4 continue
  66. if (ierr.eq.623) then
  67. ierr=0
  68. call erreur(623)
  69. call opterm(ioter)
  70. ierr=0
  71. goto 5
  72. endif
  73. interr(1)=ioter
  74. call erreur (624)
  75. call opterm(ioter)
  76. goto 5
  77. 2 IF (IOLEC.EQ.IOTER) THEN
  78. IF (IOGRA.NE.3) THEN
  79. return
  80. endif
  81. REWIND IOLEC
  82. WRITE (IOIMP,7711)
  83. 7711 FORMAT (' VOULEZ-VOUS VRAIMENT SORTIR DE GIBI ? OUI/NON')
  84. READ (IOLEC,7712,END=7720) REP
  85. 7712 FORMAT (A72)
  86. IF (REP(1:3).NE.'OUI') WRITE( IOIMP,7713)
  87. 7713 FORMAT( ' LE PROGRAMME ATTEND LA SUITE DES DONNEES')
  88. IF (REP(1:3).NE.'OUI') GOTO 5
  89. 7720 CONTINUE
  90. RETURN
  91. ELSE
  92. WRITE (IOIMP,7714) IOLEC
  93. 7714 FORMAT(' FIN DE FICHIER SUR L''UNITE ',I2,/,
  94. # ' LES DONNEES SONT MAINTENANT LUES SUR LE CLAVIER')
  95. IOLEC=IOTER
  96. GOTO 5
  97. ENDIF
  98. END
  99.  
  100.  
  101.  
  102.  
  103.  

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