fefp1
C FEFP1 SOURCE OF166741 25/02/21 21:16:26 12166
. 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
-INC TMPTVAL
SEGMENT NOTYPE
CHARACTER*16 TYPE(NBTYPE)
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
NSR =1
NCOSOR=NSTRS
SEGINI MPTVAL
c usa NSR, NCOSOR
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
NSR =1
NCOSOR=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
NSR =1
NCOSOR=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