Télécharger lireca.eso

Retour à la liste

Numérotation des lignes :

  1. C LIRECA SOURCE PV 20/05/04 21:15:07 10598
  2. C ACQUISITION D'UNE CARTE (500 CARS) DE DONNEES
  3. C
  4. SUBROUTINE LIRECA
  5.  
  6. C LIT LES CARTES DE DONNEES. REVIENT AUTOMATIQUEMENT SUR
  7. C L'UNITE IOTER EN CAS DE FIN DE FICHIER,CE QUI PERMET D'EXECUTER
  8. C UN FICHIER PREPARE A L'AVANCE
  9. C RECOPIE TOUTES LES CARTES LUES SUR UNITE 98
  10.  
  11. IMPLICIT INTEGER(I-N)
  12.  
  13. -INC PPARAM
  14. -INC CCREDLE
  15. -INC CCOPTIO
  16. -INC CCNOYAU
  17.  
  18. CHARACTER*72 REP
  19. C LOCHAI et FMCHAI dans CCNOYAU.INC
  20. CHARACTER*(LOCHAI) IAERA,TMPLI
  21. CHARACTER*8 CHA8
  22. INTEGER IRET
  23. INTEGER LONGLU
  24. LOGICAL INIPAS
  25. SAVE IECHA,INIPAS
  26. DATA INIPAS/.TRUE./
  27.  
  28. C On positionne JERR au MAXI entre l'erreur par ASSISTANT et l'erreur GLOBALE
  29. jerr=MAX(IERR,IERGLB)
  30.  
  31. CHA8='INITIALE'
  32. sredle=iredle
  33. IF(INIPAS) THEN
  34. INIPAS=.FALSE.
  35. CALL PROCL2(CHA8,IRET)
  36. IF (IRET.EQ.9998.OR.IRET.EQ.9999) THEN
  37. IOLEC=654321 + IOLEC
  38. CALL ERREUR(-305)
  39. IECHA=IECHO
  40. IECHO= max(0,iecho - 1)
  41. ENDIF
  42. ENDIF
  43. I1=IPOS
  44. I2=I1+71
  45. 5 CONTINUE
  46. IF(IOLEC.LT.0. OR. IOLEC.GT.654321 ) THEN
  47. CALL PROCLI(IAERA,IRET)
  48. IF(IRET .EQ. 9999 ) THEN
  49. IF ( IOLEC.LT. 0) THEN
  50. IOLEC = -IOLEC
  51. ELSE
  52. IOLEC=IOLEC-654321
  53. CALL ERREUR (-306)
  54. ENDIF
  55. IECHO=IECHA
  56. GO TO 5
  57. ENDIF
  58.  
  59. LONGLU=LEN(IAERA)
  60. longlu=min(500,longlu)
  61. DO WHILE ( LONGLU.NE.1.AND. IAERA(LONGLU:LONGLU) .EQ.' ')
  62. LONGLU = LONGLU -1
  63. ENDDO
  64. IF(I1+LONGLU.LE.LEN(TEXT)) THEN
  65. I2=I1+LONGLU
  66. TEXT(I1:I2)=IAERA(1:LONGLU)
  67. ELSE
  68. I2=LEN(TEXT)
  69. LONGLU=I2-I1
  70. TEXT(I1:I2)=IAERA(1:LONGLU)
  71. moterr(1:40)=IAERA(LONGLU+1:)
  72. CALL ERREUR (-358)
  73. ENDIF
  74. ELSE
  75. IF (IECHO.GT.0) CALL PROMPT
  76.  
  77. c READ(IOLEC,FMT='(A72)',END=2,ERR=4) TMPLI
  78. READ(IOLEC,FMT=FMCHAI,END=2,ERR=4) TMPLI
  79. LONGLU=LEN(TMPLI)
  80. DO WHILE ( LONGLU.NE.1.AND. TMPLI(LONGLU:LONGLU) .EQ.' ')
  81. LONGLU = LONGLU -1
  82. ENDDO
  83. IF(I1+LONGLU.LE.LEN(TEXT)) THEN
  84. I2=I1+LONGLU
  85. TEXT(I1:I2)=TMPLI(1:LONGLU)
  86. ELSE
  87. I2=LEN(TEXT)
  88. LONGLU=I2-I1
  89. TEXT(I1:I2)=TMPLI(1:LONGLU)
  90. moterr(1:40)=TMPLI(LONGLU+1:)
  91. CALL ERREUR (-358)
  92. ENDIF
  93. ENDIF
  94. C*******
  95. WRITE(98,*,ERR=6) TEXT(I1:I2)
  96. goto 7
  97. 6 interr(1)=98
  98. moterr='fort.98 ?'
  99. call erreur (1066)
  100. return
  101. C*******
  102. 7 continue
  103. IF (IECHO.GE.1) WRITE(IOIMP,3) TEXT(I1:I2)
  104. 3 FORMAT(1X,'* ',A)
  105. IF(TEXT(I1:I1).EQ.'*') THEN
  106. GO TO 5
  107. ENDIF
  108. c write(IOIMP,*) 'Sortie de lireca'
  109. IPOS=I2
  110. RETURN
  111. C traitement erreur en lecture
  112. 4 continue
  113. if (jerr.eq.623) then
  114. ierr =0
  115. IERGLB=0
  116. call erreur(623)
  117. call opterm(ioter)
  118. ierr =0
  119. IERGLB=0
  120. goto 5
  121. endif
  122. interr(1)=ioter
  123. call erreur (624)
  124. call opterm(ioter)
  125. goto 5
  126. c traitement fin de lecture
  127. 2 IF (IOLEC.EQ.IOTER) THEN
  128. IF (IOGRA.EQ.3) THEN
  129. REWIND IOLEC
  130. WRITE (IOIMP,7711)
  131. READ (IOLEC,7712,END=7720) REP
  132. IF (REP(1:3).NE.'OUI') THEN
  133. WRITE( IOIMP,7713)
  134. GOTO 5
  135. ENDIF
  136. endif
  137. 7720 CONTINUE
  138. RETURN
  139. ELSE
  140. WRITE (IOIMP,7714) IOLEC
  141. IOLEC=IOTER
  142. GOTO 5
  143. ENDIF
  144. 7711 FORMAT (' VOULEZ-VOUS VRAIMENT SORTIR DE GIBI ? OUI/NON')
  145. 7712 FORMAT (A72)
  146. 7713 FORMAT( ' LE PROGRAMME ATTEND LA SUITE DES DONNEES')
  147. 7714 FORMAT(' FIN DE FICHIER SUR L''UNITE ',I2,/,
  148. # ' LES DONNEES SONT MAINTENANT LUES SUR LE CLAVIER')
  149. END
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  

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