C PIOCAU    SOURCE    PV090527  24/04/30    21:15:01     11926          
      SUBROUTINE PIOCAU(IM)
C=======================================================================
C   OPERATEUR TRANSFORMANT LES CONTRAINTES DE PIOLA KIRCHHOFF
C   EN CONTRAINTES DE CAUCHY ET RECIPROQUEMENT
C
C      IM = 0  :   SI2 = PICA MODL1 SI1 DU (UXFEM) (MODERIV);
C      IM = 1  :   SI2 = CAPI MODL1 SI1 DU (UXFEM) (MODERIV);
C
C      MODL1= OBJET MODELE (TYPE MMODEL)
C
C       SI1 = CHAMP  DE CONTRAINTES (TYPE MCHAML)EN ENTREE
C                OU DE DEFORMATIONS
C
C       SI2 = CHAMP  DE CONTRAINTES (TYPE MCHAML) EN SORTIE
C                OU DE DEFORMATIONS
C
C       DU  = INCRMT DE DEPLACEMENT ENTRE CONFIG DE DEPART ET ACTUELLE
C             (TYPE CHPOINT)
C
C       UXFEM = DEPLACEMENT ENRICHI ENTRE CONFIG FISSURE FERMEE ET
C               CONFIG DE DEPART (elements xq4r et xc8r)
C
C       MODERIV = mot cle optionnel parmi 'JAUM' ou 'UTIL'
C
C       CODE COMBESCURE SEPT 87
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)


-INC PPARAM
-INC CCOPTIO
-INC SMMODEL
-INC SMCHAML
      POINTEUR MCHEX1.MCHELM
C
      PARAMETER(NDERI=7)
      CHARACTER*4 MODERI(NDERI)
      DATA MODERI/'LINE','QUAD','I  ','II  ','TRUE','JAUM','UTIL'/
c       -> IDERI =  1      2     1      2      3      4      5
c          traitement particulier uniquement si IDERI = 4 ou 5
      
C-----------------------------------------------------------------------

      IPMODL=0
      IPCHE1=0
      IPCHE2=0
      IPCHP1=0
*as xfem 2010_01_13
      IPCHP0=0
      ICHAX1=0
      IDERI=0
      
c     option de calcul des deformations (par defaut lineaires)
      CALL LIRMOT(MODERI,NDERI,IDERI,0)
      IF(IDERI.EQ.0) IDERI=1
      IF(IDERI.GE.3) IDERI=IDERI-2

      CALL LIROBJ('MMODEL  ',IPMODL,1,IRT1)
      IF(IERR.NE.0) RETURN
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF(IERR.NE.0)RETURN
C
C     ON LIT LE MCHAML A TRANSFORMER
C
      CALL LIROBJ('MCHAML  ',IPIN,1,IRT1)
      if (ipin.eq.0) ierr=2
      IF(IERR.NE.0) RETURN
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF(IERR.NE.0) RETURN
      mchelm=ipin
      CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
      mchelm=ipche1
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN
C
C     ON LIT UN  CHPOINT DE DEPLACEMENTS
C
      CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT1)
      IF(IERR.NE.0) RETURN
      CALL ACTOBJ('CHPOINT ',IPCHP1,1)
      IF(IERR.NE.0) RETURN
C
      CALL LIROBJ('CHPOINT ',IPCHP0,0,IRT1)
      IF (IRT1 .EQ. 1) CALL ACTOBJ('CHPOINT ',IPCHP0,1)
      IF (IERR.NE.0) RETURN

*as xfem 2010_01_13
      if (ierr.ne.0) then
        if (ichax1.ne.0) then
          write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
     &       'deplacement entre la config. 0 et la config. de reference'
          return
        endif
      endif
C
      MMODEL = IPMODL
      NBPART = KMODEL(/1)
      IPICA = 0
      DO 4 IPART=1,NBPART
        IMODEL = KMODEL(IPART)
C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
C doivent pas modifier les champs !
* septembre 2019: cette restriction est enlevee
**      IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
C et ne doivent donc pas etre transportees !
        IF ( INATUU.EQ.-1) IPICA = IPICA+1
C Verification presence XFEM
*as xfem 2010_01_13
        NOBMO1=IVAMOD(/1)
        if (NOBMO1.ne.0) then
          Do iobmo1=1,NOBMO1
            if (TYMODE(iobmo1).eq.'MCHAML') then
              MCHEX1=IVAMOD(iobmo1)
              if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
                ICHAX1 = MCHEX1.ICHAML(1)
                goto 3
              endif
            endif
          Enddo
        endif
 3      CONTINUE
*fin as xfem 2010_01_13
 4    CONTINUE

C Presence XFEM -> pointeur ICHAX1 non nul
*as xfem 2010_01_13
      if (ichax1.ne.0 .and. ipchp0.EQ.0) then
        write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
     &      'deplacement entre la config. 0 et la config. de reference'
        CALL ERREUR(21)
        return
      endif

C IPICA = NBPART -> Le modele entier contient des modeles UMAT
C                   Recopie MCHAML IPCHE1 tel quel et on quitte
      IF (IPICA.EQ.NBPART) THEN
        IRET = 1
        CALL COPIE8(IPCHE1,IPCHE2)
C
C Melange de MODELEs : Traitement GENERAL
C
      ELSE
        IRET = 0
        CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IDERI,
     &              IPCHE2,IRET)
      ENDIF

      IF (IRET.EQ.1) THEN
        CALL ACTOBJ('MCHAML  ',IPCHE2,1)
        CALL ECROBJ('MCHAML  ',IPCHE2)
      ENDIF

      END