Télécharger la plaquette Cast3M


fr en

Télécharger ooosus.eso

Retour à la liste

Numérotation des lignes : 

ooosus

  1. C OOOSUS    SOURCE    PV090527  26/04/24    08:23:23     12524          
  2.       SUBROUTINE OOOSUS (IDMK)
  3. C-----------------------------------------------------------------------
  4. C
  5. C                   ECLATEMENT D'UN SUPER SEGMENT
  6. C
  7. C     IDMK     DESCRIPTEUR DU MARQUEUR DU SUPER SEGMENT
  8. C
  9. C              LE MARQUEUR DU SUPER SEGMENT EST SUPPRIME
  10. C              LES COMPOSANTS SONT INSERES :
  11. C                - DEVANT LE SEGMENT QUI PRECEDE LE MARQUEUR
  12. C                  S'ILS APPARTIENNENT A LA MEME CHAINE
  13. C                - EN QUEUE DE LA CHAINE CORRESPONDANT A LEUR TYPE
  14. C                  OU EN TETE SUIVANT LE CAS
  15. C
  16. C PROGRAMMEUR : MOUGIN
  17. C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT   LRET  DU CALL OOOSUG
  18. C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT ->LRET
  19. C       MODIF : 17/01/89    SUPPRIMER L'ARGUMENT   LRET  DU CALL OOODLB
  20. C
  21. C-----------------------------------------------------------------------
  22. C
  23. %INC IOOADR
  24. %INC IOOADZ
  25. %INC IOODES
  26. %INC IOOSGM
  27. C
  28.       ITYPMK=MDTYP(IDMK)
  29.       ICHNMK=MDNCHN(ITYPMK)
  30.       ISMK  =MDISG(IDMK)
  31.       IF (S S ACTIF(ISMK)) THEN
  32.          MZJSS(ACTACTIF)=MZJSS(ACTACTIF)-1
  33.          MZJSM(ACTACTIF)=MZJSM(ACTACTIF)-(MSLMARK)
  34.       ENDIF
  35. C
  36.  
  37. C                PARCOURT LES COMPOSANTS DU SUPER-SEGMENT
  38.  
  39.       ISX=ISMK+MSLMARK
  40.       ISF=ISX +MSMARK(ISMK)
  41.       DO WHILE (ISX.LT.ISF)
  42.         LSX      = MSLS1(ISX)
  43.         IDX      = MSIDE(ISX)
  44.         MDMK(IDX)= 0
  45.         ITYPX    = MDTYP(IDX)
  46.         MDCAT(ITYPX)=MDISOLE
  47.         ICHNX=MDNCHN(ITYPX)
  48.         MDTYP(IDX)=ITYPX
  49.         IF     (ICHNX.EQ.ICHNMK)                       THEN
  50.            IDEA=MSIDP(ISMK)
  51.         ELSEIF (ICHNX.EQ.MRU)                          THEN
  52.            IDEA=MSIDS(MDISG(MDACHN(MRU)))
  53.         ELSE
  54.            IDEA=MDACHN(ICHNX)
  55.         ENDIF
  56.         IF (IDEA.NE.IDX)                               THEN
  57.            MDCHN , IDEA(IDX)
  58.         ENDIF
  59.         ISX=ISX+LSX
  60.       ENDDO
  61.  
  62. C      SUPPRIME LE MARQUEUR
  63.  
  64.       ITRK = MDTRK(IDMK)
  65.       IF (ITRK.GT.0) CALL OOODLB (MZPTRK,ITRK)
  66.       MDCAT(ITYPMK)=MDISOLE
  67.       MDTYP(IDMK)=ITYPMK
  68.       CALL OOOSUG (IDMK)
  69.       MZJSS(ACTUEL)=MZJSS(ACTUEL)-1
  70.       MZJSM(ACTUEL)=MZJSM(ACTUEL)-(MSLMARK)
  71.  
  72.       END
  73.  
  74.  

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