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