1 : C DTSOLZ SOURCE PV 11/03/08 21:15:27 6888 2 : SUBROUTINE DTSOLz(IRET,ktrace,msorse) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : CHARACTER*19 MROTA , MROTP 6 : CHARACTER*24 MROTS 7 : CHARACTER*22 MTRAN , MTRAP 8 : CHARACTER*27 MTRAS 9 : CHARACTER*1 ICHARI,MROTD,MTRAD,ICHARR 10 : character*6 msorse 11 : LOGICAL LOGII,LOGIR 12 : REAL*8 XVALI,XVALR 13 : C 14 : C ===================================================================== 15 : C = DESTRUCTION D'UN OBJET SOLUTION = 16 : C = = 17 : C = CREATION 06/01/86 = 18 : C = PROGRAMMEUR GUILBAUD = 19 : C ===================================================================== 20 : C 21 : -INC CCOPTIO 22 : -INC SMSOLUT 23 : -INC SMELEME 24 : -INC SMTABLE 25 : -INC SMLREEL 26 : -INC TMCOLAC 27 : * 28 : DATA MROTA/'ROTATION D ENSEMBLE'/ 29 : DATA MROTP/'VITESSE DE ROTATION'/ 30 : DATA MROTS/'ACCELERATION DE ROTATION'/ 31 : DATA MTRAN/'TRANSLATION D ENSEMBLE'/ 32 : DATA MTRAP/'VITESSE DE TRANSLATION'/ 33 : DATA MTRAS/'ACCELERATION DE TRANSLATION'/ 34 : * 35 : MSOLUT=IRET 36 : SEGACT MSOLUT 37 : ITYS=0 38 : IF(ITYSOL.NE.'MODE ') GO TO 101 39 : ITYS=1 40 : GO TO 200 41 : 101 CONTINUE 42 : IF(ITYSOL.NE.'SOLUSTAT'.AND.ITYSOL.NE.'PSEUMODE') GO TO 102 43 : ITYS=2 44 : GOTO 200 45 : 102 CONTINUE 46 : IF(ITYSOL.NE.'DYNAMIQU') GOTO 103 47 : ITYS=3 48 : GO TO 200 49 : 103 MOTERR(1:8)='SOLUTION' 50 : MOTERR(9:16)=ITYSOL 50 : CALL ERREUR(66) 51 : C L OPERATEUR DETRUIRE NE FONCTIONNE PAS POUR UN OBJET SOLUTION 52 : C COMPORTANT CE SOUS-TYPE 53 : if(ktrace.eq.msolut) then 54 : ktrace=-ktrace 55 : msorse='MSOLUT' 56 : endif 57 : SEGDES MSOLUT 58 : GOTO 1000 59 : 200 NIPO=MSOLIS(/1) 60 : MSOLRE=MSOLIS(1) 61 : IF(MSOLRE.NE.0) SEGSUP MSOLRE 62 : MSOLEN=MSOLIS(2) 63 : IF(MSOLEN.NE.0) SEGSUP MSOLEN 64 : MELEME=MSOLIS(3) 65 : IF(MELEME.NE.0.AND.ITYS.EQ.1) THEN 66 : if(ktrace.eq.meleme) then 67 : ktrace=-ktrace 68 : msorse='MELEME' 69 : endif 70 : SEGSUP MELEME 71 : IF(IPSAUV.NE.0) THEN 72 : ICOLAC = IPSAUV 73 : SEGACT ICOLAC 74 : ILISSE=ILISSG 75 : SEGACT ILISSE*MOD 75 : CALL TYPFIL('MAILLAGE',ICO) 76 : ITLACC = KCOLA(ICO) 77 : SEGACT ITLACC*MOD 77 : CALL AJOUN0(ITLACC,MELEME,ILISSE,1) 78 : SEGDES ITLACC,ILISSE 79 : SEGDES ICOLAC 80 : ENDIF 81 : ENDIF 82 : MSOLEN=MSOLIS(4) 83 : IF(MSOLEN.NE.0) THEN 84 : SEGACT MSOLEN 85 : N=ISOLEN(/1) 86 : IF(N.NE.0) THEN 87 : DO 210 NN=1,N 88 : MMODE=ISOLEN(NN) 89 : if(ktrace.eq.mmode) then 90 : ktrace=-ktrace 91 : msorse='MMODE' 92 : endif 93 : SEGSUP MMODE 94 : 210 CONTINUE 95 : ENDIF 96 : if(ktrace.eq.msolen) then 97 : ktrace=-ktrace 98 : msorse='MSOLEN' 99 : endif 100 : SEGSUP MSOLEN 101 : ENDIF 102 : DO 230 NIP=5,NIPO 103 : MSOLEN=MSOLIS(NIP) 104 : IF(MSOLEN.NE.0) THEN 105 : SEGACT MSOLEN 106 : N=ISOLEN(/1) 107 : IF(N.NE.0) THEN 108 : KSOLIT=MSOLIT(NIP) 109 : DO 220 NN=1,N 110 : IRETT=ISOLEN(NN) 111 : IF(IRETT.NE.0) THEN 112 : IF(KSOLIT.EQ.2) THEN 112 : CALL DTCHPO(IRETT) 113 : IF(IPSAUV.NE.0) THEN 114 : ICOLAC = IPSAUV 115 : SEGACT ICOLAC 116 : ILISSE=ILISSG 117 : SEGACT ILISSE*MOD 117 : CALL TYPFIL('CHPOINT',ICOCH) 118 : ITLACC = KCOLA(ICOCH) 119 : SEGACT ITLACC*MOD 119 : CALL AJOUN0(ITLACC,IRETT,ILISSE,1) 120 : SEGDES ITLACC 121 : ENDIF 122 : ENDIF 123 : IF(KSOLIT.EQ.5) THEN 123 : CALL DTCHAz(IRETT,ktrace,msorse) 124 : IF(IPSAUV.NE.0) THEN 125 : ICOLAC = IPSAUV 126 : SEGACT ICOLAC 127 : ILISSE=ILISSG 128 : SEGACT ILISSE*MOD 128 : CALL TYPFIL('MCHAML ',ICOCH) 129 : ITLACC = KCOLA(ICOCH) 130 : SEGACT ITLACC*MOD 130 : CALL AJOUN0(ITLACC,IRETT,ILISSE,1) 131 : SEGDES ITLACC 132 : ENDIF 133 : ENDIF 134 : IF ( MSOLIT.EQ.10 ) THEN 135 : KMEL1 = MSOLIS(3) 136 : IF ( NIP.EQ.11 ) THEN 136 : CALL ACCTAB(IRRET,'MAILLAGE', 137 : * IVALI,XVALI,ICHARI,LOGII,KMEL1, 138 : * 'TABLE ', 139 : * IVALR,XVALR,ICHARR,LOGIR,ITABR) 139 : CALL ACCTAB(ITABR,'MOT ', 140 : * IVALI,XVALI,MROTS ,LOGII,KMEL1, 141 : * 'LISTREEL', 142 : * IVALR,XVALR,ICHARR,LOGIR,IROTS) 143 : MLREEL = IROTS 144 : if(ktrace.eq.mlreel) then 145 : ktrace=-ktrace 146 : msorse='MLREEL' 147 : endif 148 : SEGSUP MLREEL 148 : CALL ACCTAB(ITABR,'MOT ', 149 : * IVALI,XVALI,MROTP ,LOGII,KMEL1, 150 : * 'LISTREEL', 151 : * IVALR,XVALR,ICHARR,LOGIR,IROTP) 152 : MLREEL = IROTP 153 : if(ktrace.eq.mlreel) then 154 : ktrace=-ktrace 155 : msorse='MLREEL' 156 : endif 157 : SEGSUP MLREEL 157 : CALL ACCTAB(ITABR,'MOT ', 158 : * IVALI,XVALI,MROTD ,LOGII,KMEL1, 159 : * 'LISTREEL', 160 : * IVALR,XVALR,ICHARR,LOGIR,IROTD) 161 : MLREEL = IROTD 162 : if(ktrace.eq.mlreel) then 163 : ktrace=-ktrace 164 : msorse='MLREEL' 165 : endif 166 : SEGSUP MLREEL 167 : MTABLE = ITABR 168 : if(ktrace.eq.mtable) then 169 : ktrace=-ktrace 170 : msorse='MTABLE' 171 : endif 172 : SEGSUP MTABLE 173 : ITABR = 0 174 : CONTINUE 175 : MTABLE = IRRET 176 : if(ktrace.eq.mtable) then 177 : ktrace=-ktrace 178 : msorse='MTABLE' 179 : endif 180 : SEGSUP MTABLE 181 : IF(IPSAUV.NE.0) THEN 182 : ICOLAC = IPSAUV 183 : SEGACT ICOLAC 184 : ILISSE=ILISSG 185 : SEGACT ILISSE*MOD 185 : CALL TYPFIL('LISTREEL',ICOLR) 186 : ITLACC = KCOLA(ICOLR) 187 : SEGACT ITLACC*MOD 187 : CALL AJOUN0(ITLACC,IROTD,ILISSE,1) 187 : CALL AJOUN0(ITLACC,IROTP,ILISSE,1) 187 : CALL AJOUN0(ITLACC,IROTS,ILISSE,1) 188 : SEGDES ITLACC 188 : CALL TYPFIL('TABLE ',ICOTB) 189 : ITLACC = KCOLA(ICOTB) 190 : SEGACT ITLACC*MOD 190 : CALL AJOUN0(ITLACC,ITABR,ILISSE,1) 190 : CALL AJOUN0(ITLACC,IRRET,ILISSE,1) 191 : SEGDES ITLACC 192 : SEGDES ICOLAC,ILISSE 193 : ENDIF 194 : IRRET = 0 195 : ELSE IF ( NIP.EQ.12 ) THEN 195 : CALL ACCTAB(IRRET,'MAILLAGE', 196 : * IVALI,XVALI,ICHARI,LOGII,KMEL1, 197 : * 'TABLE ', 198 : * IVALR,XVALR,ICHARR,LOGIR,ITABR) 198 : CALL ACCTAB(ITABR,'MOT ', 199 : * IVALI,XVALI,MTRAS ,LOGII,KMEL1, 200 : * 'LISTREEL', 201 : * IVALR,XVALR,ICHARR,LOGIR,ITRAS) 202 : MLREEL = ITRAS 203 : if(ktrace.eq.mlreel) then 204 : ktrace=-ktrace 205 : msorse='MLREEL' 206 : endif 207 : SEGSUP MLREEL 207 : CALL ACCTAB(ITABR,'MOT ', 208 : * IVALI,XVALI,MTRAP ,LOGII,KMEL1, 209 : * 'LISTREEL', 210 : * IVALR,XVALR,ICHARR,LOGIR,ITRAP) 211 : MLREEL = ITRAP 212 : if(ktrace.eq.mlreel) then 213 : ktrace=-ktrace 214 : msorse='MLREEL' 215 : endif 216 : SEGSUP MLREEL 216 : CALL ACCTAB(ITABR,'MOT ', 217 : * IVALI,XVALI,MTRAD ,LOGII,KMEL1, 218 : * 'LISTREEL', 219 : * IVALR,XVALR,ICHARR,LOGIR,ITRAD) 220 : MLREEL = ITRAD 221 : if(ktrace.eq.mlreel) then 222 : ktrace=-ktrace 223 : msorse='MLREEL' 224 : endif 225 : SEGSUP MLREEL 226 : MTABLE = ITABR 227 : if(ktrace.eq.mtable) then 228 : ktrace=-ktrace 229 : msorse='MTABLE' 230 : endif 231 : SEGSUP MTABLE 232 : CONTINUE 233 : MTABLE = IRRET 234 : if(ktrace.eq.mtable) then 235 : ktrace=-ktrace 236 : msorse='MTABLE' 237 : endif 238 : SEGSUP MTABLE 239 : IF(IPSAUV.NE.0) THEN 240 : ICOLAC = IPSAUV 241 : SEGACT ICOLAC 242 : ILISSE=ILISSG 243 : SEGACT ILISSE*MOD 244 : ITLACC = KCOLA(ICOLR) 245 : SEGACT ITLACC*MOD 245 : CALL AJOUN0(ITLACC,ITRAD,ILISSE,1) 245 : CALL AJOUN0(ITLACC,ITRAP,ILISSE,1) 245 : CALL AJOUN0(ITLACC,ITRAS,ILISSE,1) 246 : SEGDES ITLACC 247 : ITLACC = KCOLA(ICOTB) 248 : SEGACT ITLACC*MOD 248 : CALL AJOUN0(ITLACC,ITABR,ILISSE,1) 248 : CALL AJOUN0(ITLACC,IRRET,ILISSE,1) 249 : SEGDES ITLACC 250 : SEGDES ICOLAC,ILISSE 251 : ENDIF 252 : ITABR = 0 253 : IRRET = 0 254 : ENDIF 255 : ENDIF 256 : ENDIF 257 : 220 CONTINUE 258 : ENDIF 259 : if(ktrace.eq.msolen) then 260 : ktrace=-ktrace 261 : msorse='MSOLEN' 262 : endif 263 : SEGSUP MSOLEN 264 : ENDIF 265 : 230 CONTINUE 266 : 1000 CONTINUE 267 : RETURN 268 : END 269 : 270 : 271 :
© Cast3M 2003 - All rights reserved.
Disclaimer