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