1 : C SIGSOL SOURCE FANDEUR 10/12/14 21:19:34 6812
2 : SUBROUTINE SIGSOL
3 : C_______________________________________________________________________
4 : C
5 : C Op{rateur contraintes lin{aires pour objet solution
6 : C
7 : C
8 : C SYNTAXE :
9 : C _________
10 : C
11 : C SOL1 = SIGSOL MODL1 MAT1 ( CAR1 ) SOLUT ;
12 : C
13 : C MAT1 Champ de CARACTERISTIQUES ou de HOOKE (type MCHAML )
14 : C CAR1 Champ de CARACTERISTIQUES (type MCHAML)
15 : C SOLUT OBJET solution (ne contenant pas de contraintes )
16 : C
17 : C FEVRIER 87 BROCHARD :
18 : C - LE CALCUL EFFECTIF EST FAIT DANS SIGMAP
19 : C
20 : C Passage aux nouveaux CHAMELEMS par I.Monnier le 3.07.90
21 : C_______________________________________________________________________
22 : C
23 : IMPLICIT INTEGER(I-N)
24 : IMPLICIT REAL*8(A-H,O-Z)
25 : *
26 : -INC CCOPTIO
27 : -INC SMCHAML
28 : -INC SMCHPOI
29 : -INC SMSOLUT
30 : *
31 : LOGICAL L0,L1
32 : CHARACTER*8 MOMOD,MOSTA,MOPSM,CTYP,TYPRET,CHARRE
33 : CHARACTER*40 TYPBAS
34 : CHARACTER*72 CTEXT
35 : PARAMETER(XZER=0.D0,UNDEMI=.5D0,UN=1.D0)
36 : PARAMETER(IZERO=0,IUN=1)
37 : DATA MOMOD,MOSTA,MOPSM/'MODE ','SOLUSTAT','PSEUMODE'/
38 : *
39 : * IPOI11 IRT11 OBJERT SOLUTION NE CONTENANT PAS DE
40 : * CONTRAINTES
41 : * IPOI1 IRT1 POINTEUR CHPO DEPL. OBJET SOLUTION
42 : *
43 : IPCHA1=0
44 : IPCHA2=0
45 : ICONV =0
46 : IPCHE1=0
47 : IPCHE2=0
48 : C
49 : C LECTURE DU MODELE
50 : C
50 : CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
51 : IF(IRT1.EQ.0) GOTO 666
52 : C
53 : C LECTURE DU 1ER MCHAML
54 : C
54 : CALL LIROBJ('MCHAML',IPCHA1,1,IRT1)
55 : IF(IRT1.EQ.0) GOTO 666
56 : C
57 : C LECTURE DU 2EME MCHAML
58 : C
58 : CALL LIROBJ('MCHAML',IPCHA2,0,IRT1)
59 : C
59 : CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES',
60 : 1 'MATRICE DE HOOKE',IPCHE1,IPCHE2)
61 : IF (IPCHE2.EQ.0) THEN
62 : IMAT=1
63 : ELSE
64 : IMAT=2
65 : ENDIF
66 : *
67 : * lecture d'une TABLE ou d'un objet SOLUTION
68 : *
68 : CALL QUETYP(CTYP,IUN,IRETOU)
69 : IF (CTYP(1:8).EQ.'TABLE ') THEN
69 : CALL LIRTAB('BASE_MODALE',ITBAS,IZERO,IRET)
70 : IF (IRET.EQ.0) THEN
70 : CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,IUN,IRET)
71 : ENDIF
72 : IF (IERR.NE.0) RETURN
72 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
73 : & 'MOT',I1,X1,TYPBAS,L1,IP1)
74 : *
75 : * Cas oº la base est unique
76 : *
77 : IF (TYPBAS(1:11).EQ.'BASE_MODALE') THEN
78 : *
79 : * On r{cup}re la base de modes
80 : *
80 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'MODES',L0,IP0,
81 : & 'TABLE',I1,X1,' ',L1,IBAS)
81 : CALL SIGTAB('MODE',IBAS,IPCHA1,IPCHE1,IPCHE2,ICONV,
82 : 1 IMAT,IPMODL)
83 : TYPRET = ' '
83 : CALL ACCTAB(ITBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
84 : & TYPRET,I1,X1,CHARRE,L1,ITPS)
85 : IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
85 : CALL SIGTAB('PSMO',ITPS,IPCHA1,IPCHE1,IPCHE2,ICONV,
86 : 1 IMAT,IPMODL)
87 : ENDIF
88 : *
89 : * Cas oº on a un ensemble de bases
90 : *
91 : ELSE IF (TYPBAS(1:17).EQ.'ENSEMBLE_DE_BASES') THEN
92 : *
93 : * On boucle sur le nombre de bases
94 : *
95 : IB = 0
96 : 10 CONTINUE
97 : TYPRET = ' '
98 : IB = IB + 1
98 : CALL ACCTAB(ITBAS,'ENTIER',IB,X0,' ',L0,IP0,
99 : & TYPRET,I1,X1,CHARRE,L1,ITTBAS)
100 : IF (ITTBAS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
100 : CALL ACCTAB(ITTBAS,'MOT',I0,X0,'MODES',L0,IP0,
101 : & 'TABLE',I1,X1,' ',L1,IBAS)
101 : CALL SIGTAB('MODE',IBAS,IPCHA1,IPCHE1,IPCHE2,ICONV,
102 : 1 IMAT,IPMODL)
103 : TYPRET = ' '
103 : CALL ACCTAB(ITTBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0,
104 : & TYPRET,I1,X1,CHARRE,L1,ITPS)
105 : IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN
105 : CALL SIGTAB('PSMO',ITPS,IPCHA1,IPCHE1,IPCHE2,ICONV,
106 : 1 IMAT,IPMODL)
107 : ENDIF
108 : GOTO 10
109 : ENDIF
110 : ENDIF
110 : CALL ECROBJ('TABLE ',ITBAS)
111 : RETURN
112 : ENDIF
113 : *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*
114 : * version appel{e @ disparaitre
115 : *+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+*+**+*+*+*+*+*+*+*+*+*+*+*+*
115 : CALL LIROBJ('SOLUTION',IPOI11,IUN,IRT11)
116 : IF(IRT11.EQ.0) GOTO 666
117 : C
118 : C CALCUL DES CONTRAINTES BOUCLES SUR LES MODES
119 : C OU LES SOLUTIONS STATIQUES OU LES PSEUDO-MODES.
120 : C
121 : MSOLUT=IPOI11
122 : SEGACT MSOLUT
123 : C
124 : C IMOD = 0 ERREUR, = 1 MODE, = 2 SOLUSTAT, = 3 PSEUMODE
125 : C
126 : IMOD=0
127 : IF(ITYSOL.EQ.'MODE ') IMOD=1
128 : IF(ITYSOL.EQ.'SOLUSTAT') IMOD=2
129 : IF(ITYSOL.EQ.'PSEUMODE') IMOD=3
130 : IF(IMOD.NE.0) GOTO 110
131 : MOTERR(1:8)='SOLUTION'
131 : CALL ERREUR(302)
132 : GOTO 666
133 : C
134 : 110 CONTINUE
135 : MSOLEN=MSOLIS(5)
136 : SEGACT MSOLEN
137 : N=ISOLEN(/1)
138 : SEGINI MSOLE1
139 : DO 200 ICHO=1,N
140 : IPOI1=ISOLEN(ICHO)
141 : MCHPOI = IPOI1
142 : SEGACT MCHPOI
143 : CTEXT = MOCHDE
144 : SEGDES MCHPOI
145 : IRT1=1
146 : IRT8=0
147 : IPOI6=0
148 : IRT6=0
149 : IRT9=0
149 : CALL SIGMAP(0,IPMODL,IPOI1,IPCHE1,IPCHE2,ICONV,IMAT,IPOI8,IRET)
150 : IF(IRET.EQ.0) GOTO 210
151 : MSOLE1.ISOLEN(ICHO)=IPOI8
152 : 200 CONTINUE
153 : C
154 : C CREATION DU NOUVEL OBJET SOLUTION
155 : C
156 : SEGDES MSOLE1,MSOLEN
157 : NIPO=MSOLIS(/1)
158 : IF(NIPO.LE.6) NIPO=6
159 : SEGINI MSO1
160 : MSO1.ITYSOL=ITYSOL
161 : C
162 : DO 201 IPO=1,NIPO
163 : MSO1.MSOLIS(IPO)=MSOLIS(IPO)
164 : MSO1.MSOLIT(IPO)=MSOLIT(IPO)
165 : 201 CONTINUE
166 : MSO1.MSOLIS(6)=MSOLE1
167 : MSO1.MSOLIT(6)=5
168 : SEGDES MSO1,MSOLUT
169 : C
170 : C ECRITURE DU NOUVEL OBJET SOLUTION
171 : C
171 : CALL ECROBJ('SOLUTION',MSO1)
172 : GOTO 666
173 : C
174 : C ON N A PAS PU CREER UN CHAMELEM DE CONT. ON DETRUIT
175 : C LE NOUVEL OBJET SOLUTION
176 :
177 : 210 CONTINUE
178 : SEGSUP MSOLE1
179 : SEGDES MSOLEN,MSOLUT
180 : C
181 : C
182 : 666 CONTINUE
183 : RETURN
184 : END
185 :
186 :
© Cast3M 2003 - All rights reserved.
Disclaimer