C PRMET     SOURCE    GOUNAND   05/12/21    21:35:43     5281           
      SUBROUTINE PRMET(JMAJAC,JMAREG,
     $     JSDETG,JIG,JIGH,JIGHIG,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : PRMET
C DESCRIPTION : Informations de préconditionnement pour la métrique
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : 
C APPELES (E/S)    : 
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            :
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, ??/??/2005, version initiale
C HISTORIQUE : v1, ??/??/2005, création
C HISTORIQUE :
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
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
      POINTEUR JMAJAC.MCHEVA
      POINTEUR JMAREG.MCHEVA
      POINTEUR JSDETG.MCHEVA,JIG.MCHEVA,JIGH.MCHEVA,JIGHIG.MCHEVA
      POINTEUR G.MCHEVA
-INC TMXMAT      
      POINTEUR H.MXMAT
*
      LOGICAL LBID
      INTEGER IMPR,IRET
*     
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmet.eso' 
*
* Dimensions
*      
      NLJA=JMAJAC.VELCHE(/6)
      NPJA=JMAJAC.VELCHE(/5)
      IREF=JMAJAC.VELCHE(/4)
      IREL=JMAJAC.VELCHE(/3)
*
* Initialisations
*
      NBELM=NLJA
      NBPOI=NPJA
      N2COL=1
      N2LIG=1
      NBCOL=1
      NBLIG=1
      SEGINI JSDETG
      N2COL=IREF
      N2LIG=IREF
      SEGINI,G
      SEGINI JIG
      SEGINI JIGH
      SEGINI JIGHIG
* Objets temporaires
      LDIM1=IREF
      LDIM2=IREF
      SEGINI,H
*
* Calcul de la métrique des éléments réguliers
*
C      SEGPRT,JMAJAC
C      SEGPRT,JMAREG
      CALL MAMA(JMAREG.VELCHE,IREF,IREF,
     $     'JTJ     ',H.XMAT,IREF,IREF,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
C      SEGPRT,H
*
* Calcul de la métrique G
*
      DO ILJA=1,NLJA
         DO IPJA=1,NPJA
            CALL MAMA(JMAJAC.VELCHE(1,1,1,1,IPJA,ILJA),IREL,IREF,
     $           'JTJ     ',G.VELCHE(1,1,1,1,IPJA,ILJA),IREF,IREF,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDDO
      ENDDO
*
* Calcul de l'inverse et du déterminant
*
      LBID=.FALSE.
C      WRITE(IOIMP,*) 'GEOLI2'
C      WRITE(IOIMP,*) 'IREF=',IREF
C      WRITE(IOIMP,*) 'NPJA=',NPJA
C      WRITE(IOIMP,*) 'NLJA=',NLJA
C      WRITE(IOIMP,*) 'LBID=',LBID
C      SEGPRT,G
      CALL GEOLI2(IREF,NPJA,NLJA,G.VELCHE,
     $     JIG.VELCHE,JSDETG.VELCHE,LBID,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      SEGSUP,G
C      SEGPRT,JIG
*
* Racine du déterminant
*
      DO ILJA=1,NLJA
         DO IPJA=1,NPJA
            JSDETG.VELCHE(1,1,1,1,IPJA,ILJA)=
     $           SQRT(JSDETG.VELCHE(1,1,1,1,IPJA,ILJA))
         ENDDO
      ENDDO
C      SEGPRT,JSDETG
*
* g-1h
*
      DO ILJA=1,NLJA
         DO IPJA=1,NPJA
            CALL MAMAMA(JIG.VELCHE(1,1,1,1,IPJA,ILJA),IREF,IREF,
     $           H.XMAT,IREF,IREF,
     $           'FOIS    ',JIGH.VELCHE(1,1,1,1,IPJA,ILJA),IREF,IREF,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDDO
      ENDDO
*
* g-1hg-1
*
      DO ILJA=1,NLJA
         DO IPJA=1,NPJA
            CALL MAMAMA(JIGH.VELCHE(1,1,1,1,IPJA,ILJA),IREF,IREF,
     $           JIG.VELCHE(1,1,1,1,IPJA,ILJA),IREF,IREF,
     $           'FOIS    ',JIGHIG.VELCHE(1,1,1,1,IPJA,ILJA),IREF,IREF,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDDO
      ENDDO
      SEGSUP H
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine prmet'
      RETURN
*
* End of subroutine PRMET
*
      END