Télécharger ecproc.eso

Retour à la liste

Numérotation des lignes :

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

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