1 : C EPSI SOURCE PV 12/03/21 21:15:01 7323
2 : SUBROUTINE EPSI
3 : *_______________________________________________________________________
4 : *
5 : * OPERATEUR DEFORMATIONS
6 : *
7 : * ESP=EPSI ( II ) MODL1 ( CAR1 ) (MAT1) CHP1 ;
8 : *
9 : * OU
10 : *
11 : * ESP = EPSI MODL1 GRAD2 ( CAR1 ) | ('GEOM') | ;
12 : * | 'DEPL' |
13 : *
14 : * II MOT CLE INDIQUANT QUE L ON VEUT EPS2
15 : * MODL1 MODELE DE CALCUL, TYPE MMODEL
16 : * CAR1 CHAMP PAR ELEMENT DE CARACTERISTIQUE, TYPE MCHAML
17 : * CHP1 CHPOINT DE DEPLACEMENT
18 : * MAT1 CHAMP PAR ELEMENT DE MATERIAU OU DE HOOKE (FACULTATIF)
19 : * GEOM/DEPL MOT CLE INDIQUANT QUE GRAD2 EST UN GRADIENT DE
20 : * TRANSFORMATION/DEPLACEMENT
21 : *
22 : * 20/3/12 mot cle noer indiquant qu'on nen sort pas si erreur. On rend alors
23 : * un entier qui vaut le numero de l'erreur
24 :
25 : *-----------------------------------------------------------------------
26 :
27 : IMPLICIT INTEGER(I-N)
28 : IMPLICIT REAL*8(A-H,O-Z)
29 :
30 : -INC CCOPTIO
31 : -INC SMCHAML
32 :
33 : CHARACTER*4 MOEPS2(5)
34 :
35 : DATA MOEPS2 / 'II ','GEOM','DEPL','LINE','NOER'/
36 :
37 : C IPMODEL MODELE MMODEL
38 : C IPCHP1 CHAMPOINT DEPLACEMENTS
39 : C IPCHA1 CHAMELEM CARACTERISTIQUE
40 : C IPEPSI CHAMELEM DEFORMATIONS
41 :
42 : kerr=0
43 : IPCHE1=0
44 : IPCHA1=0
45 : IPCHE2=0
46 : IPCHA2=0
47 : C
48 : C LECTURE D'UN MOT-CLE SI NECESSAIRE
49 : C
50 : ireps2=0
50 : CALL LIRMOT(MOEPS2,5,IREPS2,0)
51 : ireps3=0
51 : CALL LIRMOT(MOEPS2,5,IREPS3,0)
52 : IF (IERR.NE.0) GOTO 666
53 : noer=0
54 : if (ireps2.eq.5) then
55 : noer=1
56 : ireps2=ireps3
57 : endif
58 : if (ireps3.eq.5) then
59 : noer=1
60 : endif
61 : C
62 : C LECTURE DU MODELE
63 : C
63 : CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
64 : IF (IERR.NE.0) GOTO 666
65 : C
66 : C ON LIT UN CHAMP/POINT
67 : C
67 : CALL LIROBJ('CHPOINT ',ICHP1,0,IRT1)
68 : IF (IRT1.NE.0) THEN
69 : C
70 : C ON LIT UN 2eme CHAMP/POINT qui est le deplacement pour avoir la
71 : C configuratyion courante
72 : C
73 : ichp2=0
73 : CALL LIROBJ('CHPOINT ',ICHP2,0,IRT1)
74 : C
75 : C ON LIT UN 1 ER CHAMP/ELEMENT (FACULTATIF )
76 : C
76 : CALL LIROBJ ('MCHAML',IPCHA1,0,IRT1)
77 : IF (Ierr.NE.0) GOTO 666
78 : if (ipcha1.ne.0) then
78 : call reduaf(ipcha1,ipmodl,ipcha,0,iret,kerr)
78 : if (iret.ne.1) call erreur(kerr)
79 : if (ierr.ne.0) return
80 : ipcha1=ipcha
81 : endif
82 : C
83 : C ON LIT UN 2 IEME CHAMP/ELEMENT (FACULTATIF )
84 : C
84 : CALL LIROBJ ('MCHAML',IPCHA2,0,IRT2)
85 : IF (IERR.NE.0) GOTO 666
86 : if (ipcha2.ne.0) then
86 : call reduaf(ipcha2,ipmodl,ipcha,0,iret,kerr)
86 : if (iret.ne.1) call erreur(kerr)
87 : if (ierr.ne.0) return
88 : ipcha2=ipcha
89 : endif
90 : C
91 : IF(IPCHA1.NE.0.OR.IPCHA2.NE.0)THEN
91 : CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES',
92 : & 'MATRICE DE HOOKE',IPCHE1,IPCHE2)
93 : IF(IERR.NE.0) GOTO 666
94 : IF (IPCHE2.EQ.0)THEN
95 : IMAT=1
96 : ELSE
97 : IMAT=2
98 : ENDIF
99 : ELSE
100 : IMAT=0
101 : IPCHE1=0
102 : IPCHE2=0
103 : ENDIF
104 : C
105 : C CALCUL DES DEFORMATIONS USUELLES
106 : C
106 : CALL EPSI1(IREPS2,IPMODL,ICHP1,IPCHE1,IPCHE2,IMAT,
107 : & IPEPSI,IRET,ichp2,noer,kerr)
108 : C
109 : ELSE
110 : C
111 : C GRADIENT GEOMETRIE OU DEPLACEMENT ?
112 : C
113 : IMIL=0
114 : IF (IREPS2.EQ.3) IMIL=1
115 : C
116 : C ON LIT UN CHAMP/ELEMENT DE GRADIENTS
117 : C
117 : CALL LIROBJ ('MCHAML',IPCHA1,1,IRT1)
118 : IF (IERR.NE.0) GOTO 666
119 : C
120 : C ON LIT UN 2 IEME CHAMP/ELEMENT (CARACTERISTIQUES-FACULTATIF)
121 : C
121 : CALL LIROBJ ('MCHAML',IPCHA2,0,IRT2)
122 : IF (IERR.NE.0) GOTO 666
123 : C
124 : IF (IPCHA1.NE.0.OR.IPCHA2.NE.0) THEN
124 : CALL RNGCHA(IPCHA1,IPCHA2,'GRADIENT',
125 : & 'CARACTERISTIQUES',IPCHE1,IPCHE2)
126 : ** Actuellement IPCHE2 n'est pas utilise. Seul IPCHE1 est verifie.
127 : ** IF (IPCHE1.EQ.0.OR.IPCHE2.EQ.0) THEN
128 : IF (IPCHE1.EQ.0) THEN
129 : MOTERR(1:8)='MCHAML'
130 : MOTERR(9:16)='GRADIENT'
131 : MOTERR(17:24)='CARACTERI'
131 : CALL ERREUR(141)
132 : ENDIF
133 : IF (IERR.NE.0) GOTO 666
134 : ENDIF
135 : C
136 : C CALCUL DES DEFORMATIONS LOGARITHMIQUES
137 : C
137 : CALL EPSLN1(IPMODL,IPCHE1,IPCHE2,IPEPSI,IMIL)
138 : IF (IERR.NE.0) GOTO 666
139 : IRET=1
140 : C
141 : ENDIF
142 : C
143 : C ECRITURE DU MCHAML DE DEFORMATIONS RESULTAT
144 : C
144 : IF (IRET.EQ.1.and.kerr.eq.0) call ecrOBJ ('MCHAML',IPEPSI)
144 : if (kerr.ne.0) call ecrent(kerr)
145 :
146 : 666 CONTINUE
147 : RETURN
148 : END
149 :
150 :
151 :
152 :
© Cast3M 2003 - All rights reserved.
Disclaimer