Télécharger la plaquette Cast3M


fr en

Télécharger copba2.eso

Retour à la liste

Numérotation des lignes : 

copba2

  1. C COPBA2    SOURCE    CHAT      05/01/12    22:19:27     5004
  2.       SUBROUTINE COPBA2(LCHAIN,ITBAS,ITBA2)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Duplique la table des modes, cr{ation d'un nouveau point rep}- *
  9. *     re, d'un nouveau chpoint, d'un nouveau chamelem, d'une nouvelle*
  10. *     table des d{placements g{neralis{s.                            *
  11. *                                                                    *
  12. *     Param}tres:                                                    *
  13. *                                                                    *
  14. * e   LCHAIN  contient les chaines de caract}res de la table ITBAS.  *
  15. * e   ITBAS   table de sous-type BASE_DE_MODES, contenant les modes, *
  16. *             ou de sous-type PSEUDO_MODE, contenant les pseudo-modes*
  17. * s   ITBA2   table dupliqu{e.                                       *
  18. *                                                                    *
  19. *     Auteur, date de cr{ation:                                      *
  20. *                                                                    *
  21. *     Lionel VIVAN, le 15 mai 1990.                                  *
  22. *                                                                    *
  23. *--------------------------------------------------------------------*
  24. *                                                                    *
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMTABLE
  29. *
  30.       INTEGER LCHAIN(*)
  31. *
  32.       CALL COPIE6(ITBAS,ITBA2)
  33.       MTABLE = ITBAS
  34.       SEGACT MTABLE
  35.       LONG = MLOTAB
  36.       MTAB1 = ITBA2
  37.       SEGACT MTAB1*MOD
  38.       IM = 1
  39.       DO 10 I = 1,LONG
  40.          IF (MTABTI(I).EQ.'ENTIER  ' .AND. MTABII(I).EQ.IM .AND.
  41.      &                   MTABTV(I).EQ.'TABLE   ') THEN
  42.             IM = IM + 1
  43.             ITMOD = MTABIV(I)
  44.             CALL COPIE6(ITMOD,ITMO2)
  45.             MTAB1.MTABIV(I) = ITMO2
  46.             MTAB2 = ITMOD
  47.             SEGACT MTAB2
  48.             LON2 = MTAB2.MLOTAB
  49.             MTAB3 = ITMO2
  50.             SEGACT MTAB3*MOD
  51.             DO 20 I2 = 1,LON2
  52.                IF (MTAB2.MTABTI(I2).EQ.'MOT     ') THEN
  53.                   IF (MTAB2.MTABII(I2).EQ.LCHAIN(1) .AND.
  54.      &                       MTAB2.MTABTV(I2).EQ.'POINT   ') THEN
  55.                      IPTR = MTAB2.MTABIV(I2)
  56.                      CALL COPIE7(IPTR,INOPT)
  57.                      MTAB3.MTABIV(I2) = INOPT
  58.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(2) .AND.
  59.      &                       MTAB2.MTABTV(I2).EQ.'TABLE   ') THEN
  60.                      ITDG = MTAB2.MTABIV(I2)
  61.                      CALL COPIE6(ITDG,ITDG2)
  62.                      MTAB3.MTABIV(I2) = ITDG2
  63.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(3) .AND.
  64.      &                       MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  65.                      ICHD = MTAB2.MTABIV(I2)
  66.                      CALL COPIE2(ICHD,ICHD2)
  67.                      MTAB3.MTABIV(I2) = ICHD2
  68.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(4) .AND.
  69.      &                       MTAB2.MTABTV(I2).EQ.'MCHAML  ') THEN
  70.                      ICHC = MTAB2.MTABIV(I2)
  71.                      CALL COPIE8(ICHC,ICHC2)
  72.                      MTAB3.MTABIV(I2) = ICHC2
  73.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(5) .AND.
  74.      &                       MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  75.                      ICHD = MTAB2.MTABIV(I2)
  76.                      CALL COPIE2(ICHD,ICHD2)
  77.                      MTAB3.MTABIV(I2) = ICHD2
  78.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(6) .AND.
  79.      &                       MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  80.                      ICHD = MTAB2.MTABIV(I2)
  81.                      CALL COPIE2(ICHD,ICHD2)
  82.                      MTAB3.MTABIV(I2) = ICHD2
  83.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(7) .AND.
  84.      &                       MTAB2.MTABTV(I2).EQ.'MCHAML  ') THEN
  85.                      ICHC = MTAB2.MTABIV(I2)
  86.                      CALL COPIE8(ICHC,ICHC2)
  87.                      MTAB3.MTABIV(I2) = ICHC2
  88.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(8) .AND.
  89.      &                       MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  90.                      ICHD = MTAB2.MTABIV(I2)
  91.                      CALL COPIE2(ICHD,ICHD2)
  92.                      MTAB3.MTABIV(I2) = ICHD2
  93.                   ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(9) .AND.
  94.      &                       MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  95.                      ICHD = MTAB2.MTABIV(I2)
  96.                      CALL COPIE2(ICHD,ICHD2)
  97.                      MTAB3.MTABIV(I2) = ICHD2
  98.                   ENDIF
  99.                ENDIF
  100.  20            CONTINUE
  101. *           end do
  102.             SEGDES MTAB2
  103.             SEGDES MTAB3
  104.          ENDIF
  105.  10      CONTINUE
  106. *     end do
  107.       SEGDES MTABLE
  108.       SEGDES MTAB1
  109. *
  110.       END
  111.  
  112.  
  113.  

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