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.  
  54. -INC PPARAM
  55. -INC CCOPTIO
  56. *
  57. REAL*8 REELDP
  58. CHARACTER *4 LEMOT
  59. *
  60. *
  61. * IPOS=0 => on interdit à IPOIN2 de contenir un LISTENTI
  62. IPOS=0
  63. CALL LIRE01 (IPOIN1,IPOS,IPOIN2)
  64. IF (IERR .NE. 0) RETURN
  65. *
  66. IF (IPOS .EQ. 1) THEN
  67. CALL LIRREE (REELDP,1,IRETOU)
  68. CALL INSER5 (IPOIN1,IPOIN2,REELDP,IPOIN3)
  69. CALL ECROBJ ('LISTREEL',IPOIN3)
  70. ELSE IF (IPOS .EQ. 2) THEN
  71. CALL LIRENT (IPOIN3,1,IRETOU)
  72. CALL INSER6 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)
  73. CALL ECROBJ ('LISTENTI',IPOIN4)
  74. ELSE IF (IPOS .EQ. 3) THEN
  75. CALL LIRCHA (LEMOT,1,IRETOU)
  76. IF (IERR.NE.0) RETURN
  77. CALL INSER7 (IPOIN1,IPOIN2,LEMOT,IPOIN3)
  78. CALL ECROBJ ('LISTMOTS',IPOIN3)
  79. ELSE IF (IPOS .EQ. 4) THEN
  80. CALL LIROBJ ('CHPOINT',IPOIN3,1,IRETOU)
  81. CALL INSER8 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)
  82. CALL ECROBJ ('LISTCHPO',IPOIN4)
  83. ELSE IF (IPOS .NE. 0) THEN
  84. NUMERR = 196
  85. CALL ERREUR (NUMERR)
  86. END IF
  87. *
  88. END
  89.  
  90.  
  91.  

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