Télécharger ecproc.eso

Retour à la liste

Numérotation des lignes :

  1. C ECPROC SOURCE GF238795 17/11/15 19:12:13 9611
  2. SUBROUTINE ECPROC
  3. C---------------------------------------------------------------------
  4. C LISTE D'UN OBJET DE TYPE PROCEDURE
  5. C---------------------------------------------------------------------
  6. IMPLICIT INTEGER(I-N)
  7. -INC CCOPTIO
  8. CHARACTER*500 BUFFER
  9. CHARACTER*(8) ICHA
  10. CHARACTER*(4) CODE
  11. integer longlu
  12.  
  13. C
  14. C RECHERCHE DE LA POSITION SUR LE FICHIER
  15. C
  16. CALL QUENOM(ICHA)
  17. IPO1=1
  18. IPO2=100000
  19. CALL LIRENT(IPO,0,IRETOU)
  20. IF(IRETOU.NE.0) THEN
  21. IPO1=IPO
  22. IPO2=IPO1
  23. CALL LIRENT(IPO,0,IRETOU)
  24. IF(IRETOU.NE.0) THEN
  25. IPO2=IPO
  26. ENDIF
  27. ENDIF
  28. CALL PROCL2(ICHA,CODE)
  29. IF(CODE.EQ.'0 ') THEN
  30. call erreur ( -330)
  31. return
  32. ELSEIF ( CODE . EQ . '9998') then
  33. call erreur ( -331)
  34. ELSE
  35. call erreur ( -332)
  36. endif
  37. C
  38. C LECTURE DE LA PROCEDURE - ECRITURE SUR LE TERMINAL
  39. C
  40. CALL ERREUR (-13)
  41. II=0
  42. 1 CALL PROCLI(BUFFER,CODE)
  43. IF (CODE.NE.'0 ') GOTO 2
  44. LONGLU=LEN(BUFFER)
  45. DO WHILE ( LONGLU.NE.1.AND. BUFFER(LONGLU:LONGLU) .EQ.' ')
  46. LONGLU = LONGLU -1
  47. ENDDO
  48. II=II+1
  49. IF(II.GE.IPO1)WRITE (IOIMP,100) II,BUFFER(1:LONGLU)
  50. 100 FORMAT (1X,I4,2X,A)
  51. IF(II.EQ.IPO2) GO TO 2
  52. GOTO 1
  53. 2 RETURN
  54. END
  55.  
  56.  
  57.  
  58.  
  59.  

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