Sources Esope | Cast3M

fefp
C FEFP      SOURCE    JB251061  23/05/10    21:15:10     11667          
*---------------------------------------------------------------------
*                    Integration of FeFp models
*---------------------------------------------------------------------
c      SUBROUTINE FEFP
c      SUBROUTINE FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
c     .                 IPCHE7,IPCHE8,IPCHE9,IPRIGI,
c     .                 PRECIS,NITMAX,NUPDATE)
c      SUBROUTINE FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,IMATRI,
c     .     NBELEM,NBPTEL,NBNN,LRE,MFR,
c     .     IVADESP,IVADPI,IVARI,IVAMAT,
c     .     IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7,
c     .     NDEP,NDEF,NSTRS,NVARI,NMATT,PRECIS,NITMAX,NUPDATE,
c     .     KERRE)
c      subroutine apf_driver_fefp(BE,VARF,SIGF,DDHOOK,
c     .                           NDEF,NVARI,NSTRS,LHOOK,
c     .                           XMAT,xdensi,PRECIS,NITMAX,KERRE,
c     .                           nescri,nues,nmodel,nnumer,deltax,
c     .                           level,kmax,iaugla,caugla)
c      subroutine pushf35(a,f,a1)
c      subroutine prin35(b,bpr,qen,q6,q6t)
c      subroutine eig35(v,d,rot)
*---------------------------------------------------------------------
*---------------------------------------------------------------------
*---------------------------------------------------------------------
      SUBROUTINE FEFP
*---------------------------------------------------------------------
*                    Integration of FeFp models
*---------------------------------------------------------------------
* SYNTAXE=
*    SIGF VARF DEPPFI RI1 = 'ECFEFP'  MODL DEPPL0 VAR0 ZDEPT CARAC
*                                     (PRECIS) (NITMAX) (NUPDATE);
* IN=
*  MMODEL     |    MODL    OBJET MODELE
*  MCHAML     |    DEPPL0  DEFORMATIONS INELASTIQUES AU DEBUT DU PAS
*  MCHAML     |    VAR0    VARIABLES INTERNES AU DEBUT DU PAS
*  CHAMPOINT  |    ZDEPT   deplacements entre conf de depart et arrivee
*  MCHAML     |    CARAC   CARACTERISTIQUES GEOMETRIQUES
*  FLOTTANT   |    PRECIS  PRECISION POUR ITERATIONS INTERNES
*  INTEGER    |    NITMAX  maximum number of iterations at local level
*  INTEGER    |    NUPDATE =1 UPDATE ; =0 TOTAL - LAGRANGIAN
*
* OUT=
*  MCHAML     |    SIGF    CONTRAINTES A LA FIN DU PAS
*  MCHAML     |    VARF    VARIABLES INTERNES A LA FIN DU PAS
*  MCHAML     |    DEPIN   DEFORMATIONS INELASTIQUES A LA FIN DU PAS
*  MRIGI      |    RI1     CONSISTENT TANGENT MATRIX
*---------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMCOORD
 
      segact mcoord
************************
* Lectura de datos
************************
* modelo
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRT)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
 
* deformacion plastica inicial
      CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF (IERR.NE.0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
 
      MCHELM=IPCHE1
      SEGACT MCHELM
c     Usa L1, N1, N3
      IF(MCHELM.TITCHE.NE.'DEFORMATIONS INELASTIQUES')THEN
        MOTERR(1:32)='DEFORMATIONS INELASTIQUES'
        CALL ERREUR(565)
        RETURN
      ENDIF
 
* variables internas iniciales
      CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF(IERR .NE. 0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
 
      MCHELM=IPCHE2
      SEGACT MCHELM
      IF(TITCHE.NE.'VARIABLES INTERNES')THEN
        MOTERR(1:32)='VARIABLES INTERNES'
        CALL ERREUR(565)
        RETURN
      ENDIF
 
* incremento de desplazamientos
      CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT)
      CALL ACTOBJ('CHPOINT ',IPCHP1,1)
      IF(IERR .NE. 0) RETURN
 
*     paso de campo nodal a campo elemental en nodos (ct=1)
      CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE3,1)
      IF(IERR .NE. 0) RETURN
 
* caracteristicas materiales y geometricas
      CALL LIROBJ('MCHAML  ',IPIN,1,IRT)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF(IERR .NE. 0) RETURN
      CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
 
      MCHELM=IPCAR
      SEGACT MCHELM
      IF(TITCHE.NE.'CARACTERISTIQUES')THEN
        MOTERR(1:32)='CARACTERISTIQUES'
        CALL ERREUR(565)
        RETURN
      ENDIF
 
* precision para iteraciones internas
      CALL LIRREE(PRECIS,0,IRT)
      IF(IRT.EQ.0) PRECIS=1.D-10
 
* num max de iteraciones internas
      CALL LIRENT(NITMAX,0,IRT)
      IF (IRT.EQ.0) NITMAX=25
 
* Update or total (default) lagrangian formulation
      CALL LIRENT(NUPDATE,0,IRT)
      IF (IRT.EQ.0) NUPDATE=0
 
* deformacion plana o axisimetrico
      IF ((IFOUR.gt.0).or.(IFOUR.lt.-1)) then
         write(*,*) ' Formulacion no disponible'
         return
      endif
 
************************
* calcular
************************
      CALL FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
     .           IPCHE7,IPCHE8,IPCHE9,IPRIGI,
     .           PRECIS,NITMAX,NUPDATE)
      IF(IERR .NE. 0) RETURN
 
************************
* escribir resultados
************************
      CALL ACTOBJ('MCHAML  ',IPCHE9,1)
      CALL ACTOBJ('MCHAML  ',IPCHE8,1)
      CALL ACTOBJ('MCHAML  ',IPCHE7,1)
 
      CALL ECROBJ('MCHAML  ',IPCHE9)
      CALL ECROBJ('MCHAML  ',IPCHE8)
      CALL ECROBJ('MCHAML  ',IPCHE7)
 
      CALL ECROBJ('RIGIDITE',IPRIGI)
 
* borrar los desplazamientos en campo elemental
      END