fefp1
C FEFP1 SOURCE CB215821 24/04/12 21:15:57 11897 . IPCHE7,IPCHE8,IPCHE9,IPRIGI, . PRECIS,NITMAX,NUPDATE) ************************************************************************* * entrees: * ipmodl = pointeur sur un objet mmodel * ipche1 = pointeur sur un mchaml de deformations * ipche2 = pointeur sur un mchaml de variables internes initiales * ipche3 = pointeur sur un mchaml de deplacements entre depart et arrivee * ipcar = pointeur sur un mchaml de caracteristiques * precis = precision des iterations internes * nitmax = maximum number of iterations at local level * nupdate = total (0) / update (1) lagrangian formulation * sorties: * ipche7 = pointeur sur un mchaml de contraintes * ipche8 = pointeur sur un mchaml de variables internes * ipche9 = pointeur sur un mchaml de deformations * iprigi = pointeur sur l'objet de type rigidite ************************************************************************* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMCHAML -INC SMCOORD -INC SMELEME -INC SMINTE -INC SMMODEL -INC SMRIGID SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT SEGMENT MPTVAL INTEGER IPOS(NS), NSOF(NS), IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT CHARACTER*8 CMATE CHARACTER*(NCONCH) CONM PARAMETER (NINF=3) INTEGER INFOS(NINF) LOGICAL lsupfo,lsupva,lsupdp,lsupma,lsupco,lsupdd ************************ * Activar el modelo ************************ MMODEL=IPMODL SEGACT MMODEL c Usa N1 NSOUS=MMODEL.KMODEL(/1) ************************ * Creation de los 3 mchelms de salida ************************ N1=NSOUS L1=11 N3=6 SEGINI MCHELM c Usa L1, N1, N3 MCHELM.TITCHE='CONTRAINTES' MCHELM.IFOCHE=IFOUR IPCHE7=MCHELM L1=18 SEGINI MCHEL1 MCHEL1.TITCHE='VARIABLES INTERNES' MCHEL1.IFOCHE=IFOUR IPCHE8=MCHEL1 L1=25 SEGINI MCHEL2 MCHEL2.TITCHE='DEFORMATIONS INELASTIQUES' MCHEL2.IFOCHE=IFOUR IPCHE9=MCHEL2 ************************ * Creacion del objeto rigidite ************************ NRIGE =7 NRIGEL=NSOUS SEGINI MRIGID c Usa NRIGE, NRIGEL MRIGID.MTYMAT = 'RIGIDITE' MRIGID.ICHOLE=0 MRIGID.IMGEO1=0 MRIGID.IMGEO2=0 MRIGID.IFORIG=IFOUR DO ISOUS=1,NSOUS MRIGID.COERIG(ISOUS)=1.D0 MRIGID.IRIGEL(4,ISOUS)=0 ENDDO IPRIGI=MRIGID c***************************************************************** c INICIO bucle sobre zonas c***************************************************************** DO 1000 ISOUS=1,NSOUS c***************************************************************** ************************ * Recuperar la informacion general de la zona ************************ c Activa el modelo de la zona IMODEL=KMODEL(ISOUS) SEGACT IMODEL c Usa MN3, NFOR, NMAT MELE =IMODEL.NEFMOD MELEME=IMODEL.IMAMOD c malla CONM =IMODEL.CONMOD c nombre del componente (blanco por defecto) c Activa la malla SEGACT MELEME c Usa NBNN,NBELEM,NBSOUS,NBREF NBNN =MELEME.NUM(/1) NBELEM=MELEME.NUM(/2) c Tipo de material NFOR =IMODEL.FORMOD(/2) c tamanyo nombre formulacion NMAT =IMODEL.MATMOD(/2) c tamanyo nombre material c entra: FORMOD,NFOR,MATMOD,NMAT c sale : CMATE,MATE,INPLAS * Controla que sea material de trabajo: * VMT_FEFP, RHMC_FEFP, POWDERCAP_FEFP,POWDER_FEFP IF ((INPLAS.ne.114).and.(INPLAS.ne.115).and. . (INPLAS.ne.116).and.(INPLAS.ne.117)) then write(*,*) ' Material no disponible',inplas ENDIF ************************ * informacion de elementos finitos ************************ * activa un segmento q se llama luego INFO, q tiene INFELE * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) c entra: MELE,IMODEL c sale : IPINF * INFO =IPINF * MELE =INFO.INFELE(1) MELE =INFELE(1) c numero de elemento finito * NBGS =INFO.INFELE(4) NBGS =INFELE(4) c num de puntos de integracion para sigma * NBG =INFO.INFELE(6) NBG =INFELE(6) c num de puntos de integracion para rigidite * IPORE=INFO.INFELE(8) IPORE=INFELE(8) c nombre funciones de forma * LRE =INFO.INFELE(9) LRE =INFELE(9) c grados libertad en rigidite * LHOOK=INFO.INFELE(10) LHOOK=INFELE(10) c tamaño matriz de hook * MINTE=INFO.INFELE(11) minte=infmod(7) c segmento de integracion * MFR =INFO.INFELE(13) MFR =INFELE(13) c formulacion de los elementos * NDDL =INFO.INFELE(15) NDDL =INFELE(15) c numero maximo de grados de libertad por nodo * NSTRS=INFO.INFELE(16) NSTRS=INFELE(16) c componentes de sigma y defor * Controla que sean elementos masivos IF ((MFR.lt.1).or.(MFR.gt.1)) then write(*,*) ' Tipo de elemento no disponible' ENDIF ************************ * Llena informacion base en los 3 campos de salida ************************ MCHELM.IMACHE(ISOUS)=MELEME MCHELM.CONCHE(ISOUS)=CONM MCHEL1.IMACHE(ISOUS)=MELEME MCHEL1.CONCHE(ISOUS)=CONM MCHEL2.IMACHE(ISOUS)=MELEME MCHEL2.CONCHE(ISOUS)=CONM MCHELM.INFCHE(ISOUS,1)=0 MCHELM.INFCHE(ISOUS,2)=0 MCHELM.INFCHE(ISOUS,3)=NIFOUR MCHELM.INFCHE(ISOUS,4)=MINTE MCHELM.INFCHE(ISOUS,5)=0 MCHELM.INFCHE(ISOUS,6)=5 MCHEL1.INFCHE(ISOUS,1)=0 MCHEL1.INFCHE(ISOUS,2)=0 MCHEL1.INFCHE(ISOUS,3)=NIFOUR MCHEL1.INFCHE(ISOUS,4)=MINTE MCHEL1.INFCHE(ISOUS,5)=0 MCHEL1.INFCHE(ISOUS,6)=5 MCHEL2.INFCHE(ISOUS,1)=0 MCHEL2.INFCHE(ISOUS,2)=0 MCHEL2.INFCHE(ISOUS,3)=NIFOUR MCHEL2.INFCHE(ISOUS,4)=MINTE MCHEL2.INFCHE(ISOUS,5)=0 MCHEL2.INFCHE(ISOUS,6)=5 ************************ * Llena informacion base de la rigidite ************************ * Activa segmento MINTE NBNO =NBNN SEGACT MINTE c Usa NBPGAU,NBNO NBPGAU=MINTE.POIGAU(/1) * Inicializa segmento descr, descripcion incognitas matriz rigidite NLIGRP=LRE NLIGRD=LRE SEGINI DESCR c Usa NLIGRP,NLGRD IPDESCR=DESCR if(lnomid(1).ne.0) then nomid=lnomid(1) segact nomid modepl=nomid ndepl=lesobl(/2) ndum=lesfac(/2) lsupdp=.false. else lsupdp=.true. endif c entra: MFR,IFOUR c sale : MODEPL (nombres comp. despl),NDEPL (numero obli),NDUM (n. opta) if(lnomid(2).ne.0) then nomid=lnomid(2) segact nomid moforc=nomid nforc=lesobl(/2) lsupfo=.false. else lsupfo=.true. endif c entra: MFR,IFOUR c sale : MOFORC (nombres comp. fuerz),NFORC (numero obli),NDUM (n. opta) * Llena el segmento descr con los nombres de las incognitas IDDL=1 NCOMP =NDEPL NBNNS =NBNN NOMID =MODEPL SEGACT NOMID NOMID =MOFORC SEGACT NOMID * write(6,*)'nbnns ncomp nligrp nligrd',nbnns,ncomp,nligrp,nligrd DO INOEUD=1,NBNNS DO ICOMP=1,NCOMP NOMID=MODEPL DESCR.LISINC(IDDL)=LESOBL(ICOMP) NOMID=MOFORC DESCR.LISDUA(IDDL)=LESOBL(ICOMP) NOELEP(IDDL)=INOEUD NOELED(IDDL)=INOEUD IDDL=IDDL+1 ENDDO ENDDO NOMID =MODEPL NOMID =MOFORC * Inicializa segment xmatri, le segment * contenant les matrices de rigidite elementaires NELRIG =NBELEM SEGINI xMATRI c usa NELRIG * Trata la rigidite MRIGID.IRIGEL(1,ISOUS)=MELEME MRIGID.IRIGEL(2,ISOUS)=0 MRIGID.IRIGEL(3,ISOUS)=IPDESCR * passer en ro segact descr MRIGID.IRIGEL(4,ISOUS)=xMATRI MRIGID.IRIGEL(5,ISOUS)=NIFOUR MRIGID.IRIGEL(6,ISOUS)=0 c no simetricas = 2, simetricas = 0 IRIGE7=0 c con friccion tiene que usarse simetrizadas... c queda pendiente de arreglar if (INPLAS.eq.116.or.INPLAS.eq.117) IRIGE7=2 MRIGID.IRIGEL(7,ISOUS)=IRIGE7 xmatri.symre=irige7 ************************ * tratamiento de los 4 campos dados ************************ c DUDAS ESTE TROZO c creation du tableau infos: no se para q, pero evita error en komcha c nbno, no se pq! c aqui se miraba que las tensiones y las var int ini fuesen compatibles ?? c ahora no hay campo de tensiones iniciales pero si campo de def plasticas c se ha de hacer eso igualmente????. => Si no se hace da un error en comcha ! c entra: c meleme = puntero zona considerada c conm = nombre del constituyente? c ipche1 y ipche2 = puntero campos c sale c INFOS = tabla de infche para komcha c IRTD = 0 si no son compatibles c IF (IRTD.EQ.0)THEN c write(*,*)' no compatibles' c SEGSUP MCHELM,MCHEL1,MCHEL2 c INFO=IPINF c SEGSUP INFO c RETURN c ENDIF c DUDAS ESTE TROZO ********************************************** c tipo de variables de trabajo NBTYPE =1 SEGINI NOTYPE NOTYPE.TYPE(1)='REAL*8' ********************************************** IPCHE1 => IVADPI * deformaciones plasticas iniciales if(lnomid(13).ne.0) then nomid=lnomid(13) segact nomid modein=nomid ndef=lesobl(/2) nfac=lesfac(/2) lsupdd=.false. else lsupdd=.true. endif ********************************************** IPCHE2 => IVARI * variables internes if(lnomid(10).ne.0) then nomid=lnomid(10) segact nomid movari=nomid nvari=lesobl(/2) nvarf=lesfac(/2) lsupva=.false. else lsupva=.true. endif NVART=NVARI+NVARF ********************************************** IPCHE3 => IVADESP * campo de desplazamientos if(lnomid(1).ne.0) then nomid=lnomid(1) segact nomid modepl=nomid ndep=lesobl(/2) nfac=lesfac(/2) lsupdp=.false. else lsupdp=.true. endif ********************************************** IPMODL => IVAMAT * caracteristiques materielles if(lnomid(6).ne.0) then nomid=lnomid(6) segact nomid momatr=nomid nmatr=lesobl(/2) nmatf=lesfac(/2) lsupma=.false. else lsupma=.true. endif NMATT=NMATR+NMATF SEGSUP NOTYPE ********************************************** IPCAR => no hay... * caracteristiques geometriques ********************************************** * Creacion de los mchamls de las zonas ********************************************** NBPTEL=NBGS NEL =NBELEM N1PTEL=NBPTEL N1EL =NEL ********************************* * tensiones ********************************* if(lnomid(4).ne.0) then nomid=lnomid(4) segact nomid mostrs=nomid nstrs=lesobl(/2) nfac=lesfac(/2) lsupco=.false. else lsupco=.true. endif c entra: IMODEL,IFOUR c sale : MOSTRS,NSTRS,NFAC N2 =NSTRS SEGINI MCHAML c usa N2 MCHELM.ICHAML(ISOUS)=MCHAML NS =1 NCOSOU=NSTRS SEGINI MPTVAL c usa NS, NCOSOU IVASTF=MPTVAL NOMID =MOSTRS SEGACT NOMID c usa NBROBL, NBRFAC DO ICOMP=1,NSTRS MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP) MCHAML.TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL =0 SEGINI MELVAL c usa N1PTEL, N1EL, N2PTEL, N2EL MCHAML.IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL enddo ********************************* * variables internes N2 =NVART SEGINI MCHAM1 MCHEL1.ICHAML(ISOUS)=MCHAM1 NS =1 NCOSOU=NVART SEGINI MPTVAL IVARIF=MPTVAL NOMID =MOVARI SEGACT NOMID DO ICOMP=1,NVARI MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP) MCHAM1.TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL =0 SEGINI MELVAL MCHAM1.IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL enddo if (nvari.lt.nvart) then DO ICOMP=NVARI+1,NVART MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP) MCHAM1.TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL =0 SEGINI MELVAL MCHAM1.IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL enddo endif ********************************* * deformations inelastiques N1PTEL=NBPTEL N1EL =NEL N2 =NDEF SEGINI MCHAM2 MCHEL2.ICHAML(ISOUS)=MCHAM2 NS =1 NCOSOU=NDEF SEGINI MPTVAL IVADPF=MPTVAL NOMID =MODEIN SEGACT NOMID DO ICOMP=1,NDEF MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP) MCHAM2.TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL =0 SEGINI MELVAL MCHAM2.IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL enddo ****************************************************************** KERRE=0 . NBELEM,NBPTEL,NBNN,LRE,MFR, . IVADESP,IVADPI,IVARI,IVAMAT, . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7, . NDEP,NDEF,NSTRS,NVART,NMATT,PRECIS,NITMAX, . NUPDATE,KERRE) ****************************************************************** * Desactivar segmentos c desactiva malla y modelo de la zona (*NOMOD?) c desactiva las entradas c desactiva/elimina las salidas SEGDES,xMATRI IF (KERRE.NE.0) THEN SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE,xMATRI,DESCR GO TO 888 END IF c elimina auxiliares NOMID=MODEPL IF (MODEPL.NE.0.and.lsupdp) SEGSUP NOMID NOMID=MOFORC IF (lsupfo.and.MOFORC.NE.0) SEGSUP NOMID NOMID=MOSTRS IF (MOSTRS.NE.0.and.lsupco) SEGSUP NOMID NOMID=MOVARI IF (lsupva.and.MOVARI.NE.0) SEGSUP NOMID NOMID=MODEIN IF (MODEIN.NE.0.and.lsupdd) SEGSUP NOMID NOMID=MOMATR IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID * INFO=IPINF * IF (IPINF .NE.0) SEGSUP INFO c***************************************************************** c FIN bucle sobre zonas 1000 continue c***************************************************************** 888 CONTINUE c desactiva el modelo c desactiva/elimina las salidas SEGDES,MRIGID IF(KERRE.NE.0) SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID RETURN END
© Cast3M 2003 - Tous droits réservés.
Mentions légales