1 : C RCDEPL SOURCE CHAT 05/01/13 02:46:01 5004
2 : SUBROUTINE RCDEPL(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA,ITYP)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Recombine les d{placements modaux au temps XTEMP *
8 : * *
9 : * Param}tres: *
10 : * *
11 : * e ITBAS table repr{sentant une base modale *
12 : * e ICHPT chpoint modal @ recombiner *
13 : * e KCHAR chargement de la structure *
14 : * e XTEMP temps de recombinaison *
15 : * e ITRES table r{sultat issue de l'op{rateur DYNE *
16 : * e IPOS position de XTEMP dans le listreel des temps *
17 : * e ITLIA table des liaisons *
18 : * e ITYP = 0 , on recombine les d{placements *
19 : * = 2 , on recombine les r{actions *
20 : * *
21 : * Auteur, date de cr{ation: *
22 : * *
23 : * Lionel VIVAN, le 18 avril 1990. *
24 : * *
25 : *--------------------------------------------------------------------*
26 : -INC CCOPTIO
27 : -INC SMCHPOI
28 : -INC SMELEME
29 : -INC SMCOORD
30 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
31 : SEGMENT TRAV(NPOIN)*D
32 : LOGICAL L0,L1
33 : CHARACTER*8 TYPRET,CHARRE
34 : CHARACTER*40 TYPBAS
35 : *
36 : * on met les contributions modales ICHPT dans ICPR et TRAV
37 : *
38 : MCHPOI = ICHPT
39 : IF (MCHPOI.EQ.0) THEN
40 : * le CHPOINT des contributions modales est nul
41 : MOTERR(1:8) = 'RCDEPL'
41 : CALL ERREUR(170)
42 : RETURN
43 : ENDIF
44 : SEGINI ICPR
45 : KCPR = ICPR
46 : SEGACT MCHPOI
47 : NSOU = IPCHP(/1)
48 : IKI = 0
49 : DO 10 ISOU = 1,NSOU
50 : MSOUPO = IPCHP(ISOU)
51 : SEGACT MSOUPO
52 : * on cherche un CHPOINT qui conteint des contributions modales
53 : IF (NOCOMP(/2).NE.1) THEN
53 : CALL ERREUR(188)
54 : SEGDES MSOUPO
55 : SEGDES MCHPOI
56 : SEGSUP ICPR
57 : RETURN
58 : ENDIF
59 : IF (NOCOMP(1).NE.'ALFA') THEN
59 : CALL ERREUR(188)
60 : SEGDES MSOUPO
61 : SEGDES MCHPOI
62 : SEGSUP ICPR
63 : RETURN
64 : ENDIF
65 : MELEME = IGEOC
66 : SEGACT MELEME
67 : N2 = NUM(/2)
68 : DO 12 I = 1,N2
69 : IKI = IKI + 1
70 : ICPR(NUM(1,I)) = IKI
71 : 12 CONTINUE
72 : SEGDES MELEME,MSOUPO
73 : 10 CONTINUE
74 : NPOIN = IKI
75 : SEGINI TRAV
76 : KTRAV = TRAV
77 : IKI = 0
78 : DO 20 ISOU = 1,NSOU
79 : MSOUPO = IPCHP(ISOU)
80 : SEGACT MSOUPO
81 : MPOVAL = IPOVAL
82 : SEGACT MPOVAL
83 : N2 = VPOCHA(/1)
84 : DO 22 I = 1,N2
85 : IKI = IKI + 1
86 : TRAV(IKI) = VPOCHA(I,1)
87 : 22 CONTINUE
88 : SEGDES MPOVAL,MSOUPO
89 : 20 CONTINUE
90 : SEGDES MCHPOI
91 : *
91 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
92 : & 'MOT',I1,X1,TYPBAS,L1,IP1)
93 : *
94 : * Cas oº la base est unique
95 : *
96 : IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
96 : CALL RCDEP2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS,
97 : & ITLIA,ITYP)
98 : IF (IERR.NE.0) THEN
99 : SEGSUP TRAV,ICPR
100 : RETURN
101 : ENDIF
102 : *
103 : * Cas où on a un ensemble de bases
104 : *
105 : ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
106 : *
107 : * On boucle sur le nombre de bases
108 : *
109 : IB = 0
110 : 30 CONTINUE
111 : TYPRET = ' '
112 : IB = IB + 1
112 : CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
113 : & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
114 : IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
114 : CALL RCDEP2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS,
115 : & ITLIA,ITYP)
116 : IF (IERR.NE.0) THEN
117 : SEGSUP TRAV,ICPR
118 : RETURN
119 : ENDIF
120 : IF (IB.EQ.1) THEN
121 : ICHDE = IRET
122 : ELSE
123 : N1 = 1
123 : CALL ADCHPO(ICHDE,IRET,ICHDE,1D0,1D0)
124 : ENDIF
125 : GOTO 30
126 : ENDIF
127 : ENDIF
128 : *
129 : SEGSUP TRAV,ICPR
130 : *
130 : CALL ECROBJ('CHPOINT ',ICHDE)
131 : *
132 : END
133 :
134 :
© Cast3M 2003 - All rights reserved.
Disclaimer