Télécharger insere.eso

Retour à la liste

Numérotation des lignes :

  1. C INSERE SOURCE JC220346 12/05/16 21:15:03 7372
  2. SUBROUTINE INSERE
  3. ************************************************************************
  4. *
  5. * I N S E R E
  6. * -----------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A LA DIRECTIVE "INSERER"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * INSERER UN ELEMENT DANS UN OBJET (QUAND CELA A UN SENS).
  14. *
  15. * PHRASE D'APPEL (EN GIBIANE):
  16. * ----------------------------
  17. *
  18. * INSERER OBJET RANG ELEM ;
  19. *
  20. * OPERANDES:
  21. * ----------
  22. *
  23. * OBJET TYPE1 OBJET OU ON INSERE UN ELEMENT.
  24. * RANG TYPE2 INDICE DE POSITION DE L'ELEMENT A INSERER
  25. * DANS L'OBJET "OBJET".
  26. * ELEM TYPE3 OBJET INSERE.
  27. *
  28. * SI TYPE1 = ... ALORS, TYPE2 = ... ET TYPE3 = ...
  29. * LISTREEL ENTIER FLOTTANT
  30. * LISTENTI ENTIER ENTIER
  31. * LISTMOTS ENTIER MOT
  32. * LISTCHPO ENTIER CHPOINT
  33. *
  34. * MODE DE FONCTIONNEMENT:
  35. * -----------------------
  36. *
  37. * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET
  38. * "OBJET".
  39. *
  40. * AUTEUR, DATE DE CREATION:
  41. * -------------------------
  42. *
  43. * PASCAL MANIGOT 5 DECEMBRE 1984
  44. * MODIF LE 22 JANVIER 1988
  45. * LANGAGE:
  46. * --------
  47. *
  48. * FORTRAN77
  49. *
  50. ************************************************************************
  51. *
  52. IMPLICIT INTEGER(I-N)
  53. -INC CCOPTIO
  54. *
  55. REAL*8 REELDP
  56. CHARACTER *4 LEMOT
  57. *
  58. *
  59. * IPOS=0 => on interdit à IPOIN2 de contenir un LISTENTI
  60. IPOS=0
  61. CALL LIRE01 (IPOIN1,IPOS,IPOIN2)
  62. IF (IERR .NE. 0) RETURN
  63. *
  64. IF (IPOS .EQ. 1) THEN
  65. CALL LIRREE (REELDP,1,IRETOU)
  66. CALL INSER5 (IPOIN1,IPOIN2,REELDP,IPOIN3)
  67. CALL ECROBJ ('LISTREEL',IPOIN3)
  68. ELSE IF (IPOS .EQ. 2) THEN
  69. CALL LIRENT (IPOIN3,1,IRETOU)
  70. CALL INSER6 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)
  71. CALL ECROBJ ('LISTENTI',IPOIN4)
  72. ELSE IF (IPOS .EQ. 3) THEN
  73. CALL LIRCHA (LEMOT,1,IRETOU)
  74. IF (IERR.NE.0) RETURN
  75. CALL INSER7 (IPOIN1,IPOIN2,LEMOT,IPOIN3)
  76. CALL ECROBJ ('LISTMOTS',IPOIN3)
  77. ELSE IF (IPOS .EQ. 4) THEN
  78. CALL LIROBJ ('CHPOINT',IPOIN3,1,IRETOU)
  79. CALL INSER8 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)
  80. CALL ECROBJ ('LISTCHPO',IPOIN4)
  81. ELSE IF (IPOS .NE. 0) THEN
  82. NUMERR = 196
  83. CALL ERREUR (NUMERR)
  84. END IF
  85. *
  86. END
  87.  
  88.  
  89.  

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