1 : C FEFP1 SOURCE CHAT 11/03/16 21:22:12 6902 2 : 3 : SUBROUTINE FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR, 4 : . IPCHE7,IPCHE8,IPCHE9,IPRIGI, 5 : . PRECIS,NITMAX,NUPDATE) 6 : ************************************************************************* 7 : * entrees: 8 : * ipmodl = pointeur sur un objet mmodel 9 : * ipche1 = pointeur sur un mchaml de deformations 10 : * ipche2 = pointeur sur un mchaml de variables internes initiales 11 : * ipche3 = pointeur sur un mchaml de deplacements entre depart et arrivee 12 : * ipcar = pointeur sur un mchaml de caracteristiques 13 : * precis = precision des iterations internes 14 : * nitmax = maximum number of iterations at local level 15 : * nupdate = total (0) / update (1) lagrangian formulation 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 SMCOORD 29 : -INC SMELEME 30 : -INC SMINTE 31 : -INC SMMODEL 32 : -INC SMRIGID 33 : SEGMENT NOTYPE 34 : CHARACTER*16 TYPE(NBTYPE) 35 : ENDSEGMENT 36 : SEGMENT MPTVAL 37 : INTEGER IPOS(NS), NSOF(NS), IVAL(NCOSOU) 38 : CHARACTER*16 TYVAL(NCOSOU) 39 : ENDSEGMENT 40 : CHARACTER*8 CMATE 41 : CHARACTER*(NCONCH) CONM 42 : PARAMETER (NINF=3) 43 : INTEGER INFOS(NINF) 44 : LOGICAL lsupfo,lsupva,lsupdp,lsupma,lsupco,lsupdd 45 : 46 : ************************ 47 : * Activar el modelo 48 : ************************ 49 : MMODEL=IPMODL 50 : SEGACT MMODEL 51 : c Usa N1 52 : NSOUS=MMODEL.KMODEL(/1) 53 : 54 : ************************ 55 : * Creation de los 3 mchelms de salida 56 : ************************ 57 : N1=NSOUS 58 : L1=11 59 : N3=6 60 : SEGINI MCHELM 61 : c Usa L1, N1, N3 62 : MCHELM.TITCHE='CONTRAINTES' 63 : MCHELM.IFOCHE=IFOUR 64 : IPCHE7=MCHELM 65 : L1=18 66 : SEGINI MCHEL1 67 : MCHEL1.TITCHE='VARIABLES INTERNES' 68 : MCHEL1.IFOCHE=IFOUR 69 : IPCHE8=MCHEL1 70 : L1=25 71 : SEGINI MCHEL2 72 : MCHEL2.TITCHE='DEFORMATIONS INELASTIQUES' 73 : MCHEL2.IFOCHE=IFOUR 74 : IPCHE9=MCHEL2 75 : 76 : ************************ 77 : * Creacion del objeto rigidite 78 : ************************ 79 : NRIGE =7 80 : NRIGEL=NSOUS 81 : SEGINI MRIGID 82 : c Usa NRIGE, NRIGEL 83 : MRIGID.MTYMAT = 'RIGIDITE' 84 : MRIGID.ICHOLE=0 85 : MRIGID.IMGEO1=0 86 : MRIGID.IMGEO2=0 87 : MRIGID.IFORIG=IFOUR 88 : DO ISOUS=1,NSOUS 89 : MRIGID.COERIG(ISOUS)=1.D0 90 : MRIGID.IRIGEL(4,ISOUS)=0 91 : ENDDO 92 : IPRIGI=MRIGID 93 : 94 : c***************************************************************** 95 : c INICIO bucle sobre zonas 96 : c***************************************************************** 97 : DO 1000 ISOUS=1,NSOUS 98 : c***************************************************************** 99 : 100 : ************************ 101 : * Recuperar la informacion general de la zona 102 : ************************ 103 : c Activa el modelo de la zona 104 : IMODEL=KMODEL(ISOUS) 105 : SEGACT IMODEL 106 : c Usa MN3, NFOR, NMAT 107 : MELE =IMODEL.NEFMOD 108 : MELEME=IMODEL.IMAMOD 109 : c malla 110 : CONM =IMODEL.CONMOD 111 : c nombre del componente (blanco por defecto) 112 : 113 : c Activa la malla 114 : SEGACT MELEME 115 : c Usa NBNN,NBELEM,NBSOUS,NBREF 116 : NBNN =MELEME.NUM(/1) 117 : NBELEM=MELEME.NUM(/2) 118 : 119 : c Tipo de material 120 : NFOR =IMODEL.FORMOD(/2) 121 : c tamanyo nombre formulacion 122 : NMAT =IMODEL.MATMOD(/2) 123 : c tamanyo nombre material 123 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS) 124 : c entra: FORMOD,NFOR,MATMOD,NMAT 125 : c sale : CMATE,MATE,INPLAS 126 : 127 : * Controla que sea material de trabajo: 128 : * VMT_FEFP, RHMC_FEFP, POWDERCAP_FEFP,POWDER_FEFP 129 : IF ((INPLAS.ne.114).and.(INPLAS.ne.115).and. 130 : . (INPLAS.ne.116).and.(INPLAS.ne.117)) then 131 : write(*,*) ' Material no disponible',inplas 132 : ENDIF 133 : 134 : ************************ 135 : * informacion de elementos finitos 136 : ************************ 137 : * activa un segmento q se llama luego INFO, q tiene INFELE 137 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 138 : c entra: MELE,IMODEL 139 : c sale : IPINF 140 : * INFO =IPINF 141 : * MELE =INFO.INFELE(1) 142 : MELE =INFELE(1) 143 : c numero de elemento finito 144 : * NBGS =INFO.INFELE(4) 145 : NBGS =INFELE(4) 146 : c num de puntos de integracion para sigma 147 : * NBG =INFO.INFELE(6) 148 : NBG =INFELE(6) 149 : c num de puntos de integracion para rigidite 150 : * IPORE=INFO.INFELE(8) 151 : IPORE=INFELE(8) 152 : c nombre funciones de forma 153 : * LRE =INFO.INFELE(9) 154 : LRE =INFELE(9) 155 : c grados libertad en rigidite 156 : * LHOOK=INFO.INFELE(10) 157 : LHOOK=INFELE(10) 158 : c tamańo matriz de hook 159 : * MINTE=INFO.INFELE(11) 160 : minte=infmod(7) 161 : c segmento de integracion 162 : * MFR =INFO.INFELE(13) 163 : MFR =INFELE(13) 164 : c formulacion de los elementos 165 : * NDDL =INFO.INFELE(15) 166 : NDDL =INFELE(15) 167 : c numero maximo de grados de libertad por nodo 168 : * NSTRS=INFO.INFELE(16) 169 : NSTRS=INFELE(16) 170 : c componentes de sigma y defor 171 : 172 : * Controla que sean elementos masivos 173 : IF ((MFR.lt.1).or.(MFR.gt.1)) then 174 : write(*,*) ' Tipo de elemento no disponible' 175 : ENDIF 176 : 177 : ************************ 178 : * Llena informacion base en los 3 campos de salida 179 : ************************ 180 : MCHELM.IMACHE(ISOUS)=MELEME 181 : MCHELM.CONCHE(ISOUS)=CONM 182 : MCHEL1.IMACHE(ISOUS)=MELEME 183 : MCHEL1.CONCHE(ISOUS)=CONM 184 : MCHEL2.IMACHE(ISOUS)=MELEME 185 : MCHEL2.CONCHE(ISOUS)=CONM 186 : MCHELM.INFCHE(ISOUS,1)=0 187 : MCHELM.INFCHE(ISOUS,2)=0 188 : MCHELM.INFCHE(ISOUS,3)=NIFOUR 189 : MCHELM.INFCHE(ISOUS,4)=MINTE 190 : MCHELM.INFCHE(ISOUS,5)=0 191 : MCHELM.INFCHE(ISOUS,6)=5 192 : MCHEL1.INFCHE(ISOUS,1)=0 193 : MCHEL1.INFCHE(ISOUS,2)=0 194 : MCHEL1.INFCHE(ISOUS,3)=NIFOUR 195 : MCHEL1.INFCHE(ISOUS,4)=MINTE 196 : MCHEL1.INFCHE(ISOUS,5)=0 197 : MCHEL1.INFCHE(ISOUS,6)=5 198 : MCHEL2.INFCHE(ISOUS,1)=0 199 : MCHEL2.INFCHE(ISOUS,2)=0 200 : MCHEL2.INFCHE(ISOUS,3)=NIFOUR 201 : MCHEL2.INFCHE(ISOUS,4)=MINTE 202 : MCHEL2.INFCHE(ISOUS,5)=0 203 : MCHEL2.INFCHE(ISOUS,6)=5 204 : 205 : ************************ 206 : * Llena informacion base de la rigidite 207 : ************************ 208 : * Activa segmento MINTE 209 : NBNO =NBNN 210 : SEGACT MINTE 211 : c Usa NBPGAU,NBNO 212 : NBPGAU=MINTE.POIGAU(/1) 213 : * Inicializa segmento descr, descripcion incognitas matriz rigidite 214 : NLIGRP=LRE 215 : NLIGRD=LRE 216 : SEGINI DESCR 217 : c Usa NLIGRP,NLGRD 218 : IPDESCR=DESCR 219 : if(lnomid(1).ne.0) then 220 : nomid=lnomid(1) 221 : segact nomid 222 : modepl=nomid 223 : ndepl=lesobl(/2) 224 : ndum=lesfac(/2) 225 : lsupdp=.false. 226 : else 227 : lsupdp=.true. 227 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 228 : endif 229 : c entra: MFR,IFOUR 230 : c sale : MODEPL (nombres comp. despl),NDEPL (numero obli),NDUM (n. opta) 231 : if(lnomid(2).ne.0) then 232 : nomid=lnomid(2) 233 : segact nomid 234 : moforc=nomid 235 : nforc=lesobl(/2) 236 : lsupfo=.false. 237 : else 237 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 238 : lsupfo=.true. 239 : endif 240 : c entra: MFR,IFOUR 241 : c sale : MOFORC (nombres comp. fuerz),NFORC (numero obli),NDUM (n. opta) 242 : * Llena el segmento descr con los nombres de las incognitas 243 : IDDL=1 244 : NCOMP =NDEPL 245 : NBNNS =NBNN 246 : NOMID =MODEPL 247 : SEGACT NOMID 248 : NOMID =MOFORC 249 : SEGACT NOMID 250 : * write(6,*)'nbnns ncomp nligrp nligrd',nbnns,ncomp,nligrp,nligrd 251 : DO INOEUD=1,NBNNS 252 : DO ICOMP=1,NCOMP 253 : NOMID=MODEPL 254 : DESCR.LISINC(IDDL)=LESOBL(ICOMP) 255 : NOMID=MOFORC 256 : DESCR.LISDUA(IDDL)=LESOBL(ICOMP) 257 : NOELEP(IDDL)=INOEUD 258 : NOELED(IDDL)=INOEUD 259 : IDDL=IDDL+1 260 : ENDDO 261 : ENDDO 262 : NOMID =MODEPL 263 : SEGDES NOMID 264 : NOMID =MOFORC 265 : SEGDES NOMID 266 : * Inicializa segment xmatri, le segment 267 : * contenant les matrices de rigidite elementaires 268 : NELRIG =NBELEM 269 : SEGINI xMATRI 270 : c usa NELRIG 271 : * Trata la rigidite 272 : MRIGID.IRIGEL(1,ISOUS)=MELEME 273 : MRIGID.IRIGEL(2,ISOUS)=0 274 : MRIGID.IRIGEL(3,ISOUS)=IPDESCR 275 : MRIGID.IRIGEL(4,ISOUS)=xMATRI 276 : MRIGID.IRIGEL(5,ISOUS)=NIFOUR 277 : MRIGID.IRIGEL(6,ISOUS)=0 278 : c no simetricas = 2, simetricas = 0 279 : IRIGE7=0 280 : c con friccion tiene que usarse simetrizadas... 281 : c queda pendiente de arreglar 282 : if (INPLAS.eq.116.or.INPLAS.eq.117) IRIGE7=2 283 : MRIGID.IRIGEL(7,ISOUS)=IRIGE7 284 : 285 : ************************ 286 : * tratamiento de los 4 campos dados 287 : ************************ 288 : c DUDAS ESTE TROZO 289 : c creation du tableau infos: no se para q, pero evita error en komcha 290 : c nbno, no se pq! 291 : NBNO=NBNNE(NUMGEO(MELE)) 292 : c aqui se miraba que las tensiones y las var int ini fuesen compatibles ?? 293 : c ahora no hay campo de tensiones iniciales pero si campo de def plasticas 294 : c se ha de hacer eso igualmente????. => Si no se hace da un error en comcha ! 294 : CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 295 : c entra: 296 : c meleme = puntero zona considerada 297 : c conm = nombre del constituyente? 298 : c ipche1 y ipche2 = puntero campos 299 : c sale 300 : c INFOS = tabla de infche para komcha 301 : c IRTD = 0 si no son compatibles 302 : c IF (IRTD.EQ.0)THEN 303 : c write(*,*)' no compatibles' 304 : c SEGDES IMODEL*NOMOD,MMODEL*NOMOD 305 : c SEGSUP MCHELM,MCHEL1,MCHEL2 306 : c INFO=IPINF 307 : c SEGSUP INFO 308 : c RETURN 309 : c ENDIF 310 : c DUDAS ESTE TROZO 311 : ********************************************** 312 : c tipo de variables de trabajo 313 : NBTYPE =1 314 : SEGINI NOTYPE 315 : NOTYPE.TYPE(1)='REAL*8' 316 : ********************************************** IPCHE1 => IVADPI 317 : * deformaciones plasticas iniciales 318 : if(lnomid(13).ne.0) then 319 : nomid=lnomid(13) 320 : segact nomid 321 : modein=nomid 322 : ndef=lesobl(/2) 323 : nfac=lesfac(/2) 324 : lsupdd=.false. 325 : else 326 : lsupdd=.true. 326 : CALL IDDEIN(IMODEL,IFOUR,MODEIN,NDEF,NFAC) 327 : endif 328 : 328 : CALL KOMCHA(IPCHE1,MELEME,CONM,MODEIN,NOTYPE,1,INFOS,3,IVADPI) 329 : ********************************************** IPCHE2 => IVARI 330 : * variables internes 331 : if(lnomid(10).ne.0) then 332 : nomid=lnomid(10) 333 : segact nomid 334 : movari=nomid 335 : nvari=lesobl(/2) 336 : nvarf=lesfac(/2) 337 : lsupva=.false. 338 : else 339 : lsupva=.true. 339 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) 340 : endif 340 : CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,NOTYPE,1,INFOS,3,IVARI) 341 : NVART=NVARI+NVARF 342 : ********************************************** IPCHE3 => IVADESP 343 : * campo de desplazamientos 344 : if(lnomid(1).ne.0) then 345 : nomid=lnomid(1) 346 : segact nomid 347 : modepl=nomid 348 : ndep=lesobl(/2) 349 : nfac=lesfac(/2) 350 : lsupdp=.false. 351 : else 352 : lsupdp=.true. 352 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEP,NFAC) 353 : endif 353 : CALL KOMCHA(IPCHE3,MELEME,CONM,MODEPL,NOTYPE,1,INFOS,3,IVADESP) 354 : ********************************************** IPMODL => IVAMAT 355 : * caracteristiques materielles 356 : if(lnomid(6).ne.0) then 357 : nomid=lnomid(6) 358 : segact nomid 359 : momatr=nomid 360 : nmatr=lesobl(/2) 361 : nmatf=lesfac(/2) 362 : lsupma=.false. 363 : else 364 : lsupma=.true. 364 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 365 : endif 365 : CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,NOTYPE,1,INFOS,3,IVAMAT) 366 : NMATT=NMATR+NMATF 367 : SEGSUP NOTYPE 368 : ********************************************** IPCAR => no hay... 369 : * caracteristiques geometriques 370 : 371 : ********************************************** 372 : * Creacion de los mchamls de las zonas 373 : ********************************************** 374 : NBPTEL=NBGS 375 : NEL =NBELEM 376 : N1PTEL=NBPTEL 377 : N1EL =NEL 378 : ********************************* 379 : * tensiones 380 : ********************************* 381 : if(lnomid(4).ne.0) then 382 : nomid=lnomid(4) 383 : segact nomid 384 : mostrs=nomid 385 : nstrs=lesobl(/2) 386 : nfac=lesfac(/2) 387 : lsupco=.false. 388 : else 389 : lsupco=.true. 389 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTRS,NFAC) 390 : endif 391 : c entra: IMODEL,IFOUR 392 : c sale : MOSTRS,NSTRS,NFAC 393 : N2 =NSTRS 394 : SEGINI MCHAML 395 : c usa N2 396 : MCHELM.ICHAML(ISOUS)=MCHAML 397 : NS =1 398 : NCOSOU=NSTRS 399 : SEGINI MPTVAL 400 : c usa NS, NCOSOU 401 : IVASTF=MPTVAL 402 : NOMID =MOSTRS 403 : SEGACT NOMID 404 : c usa NBROBL, NBRFAC 405 : DO ICOMP=1,NSTRS 406 : MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP) 407 : MCHAML.TYPCHE(ICOMP)='REAL*8' 408 : N2PTEL=0 409 : N2EL =0 410 : SEGINI MELVAL 411 : c usa N1PTEL, N1EL, N2PTEL, N2EL 412 : MCHAML.IELVAL(ICOMP)=MELVAL 413 : IVAL(ICOMP)=MELVAL 414 : enddo 415 : SEGDES NOMID 416 : ********************************* 417 : * variables internes 418 : N2 =NVART 419 : SEGINI MCHAM1 420 : MCHEL1.ICHAML(ISOUS)=MCHAM1 421 : NS =1 422 : NCOSOU=NVART 423 : SEGINI MPTVAL 424 : IVARIF=MPTVAL 425 : NOMID =MOVARI 426 : SEGACT NOMID 427 : DO ICOMP=1,NVARI 428 : MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP) 429 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 430 : N2PTEL=0 431 : N2EL =0 432 : SEGINI MELVAL 433 : MCHAM1.IELVAL(ICOMP)=MELVAL 434 : IVAL(ICOMP)=MELVAL 435 : enddo 436 : if (nvari.lt.nvart) then 437 : DO ICOMP=NVARI+1,NVART 438 : MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP) 439 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 440 : N2PTEL=0 441 : N2EL =0 442 : SEGINI MELVAL 443 : MCHAM1.IELVAL(ICOMP)=MELVAL 444 : IVAL(ICOMP)=MELVAL 445 : enddo 446 : endif 447 : SEGDES NOMID 448 : ********************************* 449 : * deformations inelastiques 450 : N1PTEL=NBPTEL 451 : N1EL =NEL 452 : N2 =NDEF 453 : SEGINI MCHAM2 454 : MCHEL2.ICHAML(ISOUS)=MCHAM2 455 : NS =1 456 : NCOSOU=NDEF 457 : SEGINI MPTVAL 458 : IVADPF=MPTVAL 459 : NOMID =MODEIN 460 : SEGACT NOMID 461 : DO ICOMP=1,NDEF 462 : MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP) 463 : MCHAM2.TYPCHE(ICOMP)='REAL*8' 464 : N2PTEL=0 465 : N2EL =0 466 : SEGINI MELVAL 467 : MCHAM2.IELVAL(ICOMP)=MELVAL 468 : IVAL(ICOMP)=MELVAL 469 : enddo 470 : SEGDES NOMID 471 : ****************************************************************** 472 : KERRE=0 472 : CALL FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI, 473 : . NBELEM,NBPTEL,NBNN,LRE,MFR, 474 : . IVADESP,IVADPI,IVARI,IVAMAT, 475 : . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7, 476 : . NDEP,NDEF,NSTRS,NVART,NMATT,PRECIS,NITMAX, 477 : . NUPDATE,KERRE) 478 : 479 : ****************************************************************** 480 : * Desactivar segmentos 481 : c desactiva malla y modelo de la zona (*NOMOD?) 482 : SEGDES MELEME 483 : SEGDES IMODEL 484 : c desactiva las entradas 484 : CALL DTMVAL (IVADPI ,1) 484 : CALL DTMVAL (IVARI ,1) 484 : CALL DTMVAL (IVADESP,1) 484 : CALL DTMVAL (IVAMAT ,1) 485 : c desactiva/elimina las salidas 485 : CALL DTMVAL (IVASTF ,1) 485 : CALL DTMVAL (IVARIF ,1) 485 : CALL DTMVAL (IVADPF ,1) 486 : SEGDES MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR 487 : IF (KERRE.NE.0) THEN 487 : CALL DTMVAL (IVASTF,3) 487 : CALL DTMVAL (IVARIF,3) 487 : CALL DTMVAL (IVADPF,3) 488 : SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR 489 : GO TO 888 490 : END IF 491 : c elimina auxiliares 492 : NOMID=MODEPL 493 : IF (MODEPL.NE.0.and.lsupdp) SEGSUP NOMID 494 : NOMID=MOFORC 495 : IF (lsupfo.and.MOFORC.NE.0) SEGSUP NOMID 496 : NOMID=MOSTRS 497 : IF (MOSTRS.NE.0.and.lsupco) SEGSUP NOMID 498 : NOMID=MOVARI 499 : IF (lsupva.and.MOVARI.NE.0) SEGSUP NOMID 500 : NOMID=MODEIN 501 : IF (MODEIN.NE.0.and.lsupdd) SEGSUP NOMID 502 : NOMID=MOMATR 503 : IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID 504 : * INFO=IPINF 505 : * IF (IPINF .NE.0) SEGSUP INFO 506 : c***************************************************************** 507 : c FIN bucle sobre zonas 508 : 1000 continue 509 : c***************************************************************** 510 : 888 CONTINUE 511 : 512 : c desactiva el modelo 513 : SEGDES MMODEL 514 : c desactiva/elimina las salidas 515 : SEGDES MCHELM,MCHEL1,MCHEL2,MRIGID 516 : IF(KERRE.NE.0) SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID 517 : 518 : RETURN 519 : END 520 : 521 : 522 : 523 : 524 :
© Cast3M 2003 - All rights reserved.
Disclaimer