C GEOMFT    SOURCE    GOUNAND   06/08/04    21:16:04     5520           
      SUBROUTINE GEOMFT(JCOOR,FFPG,SSFACT,NBELEF,
     $     JDTJAC,LAXI,
     $     JDTJA2,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : GEOMFT
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : multiplie par 2piR le determinant
C               de la matrice jacobienne
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 CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 02/10/03, version initiale
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
      POINTEUR JCOOR.MCHEVA
      POINTEUR JDTJAC.MCHEVA
      POINTEUR JDTJA2.MCHEVA
* Valeurs des fns d'interpolation du coeff. aux points de Gauss
      POINTEUR FFPG.MCHEVA
CBEGININCLUDE SFACTIV
      SEGMENT FACTIV
      POINTEUR IFACTI(NBSOUV).SFACTI
      ENDSEGMENT
      SEGMENT SFACTI
      POINTEUR ISFACT(NBSOFV).SSFACT
      ENDSEGMENT
      SEGMENT SSFACT
      LOGICAL LFACTI(NBELFV,NBELEV)
      ENDSEGMENT
CENDINCLUDE SFACTIV
*
      INTEGER LAXI
      INTEGER IMPR,IRET
*
      INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELM
      INTEGER NDDL,IESREL,NBPOGO
*     
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geomft'
      SEGACT SSFACT
      NBELFV=SSFACT.LFACTI(/1)
      NBELEV=SSFACT.LFACTI(/2)
      IESREL=IDIM
      SEGACT JCOOR
      NDLIG=JCOOR.VELCHE(/1)
      NDCOL=JCOOR.VELCHE(/2)
      N2DLIG=JCOOR.VELCHE(/3)
      N2DCOL=JCOOR.VELCHE(/4)
      NDNOEU=JCOOR.VELCHE(/5)
      NDELM=JCOOR.VELCHE(/6)
      IF (NDLIG.NE.1.OR.N2DLIG.NE.1.OR.N2DCOL.NE.IESREL.
     $     OR.NDNOEU.NE.1.OR.NDELM.NE.NBELEV) THEN
         WRITE(IOIMP,*) 'Erreur dims JCOOR'
         GOTO 9999
      ENDIF
      NDDL=NDCOL
      SEGACT FFPG
      NDLIG=FFPG.VELCHE(/1)
      NDCOL=FFPG.VELCHE(/2)
      N2DLIG=FFPG.VELCHE(/3)
      N2DCOL=FFPG.VELCHE(/4)
      NDNOEU=FFPG.VELCHE(/5)
      NDELM=FFPG.VELCHE(/6)
      IF (NDLIG.NE.1.OR.NDCOL.NE.NDDL.OR.N2DLIG.NE.1
     $     .OR.N2DCOL.NE.1.OR.NDELM.NE.NBELFV) THEN
         WRITE(IOIMP,*) 'Erreur dims FFPG'
         GOTO 9999
      ENDIF
      NBPOGO=NDNOEU 
      SEGACT JDTJAC
      NDLIG=JDTJAC.VELCHE(/1)
      NDCOL=JDTJAC.VELCHE(/2)
      N2DLIG=JDTJAC.VELCHE(/3)
      N2DCOL=JDTJAC.VELCHE(/4)
      NDNOEU=JDTJAC.VELCHE(/5)
      NDELM=JDTJAC.VELCHE(/6)
      IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1
     $     .OR.N2DCOL.NE.1
     $     .OR.(NDNOEU.NE.NBPOGO.AND.NDNOEU.NE.1)
     $     .OR.NDELM.NE.NBELEF) THEN
         WRITE(IOIMP,*) 'Erreur dims JDTJAC'
         GOTO 9999
      ENDIF
      NPJAC=NDNOEU
      IF (LAXI.EQ.1.OR.LAXI.EQ.3) THEN
         NBLIG=1
         NBCOL=1
         N2LIG=1
         N2COL=1
         NBPOI=NBPOGO
         NBELM=NBELEF
         SEGINI JDTJA2
         CALL GEOMF1(NDDL,IESREL,NBPOGO,NBELEV,NBELFV,NBELEF,
     $        NPJAC,
     $        JCOOR.VELCHE,FFPG.VELCHE,SSFACT.LFACTI,
     $        JDTJAC.VELCHE,LAXI,
     $        JDTJA2.VELCHE,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         SEGDES JDTJA2
         IF (IMPR.GT.3) THEN
            WRITE(IOIMP,*) 'On a créé',
     $           ' JDTJA2(élément , poi.gauss ,',
     $           ' 1,1,1,1)'
            CALL PRCHVA(JDTJA2,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDIF
      ELSEIF (LAXI.EQ.2) THEN
         NBLIG=1
         NBCOL=1
         N2LIG=1
         N2COL=1
         NBPOI=NPJAC
         NBELM=NBELEF
         SEGINI JDTJA2
         CALL GEOME2(NPJAC,NBELEF,
     $        JDTJAC.VELCHE,LAXI,
     $        JDTJA2.VELCHE,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         SEGDES JDTJA2
         IF (IMPR.GT.3) THEN
            WRITE(IOIMP,*) 'On a créé',
     $           ' JDTJA2(élément , poi.gauss ,',
     $           ' 1,1,1,1)'
            CALL PRCHVA(JDTJA2,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDIF
      ELSE
         WRITE(IOIMP,*) 'LAXI=',LAXI,' incorrect'
         GOTO 9999
      ENDIF
      SEGDES JDTJAC
      SEGDES FFPG
      SEGDES JCOOR
      SEGDES SSFACT
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine geomft'
      RETURN
*
* End of subroutine GEOMFT
*
      END