1 : C CMAXOA SOURCE KICH 09/09/11 21:16:12 6505 2 : SUBROUTINE CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAT, 3 : & NELMAT,NWA,NCHAIN,EPSFLU) 4 : * 5 : * MODELE MAXOTT : RECUPERATION DES INFORMATIONS 6 : * 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : * 10 : -INC CCOPTIO 11 : -INC SMEVOLL 12 : -INC SMLREEL 13 : -INC CCHAMP 14 : -INC DECHE 15 : * 16 : SEGMENT WR12 17 : REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) 18 : REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) 19 : REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) 20 : REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) 21 : REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) 22 : REAL*8 SM8(NSTRS) 23 : ENDSEGMENT 24 : 25 : DIMENSION NWA(9),IPX(9),IPY(9) 26 : DIMENSION EPSFLU(8) 27 : 28 : * 29 : *--------------------------------------- 30 : * donnees materielles de type evolution 31 : *--------------------------------------- 32 : 33 : DO JC=1,9 34 : NWA(JC)=0 35 : IPX(JC)=0 36 : IPY(JC)=0 37 : END DO 38 : * offsets pour caracteristiques de type 'evolution' 39 : * 40 : * deformations planes / axisymetrique 41 : * 42 : IF ((IFOMOD.EQ.-1.AND.IFOUR.NE.-2).OR. 43 : & (IFOMOD.EQ.0.OR.IFOMOD.EQ.1)) THEN 44 : IMAXOBL = 10 45 : IMAXFAC = 51 46 : * 47 : * contraintes planes / 3D coques minces 48 : * 49 : ELSE IF((IFOMOD.EQ.-1.AND.IFOUR.EQ.-2).OR. 50 : & (IFOMOD.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9))) THEN 51 : IMAXOBL = 10 52 : IMAXFAC = 46 53 : * 54 : * tridimensionnelle massive 55 : * 56 : ELSE 57 : IMAXOBL = 15 58 : IMAXFAC = 57 59 : ENDIF 60 : * 61 : * em0 62 : * 63 : 64 : MEVOLL=NINT(XMAT(IMAXOBL)) 65 : SEGACT MEVOLL 66 : KEVOLL=IEVOLL(1) 67 : SEGACT KEVOLL 68 : MLREEL=IPROGX 69 : IPX(1)=IPROGX 70 : IPY(1)=IPROGY 71 : SEGACT MLREEL 72 : NWA(1)=PROG(/1) 73 : SEGDES KEVOLL*NOMOD 74 : SEGDES MEVOLL*NOMOD 75 : 76 : * 77 : * em1 a em4 78 : * 79 : KED=IMAXOBL+1 80 : DO JC=2,5 81 : MEVOLL=NINT(XMAT(KED)) 82 : KED=KED+2 83 : SEGACT MEVOLL 84 : KEVOLL=IEVOLL(1) 85 : SEGACT KEVOLL 86 : MLREEL=IPROGX 87 : IPX(JC)=IPROGX 88 : IPY(JC)=IPROGY 89 : SEGACT MLREEL 90 : NWA(JC)=PROG(/1) 91 : SEGDES KEVOLL*NOMOD 92 : SEGDES MEVOLL*NOMOD 93 : END DO 94 : 95 : * 96 : * em5 a em8 97 : * 98 : NCHAIN=5 99 : KED=IMAXFAC 100 : DO JC=6,9 101 : MEVOLL=NINT(XMAT(KED)) 102 : KED=KED+2 103 : IF(MEVOLL.GT.0) THEN 104 : SEGACT MEVOLL 105 : KEVOLL=IEVOLL(1) 106 : SEGACT KEVOLL 107 : MLREEL=IPROGX 108 : IPX(JC)=IPROGX 109 : IPY(JC)=IPROGY 110 : SEGACT MLREEL 111 : NWA(JC)=PROG(/1) 112 : NCHAIN=NCHAIN+1 113 : SEGDES KEVOLL*NOMOD 114 : SEGDES MEVOLL*NOMOD 115 : ENDIF 116 : END DO 117 : 118 : 119 : *------------------------------------ 120 : * creation du segment de travail 121 : *------------------------------------ 122 : SEGINI WR12 123 : * 124 : * recuperation des caracteristiques 125 : * materielles et des variables internes 126 : * D'abord les composantes obligatoires 127 : * 128 : * tridimensionnelle massive 129 : * 130 : IF(IFOUR.EQ.2.AND.MFR.EQ.1) THEN 131 : MXVREE = 22 132 : * 133 : * deformations planes / axisymetrique 134 : * 135 : ELSE IF(IFOUR.EQ.-1.OR.IFOUR.EQ.-3 136 : & .OR.IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN 137 : MXVREE = 17 138 : * 139 : * contraintes planes / 3D coques minces 140 : * 141 : ELSE 142 : MXVREE = 14 143 : ENDIF 144 : * 145 : DO JC=0,5 146 : IF(JC.NE.0) THEN 147 : MLREEL=IPX(JC) 148 : MLREE1=IPY(JC) 149 : SEGACT MLREE1 150 : ENDIF 151 : MLREE2=NINT(VAR0(JC+MXVREE)) 152 : SEGACT MLREE2 153 : IF(JC.EQ.0) THEN 154 : DO JD=1,NSTRS 155 : EPSFLU(JD)=MLREE2.PROG(JD) 156 : END DO 157 : ELSE IF(JC.EQ.1) THEN 158 : DO JD=1,NWA(1) 159 : EM0(1,JD)=PROG(JD) 160 : EM0(2,JD)=MLREE1.PROG(JD) 161 : END DO 162 : DO JD=1,NSTRS 163 : SM0(JD)=MLREE2.PROG(JD) 164 : END DO 165 : ELSE IF(JC.EQ.2) THEN 166 : DO JD=1,NWA(2) 167 : EM1(1,JD)=PROG(JD) 168 : EM1(2,JD)=MLREE1.PROG(JD) 169 : END DO 170 : DO JD=1,NSTRS 171 : SM1(JD)=MLREE2.PROG(JD) 172 : END DO 173 : ELSE IF(JC.EQ.3) THEN 174 : DO JD=1,NWA(3) 175 : EM2(1,JD)=PROG(JD) 176 : EM2(2,JD)=MLREE1.PROG(JD) 177 : END DO 178 : DO JD=1,NSTRS 179 : SM2(JD)=MLREE2.PROG(JD) 180 : END DO 181 : ELSE IF(JC.EQ.4) THEN 182 : DO JD=1,NWA(4) 183 : EM3(1,JD)=PROG(JD) 184 : EM3(2,JD)=MLREE1.PROG(JD) 185 : END DO 186 : DO JD=1,NSTRS 187 : SM3(JD)=MLREE2.PROG(JD) 188 : END DO 189 : ELSE IF(JC.EQ.5) THEN 190 : DO JD=1,NWA(5) 191 : EM4(1,JD)=PROG(JD) 192 : EM4(2,JD)=MLREE1.PROG(JD) 193 : END DO 194 : DO JD=1,NSTRS 195 : SM4(JD)=MLREE2.PROG(JD) 196 : END DO 197 : ENDIF 198 : END DO 199 : * 200 : * traitement des composantes facultatives 201 : * 202 : DO JC=6,9 203 : IF(IPX(JC).NE.0) THEN 204 : MLREEL=IPX(JC) 205 : MLREE1=IPY(JC) 206 : SEGACT MLREE1 207 : MLREE2=NINT(VAR0(JC+MXVREE)) 208 : SEGACT MLREE2 209 : IF(JC.EQ.6) THEN 210 : DO JD=1,NWA(6) 211 : EM5(1,JD)=PROG(JD) 212 : EM5(2,JD)=MLREE1.PROG(JD) 213 : END DO 214 : DO JD=1,NSTRS 215 : SM5(JD)=MLREE2.PROG(JD) 216 : END DO 217 : ELSE IF(JC.EQ.7) THEN 218 : DO JD=1,NWA(7) 219 : EM6(1,JD)=PROG(JD) 220 : EM6(2,JD)=MLREE1.PROG(JD) 221 : END DO 222 : DO JD=1,NSTRS 223 : SM6(JD)=MLREE2.PROG(JD) 224 : END DO 225 : ELSE IF(JC.EQ.8) THEN 226 : DO JD=1,NWA(8) 227 : EM7(1,JD)=PROG(JD) 228 : EM7(2,JD)=MLREE1.PROG(JD) 229 : END DO 230 : DO JD=1,NSTRS 231 : SM7(JD)=MLREE2.PROG(JD) 232 : END DO 233 : ELSE IF(JC.EQ.9) THEN 234 : DO JD=1,NWA(9) 235 : EM8(1,JD)=PROG(JD) 236 : EM8(2,JD)=MLREE1.PROG(JD) 237 : END DO 238 : DO JD=1,NSTRS 239 : SM8(JD)=MLREE2.PROG(JD) 240 : END DO 241 : ENDIF 242 : ENDIF 243 : END DO 244 : 245 : * 246 : * DESACTIVATION DES SEGMENTS PROG 247 : * 248 : DO 10 JC=0,9 249 : IF (IPX(JC).EQ.0) GO TO 10 250 : IF (JC.NE.0) THEN 251 : MLREEL=IPX(JC) 252 : SEGDES MLREEL*NOMOD 253 : MLREE1=IPY(JC) 254 : SEGDES MLREE1*NOMOD 255 : ENDIF 256 : MLREE2=NINT(VAR0(JC+MXVREE)) 257 : SEGDES MLREE2*NOMOD 258 : 10 CONTINUE 259 : 260 : * 261 : RETURN 262 : END 263 : 264 : 265 : 266 : 267 : 268 : 269 : 270 : 271 : 272 : 273 : 274 : 275 : 276 : 277 : 278 : 279 : 280 : 281 : 282 : 283 : 284 : 285 : 286 : 287 : 288 : 289 : 290 : 291 : 292 : 293 : 294 : 295 : 296 : 297 : 298 : 299 : 300 : 301 : 302 : 303 : 304 : 305 : 306 : 307 : 308 : 309 : 310 : 311 : 312 : 313 : 314 : 315 :
© Cast3M 2003 - All rights reserved.
Disclaimer