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    FD218221  26/09/21    21:15:16     12652          
  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. *        LISTOBJE             ENTIER           OBJET
  34. *
  35. * MODE DE FONCTIONNEMENT:
  36. * -----------------------
  37. *
  38. *     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET
  39. *     "OBJET".
  40. *
  41. * AUTEUR, DATE DE CREATION:
  42. * -------------------------
  43. *
  44. *     PASCAL MANIGOT     5 DECEMBRE 1984
  45. *              MODIF LE 22 JANVIER 1988
  46. * LANGAGE:
  47. * --------
  48. *
  49. *     FORTRAN77
  50. *
  51. ************************************************************************
  52. *
  53.       IMPLICIT INTEGER(I-N)
  54.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57. -INC SMLOBJE
  58. *
  59.       REAL*8 REELDP
  60.       CHARACTER *4 LEMOT
  61. *
  62. *
  63. *     IPOS=0 => on interdit a IPOIN2 de contenir un LISTENTI
  64.       IPOS=0
  65.       CALL LIRE01 (IPOIN1,IPOS,IPOIN2)
  66.       IF (IERR .NE. 0) RETURN
  67. *
  68.       IF (IPOS .EQ. 1) THEN
  69.          CALL LIRREE (REELDP,1,IRETOU)
  70.          CALL INSER5 (IPOIN1,IPOIN2,REELDP,IPOIN3)
  71.          CALL ECROBJ ('LISTREEL',IPOIN3)
  72.       ELSE IF (IPOS .EQ. 2) THEN
  73.          CALL LIRENT (IPOIN3,1,IRETOU)
  74.          CALL INSER6 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)
  75.          CALL ECROBJ ('LISTENTI',IPOIN4)
  76.       ELSE IF (IPOS .EQ. 3) THEN
  77.          CALL LIRCHA (LEMOT,1,IRETOU)
  78.           IF (IERR.NE.0) RETURN
  79.          CALL INSER7 (IPOIN1,IPOIN2,LEMOT,IPOIN3)
  80.          CALL ECROBJ ('LISTMOTS',IPOIN3)
  81.       ELSE IF (IPOS .EQ. 4) THEN
  82.          CALL LIROBJ ('CHPOINT',IPOIN3,1,IRETOU)
  83.          CALL INSER8 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)
  84.          CALL ECROBJ ('LISTCHPO',IPOIN4)
  85.       ELSE IF (IPOS .EQ. 5) THEN
  86.          MLOBJE=IPOIN1
  87.          SEGACT,MLOBJE
  88.          IF (TYPOBJ.EQ.'FLOTTANT') THEN
  89.            CALL LIRREE (REELDP,1,IRETOU)
  90.          ELSE
  91.            CALL LIROBJ(TYPOBJ,IPOIN3,1,IRETOU)
  92.          ENDIF
  93.          SEGDES,MLOBJE
  94.          CALL INSER4 (IPOIN1,IPOIN2,IPOIN3,REELDP,IPOIN4)
  95.          CALL ECROBJ ('LISTOBJE',IPOIN4)
  96.       ELSE IF (IPOS .NE. 0) THEN
  97.          NUMERR = 196
  98.          CALL ERREUR (NUMERR)
  99.       END IF
  100. *
  101.       END
  102.  
  103.  
  104.  
  105.  

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