1 : C RCCONT SOURCE FANDEUR 10/12/14 21:19:11 6812
2 : SUBROUTINE RCCONT(ITBAS,ICHPT,KCHAR,XTEMP,ITRES,IPOS,ITLIA)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Recombine le chpoint ICHPT en contrainte. *
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 : * *
19 : * Auteur, date de cr{ation: *
20 : * *
21 : * Lionel VIVAN, le 26 avril 1990. *
22 : * *
23 : *--------------------------------------------------------------------*
24 : -INC CCOPTIO
25 : -INC SMCHPOI
26 : -INC SMELEME
27 : -INC SMCOORD
28 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
29 : SEGMENT TRAV(NPOIN)*D
30 : LOGICAL L0,L1
31 : CHARACTER*8 TYPRET,CHARRE
32 : CHARACTER*40 TYPBAS
33 : *
34 : * on met les contributions modales ICHPT dans ICPR et TRAV
35 : *
36 : MCHPOI = ICHPT
37 : IF (MCHPOI.EQ.0) THEN
38 : * le CHPOINT des contributions modales est nul
39 : MOTERR(1:8) = 'RCCONT'
39 : CALL ERREUR(170)
40 : RETURN
41 : ENDIF
42 : SEGINI ICPR
43 : KCPR = ICPR
44 : SEGACT MCHPOI
45 : NSOU = IPCHP(/1)
46 : IKI = 0
47 : DO 10 ISOU = 1,NSOU
48 : MSOUPO = IPCHP(ISOU)
49 : SEGACT MSOUPO
50 : * on cherche un CHPOINT qui contient des contributions modales
51 : IF (NOCOMP(/2).NE.1) THEN
51 : CALL ERREUR(188)
52 : SEGDES MSOUPO
53 : SEGDES MCHPOI
54 : GOTO 991
55 : ENDIF
56 : IF (NOCOMP(1).NE.'ALFA') THEN
56 : CALL ERREUR(188)
57 : SEGDES MSOUPO
58 : SEGDES MCHPOI
59 : GOTO 991
60 : ENDIF
61 : MELEME = IGEOC
62 : SEGACT MELEME
63 : N2 = NUM(/2)
64 : DO 12 I = 1,N2
65 : IKI = IKI + 1
66 : ICPR(NUM(1,I)) = IKI
67 : 12 CONTINUE
68 : SEGDES MELEME,MSOUPO
69 : 10 CONTINUE
70 : NPOIN = IKI
71 : SEGINI TRAV
72 : KTRAV = TRAV
73 : IKI = 0
74 : DO 20 ISOU = 1,NSOU
75 : MSOUPO = IPCHP(ISOU)
76 : SEGACT MSOUPO
77 : MPOVAL = IPOVAL
78 : SEGACT MPOVAL
79 : N2 = VPOCHA(/1)
80 : DO 22 I = 1,N2
81 : IKI = IKI + 1
82 : TRAV(IKI) = VPOCHA(I,1)
83 : 22 CONTINUE
84 : SEGDES MPOVAL,MSOUPO
85 : 20 CONTINUE
86 : SEGDES MCHPOI
87 : *
87 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
88 : & 'MOT',I1,X1,TYPBAS,L1,IP1)
89 : *
90 : * Cas oº la base est unique
91 : *
92 : IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
92 : CALL RCCON2(ITBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHCO,ITRES,IPOS,
93 : & ITLIA)
94 : IF (IERR.NE.0) GOTO 990
95 : *
96 : * Cas oº on a un ensemble de bases
97 : *
98 : ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
99 : *
100 : * On boucle sur le nombre de bases
101 : *
102 : IB = 0
103 : 30 CONTINUE
104 : TYPRET = ' '
105 : IB = IB + 1
105 : CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
106 : & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
107 : IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
107 : CALL RCCON2(ITTBAS,KTRAV,KCPR,KCHAR,XTEMP,IRET,ITRES,IPOS,
108 : & ITLIA)
109 : IF (IERR.NE.0) GOTO 990
110 : IF (IB.EQ.1) THEN
111 : ICHCO = IRET
112 : ELSE
113 : N1 = 1
113 : CALL ADCHEL(ICHCO,IRET,ICHCO,N1)
114 : ENDIF
115 : GOTO 30
116 : ENDIF
117 : ENDIF
118 : *
118 : CALL ECROBJ('MCHAML',ICHCO)
119 : *
120 : 990 CONTINUE
121 : SEGSUP,TRAV
122 : 991 CONTINUE
123 : SEGSUP,ICPR
124 : *
125 : RETURN
126 : END
127 :
128 :
© Cast3M 2003 - All rights reserved.
Disclaimer