1 : C SSTE1 SOURCE CHAT 11/03/16 21:31:47 6902 2 : 3 : ************************************************************************* 4 : ************************************************************************* 5 : ************************************************************************* 6 : SUBROUTINE SSTE1 (IPMODL,IPCHE1,IPCHE2,IPCHE4,IPCAR, 7 : . PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX, 8 : . IPCHE7,IPCHE8,IPCHE9,IPRIGI) 9 : * entrees: 10 : * ipmodl = pointeur sur un objet mmodel 11 : * ipche1 = pointeur sur un mchaml de contraintes initiales 12 : * ipche2 = pointeur sur un mchaml de variables internes initiales 13 : * ipche4 = pointeur sur un mchaml d'increment elastique de deformations 14 : * ipcar = pointeur sur un mchaml de caracteristiques 15 : * precis = precision des iterations internes 16 : * sorties: 17 : * ipche7 = pointeur sur un mchaml de contraintes 18 : * ipche8 = pointeur sur un mchaml de variables internes 19 : * ipche9 = pointeur sur un mchaml de deformations 20 : * iprigi = pointeur sur l'objet de type rigidite 21 : * 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : * 25 : -INC CCOPTIO 26 : -INC CCGEOME 27 : -INC SMCHAML 28 : -INC SMELEME 29 : -INC SMINTE 30 : -INC SMMODEL 31 : -INC SMRIGID 32 : SEGMENT NOTYPE 33 : CHARACTER*16 TYPE(NBTYPE) 34 : ENDSEGMENT 35 : SEGMENT MPTVAL 36 : INTEGER IPOS(NS) 37 : INTEGER NSOF(NS) 38 : INTEGER IVAL(NCOSOU) 39 : CHARACTER*16 TYVAL(NCOSOU) 40 : ENDSEGMENT 41 : 42 : CHARACTER*8 CMATE 43 : CHARACTER*(NCONCH) CONM 44 : PARAMETER (NINF=3) 45 : INTEGER INFOS(NINF) 46 : LOGICAL lsupde,lsupfo,lsupva,lsupdp,lsupco,lsupma 47 : 47 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1) 48 : IF (ISUP1.GT.1) RETURN 48 : CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2) 49 : IF (ISUP2.GT.1) RETURN 49 : CALL QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4) 50 : IF (ISUP4.GT.1) RETURN 50 : CALL QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5) 51 : IF (ISUP5.GT.1) RETURN 52 : c 53 : c Activar el modelo 54 : c 55 : MMODEL=IPMODL 56 : SEGACT MMODEL 57 : NSOUS=MMODEL.KMODEL(/1) 58 : c 59 : c Creation de los 3 mchelms de salida 60 : c 61 : N1=NSOUS 62 : L1=11 63 : N3=6 64 : SEGINI MCHELM 65 : MCHELM.TITCHE='CONTRAINTES' 66 : MCHELM.IFOCHE=IFOUR 67 : IPCHE7=MCHELM 68 : L1=18 69 : SEGINI MCHEL1 70 : MCHEL1.TITCHE='VARIABLES INTERNES' 71 : MCHEL1.IFOCHE=IFOUR 72 : IPCHE8=MCHEL1 73 : L1=12 74 : SEGINI MCHEL2 75 : MCHEL2.TITCHE='DEFORMATIONS' 76 : MCHEL2.IFOCHE=IFOUR 77 : IPCHE9=MCHEL2 78 : c 79 : c Creacion del objeto rigidite 80 : c 81 : NRIGE =7 82 : NRIGEL=NSOUS 83 : SEGINI MRIGID 84 : MRIGID.MTYMAT = 'RIGIDITE' 85 : MRIGID.ICHOLE=0 86 : MRIGID.IMGEO1=0 87 : MRIGID.IMGEO2=0 88 : MRIGID.IFORIG=IFOUR 89 : DO ISOUS=1,NSOUS 90 : MRIGID.COERIG(ISOUS)=1.D0 91 : MRIGID.IRIGEL(4,ISOUS)=0 92 : ENDDO 93 : IPRIGI=MRIGID 94 : c 95 : c bucle sobre zonas 96 : c 97 : DO 1000 ISOUS=1,NSOUS 98 : NSTR=0 99 : MOSTRS=0 100 : IVASTR=0 101 : MOVARI=0 102 : NVARI=0 103 : NVARF=0 104 : IVARI=0 105 : MOEPSI=0 106 : NDEF=0 107 : IVADEF=0 108 : IVADS=0 109 : NCARA=0 110 : NCARF=0 111 : MOCARA=0 112 : IVACAR=0 113 : NMATF=0 114 : NMATR=0 115 : MOMATR=0 116 : IVAMAT=0 117 : IVASTF=0 118 : IVARIF=0 119 : IVADEP=0 120 : KERRE=0 121 : KERR1=0 122 : MCHAML=0 123 : MCHAM1=0 124 : MCHAM2=0 125 : c Recuperar la informacion general de la zona 126 : c Activa el modelo de la zona 127 : IMODEL=KMODEL(ISOUS) 128 : SEGACT IMODEL 129 : MELE =IMODEL.NEFMOD 130 : MELEME=IMODEL.IMAMOD 131 : CONM =IMODEL.CONMOD 132 : c Activa la malla 133 : SEGACT MELEME 134 : NBNN =MELEME.NUM(/1) 135 : NBELEM=MELEME.NUM(/2) 136 : c Tipo de material 137 : NFOR =IMODEL.FORMOD(/2) 138 : NMAT =IMODEL.MATMOD(/2) 138 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS) 139 : ccc 140 : c Controlar que sea uno de los materiales de trabajo 141 : IF ((INPLAS.lt.111).or.(INPLAS.gt.113)) then 142 : write(*,*) ' Material no disponible' 143 : ENDIF 144 : ccc 145 : * informacion de elementos finitos 146 : * activa un segmento q se llama luego INFO, q tiene INFELE 146 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 147 : * INFO =IPINF 148 : * MELE =INFO.INFELE(1) 149 : * NBGS =INFO.INFELE(4) 150 : * NBG =INFO.INFELE(6) 151 : * IPORE=INFO.INFELE(8) 152 : * LRE =INFO.INFELE(9) 153 : * LHOOK=INFO.INFELE(10) 154 : * MINTE=INFO.INFELE(11) 155 : * MFR =INFO.INFELE(13) 156 : * NDDL =INFO.INFELE(15) 157 : * NSTRS=INFO.INFELE(16) 158 : MELE =INFELE(1) 159 : NBGS =INFELE(4) 160 : NBG =INFELE(6) 161 : IPORE=INFELE(8) 162 : LRE =INFELE(9) 163 : LHOOK=INFELE(10) 164 : MINTE=INFMOD(7) 165 : MFR =INFELE(13) 166 : NDDL =INFELE(15) 167 : NSTRS=INFELE(16) 168 : * Controla que sean elementos masivos 169 : IF ((MFR.lt.1).or.(MFR.gt.1)) then 170 : write(*,*) ' Tipo de elemento no disponible' 171 : ENDIF 172 : * Llena informacion en los 3 campos de salida 173 : MCHELM.IMACHE(ISOUS)=MELEME 174 : MCHELM.CONCHE(ISOUS)=CONM 175 : MCHEL1.IMACHE(ISOUS)=MELEME 176 : MCHEL1.CONCHE(ISOUS)=CONM 177 : MCHEL2.IMACHE(ISOUS)=MELEME 178 : MCHEL2.CONCHE(ISOUS)=CONM 179 : MCHELM.INFCHE(ISOUS,1)=0 180 : MCHELM.INFCHE(ISOUS,2)=0 181 : MCHELM.INFCHE(ISOUS,3)=NIFOUR 182 : MCHELM.INFCHE(ISOUS,4)=MINTE 183 : MCHELM.INFCHE(ISOUS,5)=0 184 : MCHELM.INFCHE(ISOUS,6)=5 185 : MCHEL1.INFCHE(ISOUS,1)=0 186 : MCHEL1.INFCHE(ISOUS,2)=0 187 : MCHEL1.INFCHE(ISOUS,3)=NIFOUR 188 : MCHEL1.INFCHE(ISOUS,4)=MINTE 189 : MCHEL1.INFCHE(ISOUS,5)=0 190 : MCHEL1.INFCHE(ISOUS,6)=5 191 : MCHEL2.INFCHE(ISOUS,1)=0 192 : MCHEL2.INFCHE(ISOUS,2)=0 193 : MCHEL2.INFCHE(ISOUS,3)=NIFOUR 194 : MCHEL2.INFCHE(ISOUS,4)=MINTE 195 : MCHEL2.INFCHE(ISOUS,5)=0 196 : MCHEL2.INFCHE(ISOUS,6)=5 197 : * Llena informacion la rigidite 198 : * Activa segmento MINTE 199 : NBNO=NBNN 200 : SEGACT MINTE 201 : NBPGAU=MINTE.POIGAU(/1) 202 : * Inicializa segmento descr, descripcion incognitas matriz rigidite 203 : NLIGRP=LRE 204 : NLIGRD=LRE 205 : SEGINI DESCR 206 : IPDESCR=DESCR 207 : if(lnomid(1).ne.0) then 208 : nomid=lnomid(1) 209 : segact nomid 210 : modepl=nomid 211 : ndepl=lesobl(/2) 212 : ndum=lesfac(/2) 213 : lsupdp=.false. 214 : else 215 : lsupdp=.true. 215 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 216 : endif 217 : if(lnomid(2).ne.0) then 218 : nomid=lnomid(2) 219 : segact nomid 220 : moforc=nomid 221 : nforc=lesobl(/2) 222 : lsupfo=.false. 223 : else 224 : lsupfo=.true. 224 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 225 : endif 226 : * Llena el segmento descr con los nombres de las incognitas 227 : IDDL=1 228 : NCOMP=NDEPL 229 : NBNNS=NBNN 230 : NOMID=MODEPL 231 : SEGACT NOMID 232 : NOMID=MOFORC 233 : SEGACT NOMID 234 : DO INOEUD=1,NBNNS 235 : DO ICOMP=1,NCOMP 236 : NOMID=MODEPL 237 : DESCR.LISINC(IDDL)=LESOBL(ICOMP) 238 : NOMID=MOFORC 239 : DESCR.LISDUA(IDDL)=LESOBL(ICOMP) 240 : NOELEP(IDDL)=INOEUD 241 : NOELED(IDDL)=INOEUD 242 : IDDL=IDDL+1 243 : ENDDO 244 : ENDDO 245 : NOMID=MODEPL 246 : if(lsupdp)SEGsup NOMID 247 : NOMID=MOFORC 248 : if(lsupfo)SEGsup NOMID 249 : SEGDES DESCR 250 : * Inicializa segmento imatri, chapeau sur les segments 251 : * contenant les matrices de rigidite elementaires 252 : NELRIG =NBELEM 253 : SEGINI xMATRI 254 : * Trata la rigidite 255 : MRIGID.IRIGEL(1,ISOUS)=MELEME 256 : MRIGID.IRIGEL(2,ISOUS)=0 257 : MRIGID.IRIGEL(3,ISOUS)=IPDESCR 258 : MRIGID.IRIGEL(4,ISOUS)=xMATRI 259 : MRIGID.IRIGEL(5,ISOUS)=NIFOUR 260 : MRIGID.IRIGEL(6,ISOUS)=0 261 : c no simetricas = 2, simetricas = 0 262 : IRIGE7=2 263 : MRIGID.IRIGEL(7,ISOUS)=IRIGE7 264 : * tratamiento de los 4 campos dados 265 : NBNO=NBNNE(NUMGEO(MELE)) 265 : CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 266 : IF (IRTD.EQ.0)THEN 267 : write(*,*)' no compatibles' 268 : SEGDES IMODEL*NOMOD,MMODEL*NOMOD 269 : SEGSUP MCHELM,MCHEL1,MCHEL2 270 : * INFO=IPINF 271 : * SEGSUP INFO 272 : RETURN 273 : ENDIF 274 : NBTYPE =1 275 : SEGINI NOTYPE 276 : NOTYPE.TYPE(1)='REAL*8' 277 : 278 : * contraintes: IVASTR 279 : if(lnomid(4).ne.0) then 280 : nomid=lnomid(4) 281 : segact nomid 282 : mostrs=nomid 283 : nstr=lesobl(/2) 284 : nfac=lesfac(/2) 285 : lsupco=.false. 286 : else 287 : lsupco=.true. 287 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 288 : endif 289 : MOTYPE=NOTYPE 289 : CALL KOMCHA(IPCHE1,MELEME,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 290 : IPMINT=MINTE 291 : IF (ISUP1.EQ.1) THEN 292 : ippore=0 292 : CALL VALCHE(IVASTR,NSTR,IPMINT,ippore) 293 : SEGSUP NOTYPE 294 : goto 888 295 : ENDIF 296 : * variables internes: IVARI 297 : if(lnomid(10).ne.0) then 298 : nomid=lnomid(10) 299 : segact nomid 300 : movari=nomid 301 : nvari=lesobl(/2) 302 : nvarf=lesfac(/2) 303 : lsupva=.false. 304 : else 305 : lsupva=.true. 305 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) 306 : endif 307 : MOTYVA=NOTYPE 307 : CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,MOTYVA,1,INFOS,3,IVARI) 308 : NVART=NVARI+NVARF 309 : IF (ISUP2.EQ.1) THEN 310 : ippore=0 310 : CALL VALCHE(IVARI,NVART,IPMINT,ippore) 311 : SEGSUP NOTYPE 312 : goto 888 313 : ENDIF 314 : * increments de deformations: IVADS 315 : if(lnomid(5).ne.0) then 316 : nomid=lnomid(5) 317 : segact nomid 318 : ndef=lesobl(/2) 319 : nfac=lesfac(/2) 320 : moepsi=nomid 321 : lsupde=.false. 322 : else 323 : lsupde=.true. 323 : CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NFAC) 324 : endif 324 : CALL KOMCHA(IPCHE4,MELEME,CONM,MOEPSI,MOTYPE,1,INFOS,3,IVADS) 325 : IF (ISUP4.EQ.1) THEN 326 : ippore=0 326 : CALL VALCHE(IVADS,NDEF,IPMINT,ippore) 327 : SEGSUP NOTYPE 328 : goto 888 329 : ENDIF 330 : * caracteristiques materielles: IVAMAT 331 : if(lnomid(6).ne.0) then 332 : nomid=lnomid(6) 333 : segact nomid 334 : momatr=nomid 335 : nmatr=lesobl(/2) 336 : nmatf=lesfac(/2) 337 : lsupma=.false. 338 : else 339 : lsupma=.true. 339 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 340 : endif 340 : CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 341 : SEGSUP NOTYPE 342 : NMATT=NMATR+NMATF 343 : IF (ISUP5.EQ.1) THEN 344 : ippore=0 344 : CALL VALCHE(IVAMAT,NMATT,IPMINT,ippore) 345 : goto 888 346 : ENDIF 347 : * Creacion de los mchamls de las zonas 348 : NBPTEL=NBGS 349 : NEL =NBELEM 350 : N1PTEL=NBPTEL 351 : N1EL =NEL 352 : * contraintes 353 : N2 =NSTRS 354 : SEGINI MCHAML 355 : MCHELM.ICHAML(ISOUS)=MCHAML 356 : mchelm.conche(isous) = conmod 357 : NS =1 358 : NCOSOU=NSTRS 359 : SEGINI MPTVAL 360 : IVASTF=MPTVAL 361 : NOMID =MOSTRS 362 : SEGACT NOMID 363 : DO ICOMP=1,NSTRS 364 : MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP) 365 : MCHAML.TYPCHE(ICOMP)='REAL*8' 366 : N2PTEL=0 367 : N2EL=0 368 : SEGINI MELVAL 369 : MCHAML.IELVAL(ICOMP)=MELVAL 370 : IVAL(ICOMP)=MELVAL 371 : enddo 372 : SEGDES NOMID 373 : * variables internes 374 : N2 =NVART 375 : SEGINI MCHAM1 376 : MCHEL1.ICHAML(ISOUS)=MCHAM1 377 : mchel1.conche(isous) = conmod 378 : NS =1 379 : NCOSOU=NVART 380 : SEGINI MPTVAL 381 : IVARIF=MPTVAL 382 : NOMID=MOVARI 383 : SEGACT NOMID 384 : DO ICOMP=1,NVARI 385 : MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP) 386 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 387 : N2PTEL=0 388 : N2EL=0 389 : SEGINI MELVAL 390 : MCHAM1.IELVAL(ICOMP)=MELVAL 391 : IVAL(ICOMP)=MELVAL 392 : enddo 393 : DO ICOMP=NVARI+1,NVART 394 : MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP) 395 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 396 : N2PTEL=0 397 : N2EL=0 398 : SEGINI MELVAL 399 : MCHAM1.IELVAL(ICOMP)=MELVAL 400 : IVAL(ICOMP)=MELVAL 401 : enddo 402 : SEGDES NOMID 403 : N1PTEL=NBPTEL 404 : N1EL=NEL 405 : N2=NDEF 406 : SEGINI MCHAM2 407 : MCHEL2.ICHAML(ISOUS)=MCHAM2 408 : mchel2.conche(isous) = conmod 409 : NS=1 410 : NCOSOU=NDEF 411 : SEGINI MPTVAL 412 : IVADEP=MPTVAL 413 : NOMID=MOEPSI 414 : SEGACT NOMID 415 : DO ICOMP=1,NDEF 416 : MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP) 417 : MCHAM2.TYPCHE(ICOMP)='REAL*8' 418 : N2PTEL=0 419 : N2EL=0 420 : SEGINI MELVAL 421 : MCHAM2.IELVAL(ICOMP)=MELVAL 422 : IVAL(ICOMP)=MELVAL 423 : enddo 424 : SEGDES NOMID 424 : CALL SSTE2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI, 425 : . NBELEM,NBPTEL,NBNN,LRE,MFR, 426 : . IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT, 427 : . IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7, 428 : . PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE) 429 : 430 : * Desactivar segmentos 431 : SEGDES MELEME,IMODEL,descr,xmatri 432 : 433 : IF(ISUP1.EQ.1)THEN 433 : CALL DTMVAL (IVASTR,3) 434 : ELSE 434 : CALL DTMVAL (IVASTR,1) 435 : ENDIF 436 : IF(ISUP2.EQ.1)THEN 436 : CALL DTMVAL (IVARI,3) 437 : ELSE 437 : CALL DTMVAL (IVARI,1) 438 : ENDIF 439 : IF(ISUP4.EQ.1)THEN 439 : CALL DTMVAL (IVADS,3) 440 : ELSE 440 : CALL DTMVAL (IVADS,1) 441 : ENDIF 442 : IF(ISUP5.EQ.1)THEN 442 : CALL DTMVAL (IVAMAT,3) 443 : ELSE 443 : CALL DTMVAL (IVAMAT,1) 444 : ENDIF 445 : IF (KERRE.EQ.0) THEN 445 : CALL DTMVAL (IVASTF,1) 445 : CALL DTMVAL (IVARIF,1) 445 : CALL DTMVAL (IVADEP,1) 446 : SEGDES MCHAML,MCHAM1,MCHAM2,MINTE 447 : ELSE 447 : CALL DTMVAL (IVASTF,3) 447 : CALL DTMVAL (IVARIF,3) 447 : CALL DTMVAL (IVADEP,3) 448 : SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE 449 : GO TO 888 450 : END IF 451 : IF (MOSTRS.NE.0) THEN 452 : NOMID=MOSTRS 453 : if(lsupco)SEGSUP NOMID 454 : END IF 455 : IF (lsupva.and.MOVARI.NE.0) THEN 456 : NOMID=MOVARI 457 : SEGSUP NOMID 458 : END IF 459 : IF (lsupde.and.MOEPSI.NE.0) THEN 460 : NOMID=MOEPSI 461 : SEGSUP NOMID 462 : END IF 463 : IF (MOMATR.NE.0) THEN 464 : NOMID=MOMATR 465 : if(lsupma)SEGSUP NOMID 466 : END IF 467 : * IF (IPINF .NE.0) THEN 468 : * INFO=IPINF 469 : * SEGSUP INFO 470 : * END IF 471 : 1000 continue 472 : 888 CONTINUE 473 : SEGDES MMODEL*NOMOD 474 : IF(KERRE.EQ.0)THEN 475 : SEGDES MCHELM,MCHEL1,MCHEL2,MRIGID,xMATRI,DESCR 476 : ELSE 477 : SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID,xMATRI,DESCR 478 : ENDIF 479 : RETURN 480 : END 481 : 482 : 483 : 484 : 485 : 486 : 487 : 488 : 489 : 490 : 491 : 492 : 493 : 494 : 495 :
© Cast3M 2003 - All rights reserved.
Disclaimer