1 : C RCCON2 SOURCE FANDEUR 10/12/14 21:19:09 6812
2 : SUBROUTINE RCCON2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS,
3 : & ITLIAV)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8(A-H,O-Z)
6 : *--------------------------------------------------------------------*
7 : * *
8 : * Recombine le chpoint ICHPT en contrainte. *
9 : * *
10 : * Param}tres: *
11 : * *
12 : * e IBAS table repr{sentant une base modale *
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 : * *
19 : * Auteur, date de cr{ation: *
20 : * *
21 : * Lionel VIVAN, le 26 avril 1990. *
22 : * *
23 : * REMARQUE :NORMALEMENT CHACUN DES MCHAML DE CONTRAINTE MODALE *
24 : * SONT SIMILAIRES.LES VERIFICATIONS DE CONFORMITE DE *
25 : * CHACUN DES MCHAMLs SERA DONC REDUIT AU MINIMUM. *
26 : * A SAVOIR LES SOUS ZONE PORTE BIEN LE MEME POINTEUR DE *
27 : * MAILLAGE ET LES NOMS DES COMPOSANTES QUE L ON MULTIPLIE *
28 : * SONT IDENTIQUES. *
29 : * *
30 : * Passage aux nouveaux chamelem par jm CAMPENON le 01/91 *
31 : * *
32 : *--------------------------------------------------------------------*
33 : -INC CCOPTIO
34 : -INC SMCOORD
35 : -INC SMCHAML
36 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
37 : SEGMENT ITRA1(NSOUS,4)
38 : SEGMENT TRAV(NPOIN)*D
39 : LOGICAL L0,L1
40 : CHARACTER*8 TYPRET,CHARRE
41 : *
42 : TRAV = KTRAV
43 : ICPR = KCPR
44 : *
44 : CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0,
45 : & 'TABLE',I1,X1,' ',L1,IBBB)
46 : *
47 : * initialisation du MCHAML
48 : *
49 : N1 = 1
49 : CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0,
50 : & 'TABLE',I1,X1,' ',L1,ITBMOD)
51 : TYPRET = ' '
51 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
52 : & TYPRET,I1,X1,CHARRE,L1,IPHC1)
53 : IF (IPHC1.NE.0) THEN
54 : IF (TYPRET.EQ.'MCHAML ') GOTO 100
55 : ENDIF
56 : *
57 : MOTERR(1:8) = 'RCCON2 '
58 : INTERR(1) = N1
58 : CALL ERREUR(169)
59 : RETURN
60 : *
61 : 100 CONTINUE
62 : MCHEL1 = IPHC1
63 : SEGINI,MCHELM=MCHEL1
64 : ICHCO = MCHELM
65 : NSOUS= ICHAML(/1)
66 : SEGINI ITRA1
67 : DO 60 ISOUS=1,NSOUS
68 : ITRA1(ISOUS,1)=IMACHE(ISOUS)
69 : MCHAM1=ICHAML(ISOUS)
70 : SEGINI,MCHAML=MCHAM1
71 : ICHAML(ISOUS)=MCHAML
72 : ITRA1(ISOUS,2)=MCHAML
73 : 60 CONTINUE
74 : *
75 : * boucle sur le nombre de modes
76 : *
77 : IM = 0
78 : 40 CONTINUE
79 : IM = IM + 1
80 : TYPRET = ' '
80 : CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
81 : & TYPRET,I1,X1,CHARRE,L1,ITBMOD)
82 : IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
83 : TYPRET = ' '
83 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
84 : & TYPRET,I1,X1,CHARRE,L1,IPHC1)
85 : C* IF (TYPRET.NE.'MCHAML ') THEN
86 : C* ERREUR ?
87 : C* ENDIF
88 : MCHEL1=IPHC1
89 : SEGACT MCHEL1
90 : DO 42 ISOUS=1,NSOUS
91 : IPMAIL=ITRA1(ISOUS,1)
92 : IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN
93 : SEGDES MCHEL1
93 : CALL ERREUR(21)
94 : GOTO 9990
95 : ENDIF
96 : MCHAM1=MCHEL1.ICHAML(ISOUS)
97 : SEGACT MCHAM1
98 : MCHAML=ITRA1(ISOUS,2)
99 : NCOMP=IELVAL(/1)
100 : DO 30 ICOMP=1,NCOMP
100 : CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
101 : & NOMCHE(ICOMP) )
102 : IF (IPLAC.EQ.0) THEN
103 : SEGDES MCHAM1
104 : SEGDES MCHEL1
104 : CALL ERREUR(21)
105 : GOTO 9990
106 : ENDIF
107 : MELVA1=MCHAM1.IELVAL(IPLAC)
108 : SEGACT MELVA1
109 : N1PTEL = MELVA1.VELCHE(/1)
110 : N1EL = MELVA1.VELCHE(/2)
111 : ITRA1(ISOUS,3) = MAX(ITRA1(ISOUS,3),N1PTEL)
112 : ITRA1(ISOUS,4) = MAX(ITRA1(ISOUS,4),N1EL )
113 : SEGDES MELVA1
114 : 30 CONTINUE
115 : SEGDES MCHAM1
116 : 42 CONTINUE
117 : SEGDES MCHEL1
118 : GOTO 40
119 : ENDIF
120 : NBMODE = IM - 1
121 : *
122 : DO 50 ISOUS=1,NSOUS
123 : MCHAML=ITRA1(ISOUS,2)
124 : N1PTEL = ITRA1(ISOUS,3)
125 : N1EL = ITRA1(ISOUS,4)
126 : N2PTEL = 0
127 : N2EL = 0
128 : NCOMP=IELVAL(/1)
129 : DO 51 ICOMP=1,NCOMP
130 : SEGINI MELVAL
131 : IELVAL(ICOMP) = MELVAL
132 : 51 CONTINUE
133 : 50 CONTINUE
134 : *
135 : * boucle sur les contraintes modales
136 : *
137 : DO 300 IM = 1,NBMODE
137 : CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0,
138 : & 'TABLE',I1,X1,' ',L1,ITBMOD)
138 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,
139 : & 'POINT',I1,X1,' ',L1,IPTR)
140 : TYPRET = ' '
140 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CONTRAINTE_MODALE',L0,IP0,
141 : & TYPRET,I1,X1,CHARRE,L1,IPHC1)
142 : C* IF (TYPRET.NE.'MCHAML ') THEN
143 : C* ERREUR ?
144 : C* ENDIF
145 : IMODE = ICPR(IPTR)
146 : IF (IMODE.EQ.0) THEN
147 : *
148 : * on ne trouve pas la contrainte modale
149 : *
150 : MOTERR(1:8) = 'RCCON2'
151 : INTERR(1) = IM
151 : CALL ERREUR(169)
151 : CALL DTCHAM(ICHCO)
152 : GOTO 9990
153 : ENDIF
154 : XVAL = TRAV(IMODE)
155 : MCHEL1 = IPHC1
156 : SEGACT MCHEL1
157 : NSOU1 = MCHEL1.ICHAML(/1)
158 : DO 320 ISOU1 = 1,NSOU1
159 : MCHAML=ITRA1(ISOU1,2)
160 : MCHAM1=MCHEL1.ICHAML(ISOU1)
161 : SEGACT MCHAM1
162 : NCOMP=IELVAL(/1)
163 : DO 342 ICOMP=1,NCOMP
163 : CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC,
164 : & NOMCHE(ICOMP) )
165 : MELVA1=MCHAM1.IELVAL(IPLAC)
166 : SEGACT MELVA1
167 : MELVAL=IELVAL(ICOMP)
168 : DO 344 IGAU=1,VELCHE(/1)
169 : IGMN=MIN(IGAU,MELVA1.VELCHE(/1))
170 : DO 344 IB=1,VELCHE(/2)
171 : IBMN=MIN(IB ,MELVA1.VELCHE(/2))
172 : VELCHE(IGAU,IB)=VELCHE(IGAU,IB)
173 : & +XVAL*MELVA1.VELCHE(IGMN,IBMN)
174 : 344 CONTINUE
175 : SEGDES MELVA1
176 : 342 CONTINUE
177 : SEGDES MCHAM1
178 : 320 CONTINUE
179 : SEGDES MCHEL1
180 : 300 CONTINUE
181 : DO 61 ISOUS=1,NSOUS
182 : MCHAML=ITRA1(ISOUS,2)
183 : NCOMP=IELVAL(/1)
184 : DO 62 ICOMP=1,NCOMP
185 : MELVAL=IELVAL(ICOMP)
186 : SEGDES MELVAL
187 : 62 CONTINUE
188 : SEGDES MCHAML
189 : 61 CONTINUE
190 : SEGDES MCHELM
191 : *
192 : * Prise en compte des pseudo-modes
193 : *
194 : IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN
195 : TYPRET = ' '
195 : CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
196 : & TYPRET,I1,X1,CHARRE,L1,ITPS)
197 : IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
197 : CALL PSRCD2('CONT',ITPS,IBBB,ICHCO,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
198 : ELSE
198 : CALL ERREUR(429)
199 : ENDIF
200 : ENDIF
201 : RETURN
202 : *
203 : 9990 CONTINUE
204 : DO 71 ISOUS=1,NSOUS
205 : MCHAML=ITRA1(ISOUS,2)
206 : SEGSUP MCHAML
207 : 71 CONTINUE
208 : SEGSUP ITRA1
209 : C* SEGSUP MCHELM
210 :
211 : RETURN
212 : END
213 :
214 :
© Cast3M 2003 - All rights reserved.
Disclaimer