Télécharger la plaquette Cast3M


fr en

Télécharger enlev6.eso

Retour à la liste

Numérotation des lignes : 

enlev6

  1. C ENLEV6    SOURCE    CHAT      05/01/12    23:40:02     5004
  2.       SUBROUTINE ENLEV6 (IPTABL,  IPTAB2)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. *                             E N L E V 6
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     ENLEVER UN ELEMENT D'UNE "TABLE".
  14. *
  15. * MODULES UTILISES:
  16. * -----------------
  17. *
  18.  
  19. -INC PPARAM
  20. -INC CCOPTIO
  21. -INC SMTABLE
  22. *
  23. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  24. * -----------
  25. *
  26. *     IPTABL  (E)  TABLE A REDUIRE.
  27. *     INDICE       INDICE DE L'OBJET A ENLEVER.
  28. *     TYPIND       TYPE DE L'INDICE DE L'OBJET A ENLEVER.
  29. *     IPTAB2  (S)  TABLE REDUITE.
  30. *
  31.       CHARACTER*(8) TYPIND
  32. *
  33. * AUTEUR, DATE DE CREATION:
  34. * -------------------------
  35. *
  36. *     PASCAL MANIGOT     21 JUIN 1988
  37. *
  38. * LANGAGE:
  39. * --------
  40. *
  41. *     ESOPE + FORTRAN77
  42. *
  43. ************************************************************************
  44. *
  45.  
  46.       CALL QUETYP ( TYPIND,1,IRETOU)
  47.       IF(IERR.NE.0) RETURN
  48.       IF(TYPIND.EQ.'FLOTTANT' ) THEN
  49.         CALL LIRREE ( XVA,1,IRETOU)
  50.       ELSE
  51.          CALL LIROBJ ( TYPIND , INDICE, 1,IRETOU)
  52.       ENDIF
  53.       IF ( IERR.NE.0) RETURN
  54.       MTABLE = IPTABL
  55.       SEGACT,MTABLE
  56.       M = MLOTAB
  57.       M0 = 0
  58.       IF (TYPIND.EQ.'FLOTTANT')  THEN
  59.          DO 103 I=1,M
  60.            IF( RMTABI(I) . EQ. XVA) THEN
  61.              M0 = I
  62.              GO TO 102
  63.            ENDIF
  64.   103    CONTINUE
  65.       ELSE
  66.       DO 100 I=1,M
  67.          IF (MTABTI(I) .EQ. TYPIND) THEN
  68.             IF (MTABII(I) .EQ. INDICE) THEN
  69.                M0 = I
  70.                GOTO 102
  71.             END IF
  72.          END IF
  73.   100    CONTINUE
  74. *     END DO
  75.       ENDIF
  76.   102 CONTINUE
  77. *
  78.       IF (M0 .EQ. 0) THEN
  79.          CALL ERREUR (171)
  80.          RETURN
  81.       END IF
  82. *
  83.       M = M - 1
  84.       SEGINI,MTAB2
  85.       MTAB2.MLOTAB=M
  86.       IPTAB2 = MTAB2
  87. *
  88.       DO 200 I=1,(M0-1)
  89.          MTAB2.MTABTI(I) = MTABLE.MTABTI(I)
  90.          MTAB2.MTABTV(I) = MTABLE.MTABTV(I)
  91.          MTAB2.RMTABI(I) = MTABLE.RMTABI(I)
  92.          MTAB2.MTABII(I) = MTABLE.MTABII(I)
  93.          MTAB2.MTABIV(I) = MTABLE.MTABIV(I)
  94.          MTAB2.RMTABV(I) = MTABLE.RMTABV(I)
  95.   200    CONTINUE
  96. *     END DO
  97.       DO 210 I=M0,M
  98.          MTAB2.MTABTI(I) = MTABLE.MTABTI(I+1)
  99.          MTAB2.MTABTV(I) = MTABLE.MTABTV(I+1)
  100.          MTAB2.RMTABI(I) = MTABLE.RMTABI(I+1)
  101.          MTAB2.MTABII(I) = MTABLE.MTABII(I+1)
  102.          MTAB2.MTABIV(I) = MTABLE.MTABIV(I+1)
  103.          MTAB2.RMTABV(I) = MTABLE.RMTABV(I+1)
  104.   210    CONTINUE
  105. *     END DO
  106. *
  107.       SEGDES,MTABLE
  108.       SEGDES,MTAB2
  109. *
  110.       END
  111.  
  112.  
  113.  

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