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

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