1 : C SYMTRI SOURCE PV 12/12/06 21:15:29 7594
2 :
3 : C Creation des (matrices de) RIGIDITE associees a des conditions de
4 : C SYMETRIE (operateur SYMT) et d'ANTISYMETRIE (operateur ANTI).
5 :
6 : C Syntaxe : SYMT ('DEPL')('ROTA') MELEME P1 (P2) (P3) (FLOT1) ;
7 : C ANTI ('DEPL')('ROTA') MELEME P1 (P2) (P3) (FLOT1) ;
8 :
9 : C 10/2003 : modifications pour integrer cas IDIM=1.
10 : C En dimension 1, ces operateurs ne sont pas disponibles.
11 : C L'utilisation de l'operateur BLOQUE est suffisante !
12 :
13 : SUBROUTINE SYMTRI(ityp)
14 :
15 : IMPLICIT INTEGER(I-N)
16 : IMPLICIT REAL*8 (A-H,O-Z)
17 :
18 :
19 : -INC CCOPTIO
20 : -INC SMCOORD
21 :
22 : C** DIMENSION XNORM(3)
23 : COMMON / CSYMTR / XNORM(3)
24 :
25 : DIMENSION U1(3),U2(3)
26 : CHARACTER*4 MOTBLO(2)
27 : DATA MOTBLO / 'DEPL','ROTA' /
28 :
29 : C Operateurs SYMT et ANTI indisponibles en dimension 1
30 : IF (IDIM.EQ.1) THEN
31 : INTERR(1)=IDIM
31 : CALL ERREUR(709)
32 : RETURN
33 : ENDIF
34 :
35 : idimp1=IDIM+1
36 : C Signification de ITYP :
37 : C ITYP = 0 si operateur SYMT , ITYP = 1 si operateur ANTI
38 :
39 : C Lecture de DEPL ou ROTA pour permettre la lecture de la suite
40 : C Signification de IDEPL et IROTA :
41 : C IDEPL=1 (IROTA=1) si mot-cle 'DEPL' ('ROTA') active et =0 sinon
42 : IDEPL=0
43 : IROTA=0
43 : CALL LIRMOT(MOTBLO,2,IMOT,1)
44 : IF (IERR.NE.0) RETURN
45 : 10 IF (IMOT.EQ.1) IDEPL=1
46 : IF (IMOT.EQ.2) IROTA=1
46 : CALL LIRMOT(MOTBLO,2,IMOT,0)
47 : IF (IMOT.NE.0) GOTO 10
48 :
49 : C Appel a POIEXT pour recuperer le bon ensemble de POINTS
50 : IF (IDIM.EQ.2) THEN
50 : CALL ECRCHA('DROI')
51 : ELSE
51 : CALL ECRCHA('PLAN')
52 : ENDIF
52 : CALL POIEXT
53 : C En 2D et 3D, lecture de l'ensemble des points, ecrit dans la pile
54 : C suite a l'appel a POIEXT, soumis a la condition de (anti)symetrie.
54 : CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
55 : IF (IERR.NE.0) RETURN
56 : C On construit U1 et U2 perpendiculaires a XNORM (COMMON CSYMTR)
57 : C Attention en DIME 2 : XNORM est le vecteur directeur de la droite
58 : C Ces vecteurs U1 et U2 sont utilises dans le cas IROTA=1.
59 : IF (IDIM.EQ.2) THEN
60 : XTEMP=-XNORM(2)
61 : XNORM(2)=XNORM(1)
62 : XNORM(1)=XTEMP
63 : ENDIF
64 : U1(1)=-XNORM(2)
65 : U1(2)=XNORM(1)
66 : U1(3)=0.D0
67 : SU1=SQRT(U1(1)**2+U1(2)**2)
68 : IF (SU1.GE.0.1) THEN
69 : U1(1)=U1(1)/SU1
70 : U1(2)=U1(2)/SU1
71 : ELSE
72 : U1(1)=0.D0
73 : U1(2)=-XNORM(3)
74 : U1(3)=XNORM(2)
75 : SU1=SQRT(U1(2)**2+U1(3)**2)
76 : U1(2)=U1(2)/SU1
77 : U1(3)=U1(3)/SU1
78 : ENDIF
79 : U2(1)=XNORM(2)*U1(3)-XNORM(3)*U1(2)
80 : U2(2)=XNORM(3)*U1(1)-XNORM(1)*U1(3)
81 : U2(3)=XNORM(1)*U1(2)-XNORM(2)*U1(1)
82 :
83 : IF (ITYP.EQ.1) GOTO 500
84 : C CONDITION DE SYMETRIE :
85 : C -------------------------
86 : C Cas 'DEPL' : creation du point associe a la "direction"
87 : IF (IDEPL.EQ.1) THEN
88 : NBPTS=XCOOR(/1)/idimp1+1
89 : SEGADJ MCOORD
90 : IPoin=(NBPTS-1)*idimp1
91 : XCOOR(IPoin+1)=XNORM(1)
92 : XCOOR(IPoin+2)=XNORM(2)
93 : IF (IDIM.EQ.3) XCOOR(IPoin+3)=XNORM(3)
94 : XCOOR(IPoin+idimp1)=0.
95 : C Appel a BLOQU 'DEPL' 'DIRE' Poin1
95 : CALL ECROBJ('POINT ',NBPTS)
95 : CALL ECRCHA('DIRE')
95 : CALL ECRCHA('DEPL')
95 : CALL ECROBJ('MAILLAGE',MELEME)
95 : CALL BLOQUE
96 : SEGACT MCOORD*mod
97 : ENDIF
98 : C Cas 'ROTA' : creation des points associes a la "direction"
99 : C En 2D, on fait seulement BLOQUER 'ROTA'
100 : IF (IROTA.EQ.1) THEN
101 : IF (IDIM.EQ.2) THEN
101 : CALL ECRCHA('ROTA')
101 : CALL ECROBJ('MAILLAGE',MELEME)
101 : CALL BLOQUE
102 : SEGACT MCOORD*MOD
103 : ELSE
104 : NBPTA=XCOOR(/1)/idimp1
105 : NBPTS=NBPTA+2
106 : SEGADJ MCOORD
107 : XCOOR(NBPTA*idimp1+1)=U1(1)
108 : XCOOR(NBPTA*idimp1+2)=U1(2)
109 : XCOOR(NBPTA*idimp1+3)=U1(3)
110 : XCOOR((NBPTA+1)*idimp1)=0.D0
111 : NBPTA=NBPTA+1
112 : C Appel a BLOQU 'ROTA' 'DIRE' Poin1
112 : CALL ECROBJ('POINT ',NBPTA)
112 : CALL ECRCHA('DIRE')
112 : CALL ECRCHA('ROTA')
112 : CALL ECROBJ('MAILLAGE',MELEME)
112 : CALL BLOQUE
113 : SEGACT MCOORD*MOD
114 : XCOOR(NBPTA*idimp1+1)=U2(1)
115 : XCOOR(NBPTA*idimp1+2)=U2(2)
116 : XCOOR(NBPTA*idimp1+3)=U2(3)
117 : XCOOR((NBPTA+1)*idimp1)=0.D0
118 : NBPTA=NBPTA+1
119 : C Appel a BLOQU 'ROTA' 'DIRE' Poin1
119 : CALL ECROBJ('POINT ',NBPTA)
119 : CALL ECRCHA('DIRE')
119 : CALL ECRCHA('ROTA')
119 : CALL ECROBJ('MAILLAGE',MELEME)
119 : CALL BLOQUE
120 : SEGACT MCOORD*MOD
120 : CALL PRFUSE
121 : ENDIF
122 : ENDIF
122 : IF (IROTA.EQ.1.AND.IDEPL.EQ.1) CALL PRFUSE
123 : RETURN
124 :
125 : C CONDITION D'ANTISYMETRIE :
126 : C ----------------------------
127 : C Cas 'ROTA' : Creation du point associe a la direction
128 : 500 IF (IROTA.EQ.1) THEN
129 : NBPTS=XCOOR(/1)/idimp1+1
130 : SEGADJ MCOORD
131 : IPoin=(NBPTS-1)*idimp1
132 : XCOOR(IPoin+1)=XNORM(1)
133 : XCOOR(IPoin+2)=XNORM(2)
134 : IF (IDIM.EQ.3) XCOOR(IPoin+3)=XNORM(3)
135 : XCOOR(IPoin+idimp1)=0.
136 : C Appel a BLOQU 'ROTA' 'DIRE'
137 : IF (IDIM.EQ.3) THEN
137 : CALL ECROBJ('POINT ',NBPTS)
137 : CALL ECRCHA('DIRE')
138 : ENDIF
138 : CALL ECRCHA('ROTA')
138 : CALL ECROBJ('MAILLAGE',MELEME)
138 : CALL BLOQUE
139 : SEGACT MCOORD*MOD
140 : ENDIF
141 : C Cas 'DEPL' : creation des points associes a la "direction"
142 : IF (IDEPL.EQ.1) THEN
143 : IF (IDIM.EQ.3) THEN
144 : NBPTA=XCOOR(/1)/idimp1
145 : NBPTS=NBPTA+2
146 : SEGADJ MCOORD
147 : XCOOR(NBPTA*idimp1+1)=U1(1)
148 : XCOOR(NBPTA*idimp1+2)=U1(2)
149 : XCOOR(NBPTA*idimp1+3)=U1(3)
150 : XCOOR((NBPTA+1)*idimp1)=0.D0
151 : NBPTA=NBPTA+1
152 : C Appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
152 : CALL ECROBJ('POINT ',NBPTA)
152 : CALL ECRCHA('DIRE')
152 : CALL ECRCHA('DEPL')
152 : CALL ECROBJ('MAILLAGE',MELEME)
152 : CALL BLOQUE
153 : SEGACT MCOORD*MOD
154 : XCOOR(NBPTA*idimp1+1)=U2(1)
155 : XCOOR(NBPTA*idimp1+2)=U2(2)
156 : XCOOR(NBPTA*idimp1+3)=U2(3)
157 : XCOOR((NBPTA+1)*idimp1)=0.
158 : NBPTA=NBPTA+1
159 : C Appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
159 : CALL ECROBJ('POINT ',NBPTA)
159 : CALL ECRCHA('DIRE')
159 : CALL ECRCHA('DEPL')
159 : CALL ECROBJ('MAILLAGE',MELEME)
159 : CALL BLOQUE
160 : SEGACT MCOORD*MOD
160 : CALL PRFUSE
161 : C En 2D, appel a BLOQU 'DEPL' 'DIRE' Poin1 ;
162 : ELSE
163 : NBPTA=XCOOR(/1)/idimp1
164 : NBPTS=NBPTA+1
165 : SEGADJ MCOORD
166 : XCOOR(NBPTA*idimp1+1)=U1(1)
167 : XCOOR(NBPTA*idimp1+2)=U1(2)
168 : C** XCOOR(NBPTA*idimp1+3)=U1(3)
169 : XCOOR((NBPTA+1)*idimp1)=0.D0
170 : C** NBPTA=NBPTA+1
170 : CALL ECROBJ('POINT ',NBPTS)
170 : CALL ECRCHA('DIRE')
170 : CALL ECRCHA('DEPL')
170 : CALL ECROBJ('MAILLAGE',MELEME)
170 : CALL BLOQUE
171 : SEGACT MCOORD*MOD
172 : ENDIF
173 : ENDIF
173 : IF (IROTA.EQ.1.AND.IDEPL.EQ.1) CALL PRFUSE
174 : RETURN
175 :
176 : END
177 :
178 :
179 :
180 :
© Cast3M 2003 - All rights reserved.
Disclaimer