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