Télécharger la plaquette Cast3M


fr en

Télécharger insere.eso

Retour à la liste

Numérotation des lignes : 

insere

  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