C GEOREG    SOURCE    GOUNAND   26/01/09    21:15:30     12441          
      SUBROUTINE GEOREG(ITQUAF,MYFALS,MYFPGS,
     $        JMAREG,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : GEOREG
C DESCRIPTION :
*
* Calcul du jacobien de la transformation :
* élément volumique de référence -> élément réguliers
* de côté 1
* Cela sert pour l'adaptativité.
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, 04/10/2005, version initiale
C HISTORIQUE : v1, 04/10/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 PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC TNLIN
*-INC SELREF
      POINTEUR ELCOUR.ELREF
*-INC SFALRF
      POINTEUR MYFALS.FALRFS
*-INC SPOGAU
      POINTEUR MYPGS.POGAUS
      POINTEUR PGCOUR.POGAU
*-INC SFAPG
      POINTEUR MYFPGS.FAPGS
*-INC SMCHAEL
      INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
      POINTEUR JCOOR.MCHEVA
      POINTEUR JMAREG.MCHEVA
      POINTEUR JMIREG.MCHEVA
      POINTEUR JDTREG.MCHEVA
      POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA
*
      SEGMENT NOEREG
      REAL*8  XNOEUD(NDIM,NNLREG)
      ENDSEGMENT
*
      CHARACTER*4 CQUAF,METGAU,MYDISC
      INTEGER IMPR,IRET

*
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans georeg.eso'
      CQUAF=NOMS(ITQUAF)
*
* Here : SEGINI NOEREG
*
      IF (CQUAF.EQ.'SEG3') THEN
         NNLREG=2
         NDIM  =1
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(1,2)=1.D0
*        SEGDES NOEREG
      ELSEIF (CQUAF.EQ.'TRI7') THEN
         NNLREG=3
         NDIM  =2
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(2,1)=0.D0
         XNOEUD(1,2)=1.D0
         XNOEUD(2,2)=0.D0
         XNOEUD(1,3)=0.5D0
         XNOEUD(2,3)=SQRT(3.D0)/2.D0
*        SEGDES NOEREG
      ELSEIF (CQUAF.EQ.'QUA9') THEN
         NNLREG=4
         NDIM  =2
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(2,1)=0.D0
         XNOEUD(1,2)=1.D0
         XNOEUD(2,2)=0.D0
         XNOEUD(1,3)=1.D0
         XNOEUD(2,3)=1.D0
         XNOEUD(1,4)=0.D0
         XNOEUD(2,4)=1.D0
*        SEGDES NOEREG
      ELSEIF (CQUAF.EQ.'TE15') THEN
         NNLREG=4
         NDIM  =3
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(2,1)=0.D0
         XNOEUD(3,1)=0.D0
         XNOEUD(1,2)=1.D0
         XNOEUD(2,2)=0.D0
         XNOEUD(3,2)=0.D0
         XNOEUD(1,3)=0.5D0
         XNOEUD(2,3)=SQRT(3.D0)/2.D0
         XNOEUD(3,3)=0.D0
         XNOEUD(1,4)=0.5D0
         XNOEUD(2,4)=SQRT(3.D0)/6.D0
         XNOEUD(3,4)=SQRT(6.D0)/3.D0
*        SEGDES NOEREG
      ELSEIF (CQUAF.EQ.'PY19') THEN
         NNLREG=5
         NDIM  =3
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(2,1)=0.D0
         XNOEUD(3,1)=0.D0
         XNOEUD(1,2)=1.D0
         XNOEUD(2,2)=0.D0
         XNOEUD(3,2)=0.D0
         XNOEUD(1,3)=1.D0
         XNOEUD(2,3)=1.D0
         XNOEUD(3,3)=0.D0
         XNOEUD(1,4)=0.D0
         XNOEUD(2,4)=1.D0
         XNOEUD(3,4)=0.D0
         XNOEUD(1,5)=0.5D0
         XNOEUD(2,5)=0.5D0
         XNOEUD(3,5)=SQRT(2.D0)/2.D0
*         XNOEUD(3,5)=1.D0
*        SEGDES NOEREG
      ELSEIF (CQUAF.EQ.'PR21') THEN
         NNLREG=6
         NDIM  =3
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(2,1)=0.D0
         XNOEUD(3,1)=0.D0
         XNOEUD(1,2)=1.D0
         XNOEUD(2,2)=0.D0
         XNOEUD(3,2)=0.D0
         XNOEUD(1,3)=0.5D0
         XNOEUD(2,3)=SQRT(3.D0)/2.D0
         XNOEUD(3,3)=0.D0
*
         XNOEUD(1,4)=0.D0
         XNOEUD(2,4)=0.D0
         XNOEUD(3,4)=1.D0
         XNOEUD(1,5)=1.D0
         XNOEUD(2,5)=0.D0
         XNOEUD(3,5)=1.D0
         XNOEUD(1,6)=0.5D0
         XNOEUD(2,6)=SQRT(3.D0)/2.D0
         XNOEUD(3,6)=1.D0

*        SEGDES NOEREG
      ELSEIF (CQUAF.EQ.'CU27') THEN
         NNLREG=8
         NDIM  =3
         SEGINI NOEREG
         XNOEUD(1,1)=0.D0
         XNOEUD(2,1)=0.D0
         XNOEUD(3,1)=0.D0
         XNOEUD(1,2)=1.D0
         XNOEUD(2,2)=0.D0
         XNOEUD(3,2)=0.D0
         XNOEUD(1,3)=1.D0
         XNOEUD(2,3)=1.D0
         XNOEUD(3,3)=0.D0
         XNOEUD(1,4)=0.D0
         XNOEUD(2,4)=1.D0
         XNOEUD(3,4)=0.D0
*
         XNOEUD(1,5)=0.D0
         XNOEUD(2,5)=0.D0
         XNOEUD(3,5)=1.D0
         XNOEUD(1,6)=1.D0
         XNOEUD(2,6)=0.D0
         XNOEUD(3,6)=1.D0
         XNOEUD(1,7)=1.D0
         XNOEUD(2,7)=1.D0
         XNOEUD(3,7)=1.D0
         XNOEUD(1,8)=0.D0
         XNOEUD(2,8)=1.D0
         XNOEUD(3,8)=1.D0
*        SEGDES NOEREG
      ELSE
         WRITE(IOIMP,*) CQUAF,' regulier non implemente'
         GOTO 9999
      ENDIF
*
      NBLIG=1
      NBCOL=XNOEUD(/2)
      N2LIG=1
      N2COL=XNOEUD(/1)
      NBPOI=1
      NBELM=1
      SEGINI JCOOR
      DO I=1,N2COL
         DO J=1,NBCOL
            JCOOR.WELCHE(1,J,1,I,1,1)=XNOEUD(I,J)
         ENDDO
      ENDDO
*
* On suppose la transformation linéaire entre élément de
* référence et élément régulier => 1 point de Gauss
*
      METGAU='GAU1'
      CALL KEPG(ITQUAF,METGAU,
     $     MYFPGS,
     $     PGCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      MYDISC='LINE'
      CALL KEEF(ITQUAF,MYDISC,
     $     MYFALS,
     $     ELCOUR,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* In KFNREF : SEGINI FFPG
* In KFNREF : SEGINI DFFPG
      CALL KFNREF(ELCOUR,PGCOUR,
     $     FFPG,DFFPG,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
* Création des matrices jacobiennes et déterminants
* On ne garde que la matrice jacobienne.
* In GEOLIN : SEGINI JMAREG
* In GEOLIN : SEGINI JMIREG
* In GEOLIN : SEGINI JDTREG
      NBELEM=1
*
      CALL GEOLIN(DFFPG,JCOOR,NBELEM,
     $     JMAREG,JMIREG,JDTREG,
     $     IMPR,IRET)
      IF (IRET.NE.0) THEN
         Write(ioimp,*) 'Jacobien des elements reguliers non inversible'
         GOTO 9999
      ENDIF
      SEGSUP JDTREG
      SEGSUP JMIREG
*      SEGDES JMAREG
      SEGSUP DFFPG
      SEGSUP FFPG
      SEGSUP JCOOR
      SEGSUP NOEREG
*      SEGPRT,JMAREG
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine georeg'
      RETURN
*
* End of subroutine GEOREG
*
      END