Télécharger la plaquette Cast3M


fr en

Télécharger inser4.eso

Retour à la liste

Numérotation des lignes : 

inser4

  1. C INSER4    SOURCE    FD218221  26/09/21    21:15:08     12652          
  2.       SUBROUTINE INSER4 (MLOBJE,IEME,IPOBJE,XREE,MLOBJ1)
  3. ************************************************************************
  4. *
  5. *                             I N S E R 4
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     INSERER UN OBJET EN I-EME POSITION DANS UN OBJET DE TYPE LISTOBJE.
  12. *
  13. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  14. * -----------
  15. *
  16. *     MLOBJE  ENTIER    (E)  POINTEUR DE LA LISTE DE TYPE "LISTOBJE".
  17. *                            SUPPOSE ACTIF
  18. *     IEME    ENTIER    (E)  POSITION D'INSERTION DE L'OBJET DANS
  19. *                            LA LISTE DE TYPE "LISTOBJE"
  20. *     IPOBJE  ENTIER    (E)  POINTEUR DE L'OBJET A INSERER, SUPPOSE DU
  21. *                            MEME TYPE QUE CEUX CONTENUS DANS MLOBJE
  22. *                            SERA IGNORE SI LE TYPE D'OBJETS CONTENUS
  23. *                            DANS MLOBJE = 'FLOTTANT'
  24. *     XREE    REEL DP   (E)  FLOTTANT A INSERER
  25. *                            SERA IGNORE SI LE TYPE D'OBJETS CONTENUS
  26. *                            DANS MLOBJE != 'FLOTTANT'
  27. *     MLOBJ1  ENTIER    (S)  POINTEUR DE LA LISTE DE TYPE "LISTOBJE" CREE
  28. *
  29. * SOUS-PROGRAMMES APPELES:
  30. * ------------------------
  31. *
  32. *     ERREUR
  33. *
  34. * AUTEUR, DATE DE CREATION:
  35. * -------------------------
  36. *
  37. *     PASCAL MANIGOT     22 FEVRIER 1985
  38. *
  39. * LANGAGE:
  40. * --------
  41. *
  42. *     ESOPE + FORTRAN77
  43. *
  44. ************************************************************************
  45. *
  46.       IMPLICIT INTEGER(I-N)
  47.  
  48. -INC PPARAM
  49. -INC CCOPTIO
  50. -INC SMLOBJE
  51.  
  52.       REAL*8 XREE
  53. *
  54.       SEGACT,MLOBJE
  55.       LDIM = 0
  56. *     Cas des LISTOBJE de FLOTTANT
  57.       IF (TYPOBJ.EQ.'FLOTTANT') THEN
  58.         LDIM = RLIREE(/1)
  59. *     Et des autres
  60.       ELSE
  61.         LDIM = LISOBJ(/1)
  62.       ENDIF
  63.       LDIM1 = LDIM + 1
  64. *
  65. *
  66.       IF (0 .LT. IEME .AND. IEME .LE. LDIM1) THEN
  67. *       Cas des LISTOBJE de FLOTTANT
  68.         IF (TYPOBJ.EQ.'FLOTTANT') THEN
  69.           NOBJ = 0
  70.           NREE = LDIM1
  71. *       Et des autres
  72.         ELSE
  73.           NOBJ = LDIM1
  74.           NREE = 0
  75.         ENDIF
  76.         SEGINI MLOBJ1
  77.         MLOBJ1.TYPOBJ = TYPOBJ
  78. *       Cas des LISTOBJE de FLOTTANT
  79.         IF (TYPOBJ.EQ.'FLOTTANT') THEN
  80.           MLOBJ1.RLIREE(IEME) = XREE
  81.           IF ( IEME .GT . 1 )  THEN
  82.             DO 100 I=1   ,(IEME-1)
  83.               MLOBJ1.RLIREE(I) = MLOBJE.RLIREE(I)
  84.   100       CONTINUE
  85.           ENDIF
  86.           IF ( IEME .LT .LDIM1)  THEN
  87.             DO 110 I= IEME   , LDIM
  88.               MLOBJ1.RLIREE(I + 1 ) = MLOBJE.RLIREE(I)
  89.   110       CONTINUE
  90.           ENDIF
  91. *       Et des autres
  92.         ELSE
  93.           MLOBJ1.LISOBJ(IEME) = IPOBJE
  94.           IF ( IEME .GT . 1 )  THEN
  95.             DO 200 I=1   ,(IEME-1)
  96.               MLOBJ1.LISOBJ(I) = MLOBJE.LISOBJ(I)
  97.   200       CONTINUE
  98.           ENDIF
  99.           IF ( IEME .LT .LDIM1)  THEN
  100.             DO 210 I= IEME   , LDIM
  101.               MLOBJ1.LISOBJ(I + 1 ) = MLOBJE.LISOBJ(I)
  102.   210       CONTINUE
  103.           ENDIF
  104.         ENDIF
  105.         SEGDES,MLOBJ1
  106.       ELSE
  107.         INTERR(1) = IEME
  108.         NUMERR = 36
  109.         CALL ERREUR (NUMERR)
  110.       ENDIF
  111.       SEGDES,MLOBJE
  112. *
  113. *
  114.       END
  115.  
  116.  

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