C CCGIME    SOURCE    GOUNAND   11/04/29    21:15:16     6947           
      SUBROUTINE CCGIME(LCOF,NOMLOI,
     $     FC,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CCGIME
C DESCRIPTION : Lois de comportement aux points de Gauss :
C               Inverse de la métrique par rapport à un 
C               élément de référence régulier.
C     
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELE PAR       :
C***********************************************************************
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            : -
C TRAVAIL            :
C***********************************************************************
C VERSION    : v1, 22/09/10, version initiale
C HISTORIQUE : v1, 22/09/10, création
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
-INC CCOPTIO
-INC CCREEL
CBEGININCLUDE SMCHAEL
      SEGMENT MCHAEL
      POINTEUR IMACHE(N1).MELEME
      POINTEUR ICHEVA(N1).MCHEVA
      ENDSEGMENT
      SEGMENT MCHEVA
      REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
      ENDSEGMENT
      SEGMENT LCHEVA
      POINTEUR LISCHE(NBCHE).MCHEVA
      ENDSEGMENT
CENDINCLUDE SMCHAEL
      INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
      POINTEUR FC.MCHEVA
      POINTEUR LCOF.LCHEVA
      POINTEUR JMAJAC.MCHEVA
      POINTEUR JMIJAC.MCHEVA
      POINTEUR JDTJAC.MCHEVA
      POINTEUR JMAREG.MCHEVA
      CHARACTER*8 NOMLOI
      INTEGER ICOF
*     
-INC TMXMAT
* Objets temporaires
      POINTEUR JAC.MXMAT,JT.MXMAT,MJT.MXMAT
      POINTEUR G.MXMAT,IG.MXMAT,H.MXMAT,HIG.MXMAT,IGHIG.MXMAT
      POINTEUR ME.MXMAT
*     
      SEGMENT MCOF
      POINTEUR COEF(IDIM,IDIM).MCHEVA
      ENDSEGMENT
*     
      LOGICAL LBID
      INTEGER LAXSP
      REAL*8 DEUPI,XR
      REAL*8 XL,XM
*     
      INTEGER IMPR,IRET
*     
* Executable statements
*     
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgime'
C      IF (.NOT.(IDIM.EQ.1)) THEN
C         WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
C         GOTO 9999
C      ENDIF
      NLFC=FC.VELCHE(/6)
      NPFC=FC.VELCHE(/5)
      ICOF=0 
*     
      ICOF=ICOF+1
      JMAJAC=LCOF.LISCHE(ICOF)
      NLJA=JMAJAC.VELCHE(/6)
      NPJA=JMAJAC.VELCHE(/5)
      IREF=JMAJAC.VELCHE(/4)
      IREL=JMAJAC.VELCHE(/3)
*     
      IF (IREL.NE.IDIM) THEN
         WRITE(IOIMP,*) 'Erreur dims JMAJAC'
         GOTO 9999
      ENDIF
*     
      ICOF=ICOF+1
      ICOF=ICOF+1
      ICOF=ICOF+1
      JMAREG=LCOF.LISCHE(ICOF)
      NLJR=JMAREG.VELCHE(/6)
      NPJR=JMAREG.VELCHE(/5)
      I1  =JMAREG.VELCHE(/4)
      I2  =JMAREG.VELCHE(/3)
      IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
     $     THEN
         WRITE(IOIMP,*) 'Erreur dims JMAREG'
         GOTO 9999
      ENDIF
*     
* Objets temporaires et à préconditionner
*     
      LDIM1=IREL
      LDIM2=IREF
      SEGINI,JAC
      LDIM1=IREF
      LDIM2=IREL
      SEGINI,JT
      SEGINI,MJT
      LDIM1=IREF
      LDIM2=IREF
      SEGINI,G
      SEGINI,IG
      SEGINI,H
      SEGINI,HIG
      SEGINI,IGHIG
      LDIM1=IREL
      LDIM2=IREL
      SEGINI,ME
*     
* Calcul de la métrique des éléments réguliers
*     
      CALL MAMA(JMAREG.VELCHE,IREF,IREF,
     $     'JTJ     ',H.XMAT,IREF,IREF,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      SEGPRT,H
*     
      DO ILFC=1,NLFC
         IF (NLJA.EQ.1) THEN
            ILJA=1
         ELSE
            ILJA=ILFC
         ENDIF
         DO IPFC=1,NPFC
            IF (NPJA.EQ.1) THEN
               IPJA=1
            ELSE
               IPJA=IPFC
            ENDIF
*     
* Copie du jacobien
*     
            CALL MAMA(JMAJAC.VELCHE(1,1,1,1,IPJA,ILJA),IREL,IREF,
     $           'COPIE   ',
     $           JAC.XMAT,IREL,IREF,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
*            SEGPRT,JAC
*     
* Calcul de la métrique ME = J (JtJ)-1 h (JtJ)-1 Jt = J M Jt
*     
*     Calcul de Jt
            CALL MAMA(JAC.XMAT,IREL,IREF,
     $           'TRANSPOS',JT.XMAT,IREF,IREL,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
*            SEGPRT,JT
*     Calcul de G=JtJ
            CALL MAMAMA(JT.XMAT,IREF,IREL,JAC.XMAT,IREL,IREF,
     $           'FOIS    ',G.XMAT,IREF,IREF,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
*            SEGPRT,G
* Calcul de l'inverse, du déterminant et trace de l'inverse de g
            LBID=.FALSE.
            CALL GEOLI2(IREF,1,1,G.XMAT,IG.XMAT,DETG,
     $           LBID,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
*            SEGPRT,IG
* Calcul de hg-1, de sa trace et de son déterminant
            CALL MAMAMA(H.XMAT,IREF,IREF,IG.XMAT,IREF,IREF,
     $           'FOIS    ',HIG.XMAT,IREF,IREF,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            CALL MAMAMA(IG.XMAT,IREF,IREF,HIG.XMAT,IREF,IREF,
     $           'FOIS    ',IGHIG.XMAT,IREF,IREF,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            CALL MAMAMA(IGHIG.XMAT,IREF,IREF,JT.XMAT,IREF,IREL,
     $           'FOIS    ',MJT.XMAT,IREF,IREL,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            CALL MAMAMA(JAC.XMAT,IREL,IREF,MJT.XMAT,IREF,IREL,
     $           'FOIS    ',ME.XMAT,IREL,IREL,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
*     
* Calcul des la métrique inverse de l'élément
*     
            IF (NOMLOI(1:4).EQ.'IMET') THEN
               CALL CH2INT(NOMLOI(5:5),IDIM1,IMPR,IRET)
               IF (IRET.NE.0) GOTO 9999
               CALL CH2INT(NOMLOI(6:6),IDIM2,IMPR,IRET)
               IF (IRET.NE.0) GOTO 9999
               CONTRI=ME.XMAT(IDIM1,IDIM2)
*               WRITE(IOIMP,*) 'CONTRI=',CONTRI
            ELSE
               WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
               WRITE(IOIMP,*) 'Erreur grave'
               GOTO 9999
            ENDIF
            FC.VELCHE(1,1,1,1,IPFC,ILFC)=
     $           FC.VELCHE(1,1,1,1,IPFC,ILFC)+
     $           CONTRI
         ENDDO
      ENDDO
      SEGSUP,ME
      SEGSUP,IGHIG
      SEGSUP,HIG
      SEGSUP,H
      SEGSUP,IG
      SEGSUP,G
      SEGSUP,MJT
      SEGSUP,JT
      SEGSUP,JAC
*     
* Normal termination
*     
      IRET=0
      RETURN
*     
* Format handling
*     
*     
* Error handling
*     
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine ccgime'
      RETURN
*     
* End of subroutine CCGIME
*     
      END