C PIOCAU    SOURCE    CHAT      11/03/16    21:29:02     6902           
      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) ;                                   
C      IM = 1  :   SI2 = CAPI MODL1 SI1 DU  (UXFEM) ;                                   
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       CODE COMBESCURE SEPT 87                                                 
C                                                                               
C       PASSAGE AUX NOUVEAUX  CHAMELEMS PAR P.DOWLATYARI  le 12/4/91            
C=======================================================================        
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC CCOPTIO                                                                    
-INC SMMODEL                                                             
-INC SMCHAML
      POINTEUR MCHEX1.MCHELM
C                                                                               
      IPCHA1=0                                                                  
      IPCHP1=0                                                                  
      IPCHE1=0                                                                  
      IPCHE2=0      
*as xfem 2010_01_13
      IPCHP0=0
      ICHAX1=0                                                            
      IRET=0

      IPMODL=0                                                                  
C                                                                               
      CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
      IF(IERR.NE.0)RETURN        
C
C     Je verifie que je n'utilise pas PICA avec un des modeles interdit (OTTOSEN, UO2)
C     j active le segment pour verifier son contenu
C
      MMODEL = IPMODL
      SEGACT MMODEL
*     Nombre de partitions :
      NBPART = KMODEL(/1)
      IPICA  = 0
*     Boucle sur les partitions du modèle.
*     Le chamelem résultat aura autant de partitions qu'il y a de
*     sous-maillages supports correspondant.
      DO 4 IPART=1,NBPART
        IMODEL = KMODEL(IPART)
        SEGACT IMODEL
        IF ((INATUU.EQ.108).OR.(INATUU.EQ.42)) THEN
          IPICA=1
        ENDIF

*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)
              SEGACT MCHEX1
              if ((MCHEX1.TITCHE).eq.'ENRICHIS') then
                ICHAX1 = MCHEX1.ICHAML(1)
                SEGDES MCHEX1
                goto 3
              endif
              SEGDES MCHEX1
            endif
          Enddo
        endif
 3      CONTINUE
*fin as xfem 2010_01_13

        SEGDES IMODEL
 4    CONTINUE
      SEGDES MMODEL
C
C     fin de la verification des modeles interdits et presence XFEM
C                                                                               
      CALL LIROBJ('MCHAML',IPCHE1,1,IRT4)
      IF(IERR.NE.0) RETURN
C                                                                               
C     ON LIT UN  CHPOINT DE DEPLACEMENTS                                        
C                                                                               
      CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT5)
      IF(IERR.NE.0) RETURN
C                                                                               
C     Si on utilise un modele interdit, on va faire une simple copie du MCHAML; sinon on utilise la procedure normale
C
      IF (IPICA.NE.0) THEN
        CALL COPIE8(IPCHE1,IPCHE2)
        if (ierr.ne.0) return
        IRET=1
      ELSE                
*as xfem 2010_01_13
        if (ichax1.ne.0) then
          call LIROBJ('CHPOINT',IPCHP0,1,IRT6)
          if (ierr.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                                                  

        CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IPCHE2,IRET)
*fin as xfem 2010_01_13
                          
      ENDIF
C                                                                               
      IF(IRET.EQ.1) CALL ECROBJ('MCHAML',IPCHE2)
      RETURN                                                                    
      END