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 : -INC CCOPTIO
26 : -INC SMTABLE
27 : *
28 : INTEGER LCHAIN(*)
29 : *
29 : CALL COPIE6(ITBAS,ITBA2)
30 : MTABLE = ITBAS
31 : SEGACT MTABLE
32 : LONG = MLOTAB
33 : MTAB1 = ITBA2
34 : SEGACT MTAB1*MOD
35 : IM = 1
36 : DO 10 I = 1,LONG
37 : IF (MTABTI(I).EQ.'ENTIER ' .AND. MTABII(I).EQ.IM .AND.
38 : & MTABTV(I).EQ.'TABLE ') THEN
39 : IM = IM + 1
40 : ITMOD = MTABIV(I)
40 : CALL COPIE6(ITMOD,ITMO2)
41 : MTAB1.MTABIV(I) = ITMO2
42 : MTAB2 = ITMOD
43 : SEGACT MTAB2
44 : LON2 = MTAB2.MLOTAB
45 : MTAB3 = ITMO2
46 : SEGACT MTAB3*MOD
47 : DO 20 I2 = 1,LON2
48 : IF (MTAB2.MTABTI(I2).EQ.'MOT ') THEN
49 : IF (MTAB2.MTABII(I2).EQ.LCHAIN(1) .AND.
50 : & MTAB2.MTABTV(I2).EQ.'POINT ') THEN
51 : IPTR = MTAB2.MTABIV(I2)
51 : CALL COPIE7(IPTR,INOPT)
52 : MTAB3.MTABIV(I2) = INOPT
53 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(2) .AND.
54 : & MTAB2.MTABTV(I2).EQ.'TABLE ') THEN
55 : ITDG = MTAB2.MTABIV(I2)
55 : CALL COPIE6(ITDG,ITDG2)
56 : MTAB3.MTABIV(I2) = ITDG2
57 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(3) .AND.
58 : & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
59 : ICHD = MTAB2.MTABIV(I2)
59 : CALL COPIE2(ICHD,ICHD2)
60 : MTAB3.MTABIV(I2) = ICHD2
61 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(4) .AND.
62 : & MTAB2.MTABTV(I2).EQ.'MCHAML ') THEN
63 : ICHC = MTAB2.MTABIV(I2)
63 : CALL COPIE8(ICHC,ICHC2)
64 : MTAB3.MTABIV(I2) = ICHC2
65 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(5) .AND.
66 : & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
67 : ICHD = MTAB2.MTABIV(I2)
67 : CALL COPIE2(ICHD,ICHD2)
68 : MTAB3.MTABIV(I2) = ICHD2
69 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(6) .AND.
70 : & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
71 : ICHD = MTAB2.MTABIV(I2)
71 : CALL COPIE2(ICHD,ICHD2)
72 : MTAB3.MTABIV(I2) = ICHD2
73 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(7) .AND.
74 : & MTAB2.MTABTV(I2).EQ.'MCHAML ') THEN
75 : ICHC = MTAB2.MTABIV(I2)
75 : CALL COPIE8(ICHC,ICHC2)
76 : MTAB3.MTABIV(I2) = ICHC2
77 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(8) .AND.
78 : & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
79 : ICHD = MTAB2.MTABIV(I2)
79 : CALL COPIE2(ICHD,ICHD2)
80 : MTAB3.MTABIV(I2) = ICHD2
81 : ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(9) .AND.
82 : & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
83 : ICHD = MTAB2.MTABIV(I2)
83 : CALL COPIE2(ICHD,ICHD2)
84 : MTAB3.MTABIV(I2) = ICHD2
85 : ENDIF
86 : ENDIF
87 : 20 CONTINUE
88 : * end do
89 : SEGDES MTAB2
90 : SEGDES MTAB3
91 : ENDIF
92 : 10 CONTINUE
93 : * end do
94 : SEGDES MTABLE
95 : SEGDES MTAB1
96 : *
97 : END
98 :
99 :
© Cast3M 2003 - All rights reserved.
Disclaimer