1 : C RTEN SOURCE PV 09/03/12 21:34:01 6325
2 : SUBROUTINE RTEN
3 : C=======================================================================
4 : C
5 : C >>> Changement de repere d'un tenseur <<<
6 : C >>> de contraintes ou de deformations <<<
7 : C
8 : C CHAM2 = RTEN CHAM1 MODL1 ...
9 : C
10 : C ... | W1 (W2) ;
11 : C | CHAM3 ;
12 : C | (CHAM3) | 'POLA' CENTR1 ;
13 : C | 'SPHE' CENTR1 AXEI1 ;
14 : C | 'CYLI' CENTR1 AXEI1 ;
15 : C | 'TORI' | ('CART') CENTR1 AXEI1 ;
16 : C | 'CIRC' CENTR1 AXEI1 CENTR2 ;
17 : C
18 : C CHAM1 = MCHAML de sous type CONTRAINTES ou DEFORMATIONS
19 : C MODL1 = objet de type MMODEL
20 : C W1,W2 = objets de type POINT
21 : C CHAM3 = objet de type MCHAML de sous type CARACTERISTIQUES
22 : C CHAM2 = MCHAML de sous type CONTRAINTES ou DEFORMATIONS
23 : C CENTR1 = objet de type POINT
24 : C AXEI1 = objet de type POINT
25 : C CENTR2 = objet de type POINT
26 : C
27 : C=======================================================================
28 : IMPLICIT INTEGER(I-N)
29 : -INC CCOPTIO
30 : -INC SMCHAML
31 : *
32 : CHARACTER*4 MOCLE1(4),MOCLE2(2),MOCLE3(2)
33 : DATA MOCLE1 /'POLA','CYLI','SPHE','TORI'/
34 : DATA MOCLE2 /'CART','CIRC'/
35 : DATA MOCLE3 /'RTAR','RART'/
36 : *
37 : ICAS =0
38 : IPCHE =0
39 : IPCHE1=0
40 : IMOT =0
41 : IPTV1 =0
42 : IPTV2 =0
43 : IPTV3 =0
44 : IPMODL=0
45 : IPCHAM=0
46 : IRET =0
47 : JMOT =0
48 : IGRAD =0
49 : KMOT =0
50 : IRTP9 =0
51 : C
52 : C Lecture d'un champ par point
53 : C
53 : CALL LIROBJ('CHPOINT', MCHPOI, 0, IRET)
54 : IF (IERR.NE.0) RETURN
55 : IF (IRET .NE. 0) THEN
55 : CALL RDEPLA(MCHPOI)
56 : GOTO 100
57 : ENDIF
58 : C
59 : C Lecture d'un modele
60 : C
60 : CALL LIROBJ('MMODEL',IPMODL,1,IRTM)
61 : IF (IERR.NE.0) RETURN
62 : C
63 : C Lecture d'un mchaml
64 : C
64 : CALL LIROBJ('MCHAML',IPCHE,1,IRT)
65 : IF (IERR.NE.0) RETURN
66 : C
67 : C Lecture facultatice d'un second mchaml
68 : C
68 : CALL LIROBJ('MCHAML',IPCHE1,0,IRT1)
69 : IF (IERR.NE.0) RETURN
70 : C
71 : IF (IRT1.NE.0) THEN
72 : MCHELM=IPCHE
73 : SEGACT MCHELM
74 : C
75 : C Le mchaml des reperes est mis en second s'il le faut
76 : C
77 : IF (TITCHE.NE.'DEFORMATIONS INELASTIQUES'.AND.
78 : & TITCHE.NE.'DEFORMATIONS'.AND.
79 : & TITCHE.NE.'CONTRAINTES'.AND.
80 : & TITCHE.NE.'VARIABLES INTERNES') THEN
81 : IPXXX=IPCHE
82 : IPCHE=IPCHE1
83 : IPCHE1=IPXXX
84 : ENDIF
85 : SEGDES MCHELM
86 : *
87 : * s'agit-il d'un champ de gradient ?
88 : *
89 : MCHELM=IPCHE1
90 : SEGACT MCHELM
91 : IF (TITCHE.EQ.'GRADIENT') THEN
92 : IGRAD=1
93 : C
94 : C Lecture facultative d'un mot-cle
95 : C
95 : CALL LIRMOT (MOCLE3,2,KMOT,0)
96 : IF (IERR.NE.0) RETURN
97 : IF (KMOT.EQ.0) KMOT=1
98 : SEGDES MCHELM
99 : GO TO 50
100 : ENDIF
101 : ENDIF
102 : C
103 : C Lecture facultative d'un mot-cle
104 : C
104 : CALL LIRMOT (MOCLE1,4,IMOT,0)
105 : IF (IERR.NE.0) RETURN
106 : C
107 : IF (IMOT.EQ.0) THEN
108 : C
109 : C Cas des reperes cartesien et orthotrope
110 : C
111 : C Lecture facultative d'un premier point
112 : C
112 : CALL LIROBJ('POINT',IPTV1,0,IRTP9)
113 : IF (IERR.NE.0) RETURN
114 : IF (IRTP9.NE.0) THEN
115 : C
116 : C Lecture facultative d'un second point
117 : C
117 : CALL LIROBJ('POINT',IPTV2,0,IRTP2)
118 : IF(IERR.NE.0) RETURN
119 : ENDIF
120 : ELSE
121 : C
122 : C Cas des autres reperes (avec mot-cle)
123 : C
124 : C Lecture facultative d'un second mot-cle
125 : C
126 : IF (IMOT.EQ.4) THEN
126 : CALL LIRMOT(MOCLE2,2,JMOT,0)
127 : IF (IERR.NE.0) RETURN
128 : ENDIF
129 : C
130 : C Lecture obligatoire d'un premier point
131 : C
131 : CALL LIROBJ('POINT',IPTV1,1,IRTP1)
132 : IF (IERR.NE.0) RETURN
133 : C
134 : C Lecture facultative d'un second point
135 : C
135 : CALL LIROBJ ('POINT',IPTV2,0,IRTP2)
136 : IF (IERR.NE.0) RETURN
137 : IF (IRTP2.EQ.0) THEN
138 : C
139 : C Un seul point : 'POLA'
140 : C
141 : IF (IMOT.NE.1) THEN
141 : CALL ERREUR(641)
142 : RETURN
143 : ENDIF
144 : ELSE IF (IMOT.EQ.4) THEN
145 : C
146 : C Autre mot-cle possible : 'TORI'
147 : C
148 : IF (JMOT.EQ.2) THEN
149 : C
150 : C Troisieme point obligatoire : 'TORI' 'CIRC'
151 : C
151 : CALL LIROBJ('POINT',IPTV3,1,IRTP3)
152 : IF (IERR.NE.0) RETURN
153 : ELSE
154 : C
155 : C Pas de troisieme point : 'TORI' 'CART'
156 : C
157 : IMOT=5
158 : ENDIF
159 : ENDIF
160 : ENDIF
161 : C
162 : 50 CONTINUE
163 : C
164 : IF (IMOT.NE.0) ICAS = 3
165 : IF (IMOT.EQ.0) THEN
166 : ICAS = 2
167 : IF (IRTP9.EQ.0) ICAS = 1
168 : ENDIF
169 : IF(IGRAD.EQ.1) ICAS=4
170 : C
171 : C Appel au module de calcul
172 : C
172 : CALL RTENS(IPCHE,IPMODL,IMOT,KMOT,
173 : & IPTV1,IPTV2,IPTV3,IPCHE1,ICAS,IPCHAM)
174 : C
174 : IF (IERR.EQ.0) CALL ECROBJ('MCHAML',IPCHAM)
175 : 100 CONTINUE
176 : RETURN
177 : END
178 :
179 :
180 :
181 :
182 :
183 :
184 :
185 :
© Cast3M 2003 - All rights reserved.
Disclaimer