C GEOLF1    SOURCE    GOUNAND   06/08/04    21:15:48     5520
      SUBROUTINE GEOLF1(IESREL,IESREF,NDDL,NBPOGO,NBELEV,NBELFV,NBELEF,
     $     NLFVDF,
     $     DFFPG,JCOOR,SSFACT,
     $     JMAJAC,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : GEOLF1
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Calcul de la matrice jacobienne d'une transformation
C               géométrique aux points de Gauss d'un élément de
C               référence pour chaque élément réel.
C               On a :
C    Fonction f :      R^m      ->    R^n
C                 a=(a1...am)  |->  f(a)=(f1(a)...fn(a)
C      =>         matjac(i,j)(a)=Dj fi (a) = dfi / dxj (a)
C
C  Par exemple, pour une surface en 3D, la matrice jacobienne
C  s'exprime comme :
C
C
C                [  <xn>  ]
C         [J] =  [  <yn>  ]   .  [ { dNg/d(ksi) } { dNg/d(eta) } ]
C                [  <zn>  ]
C
C        (3x2)   (3 x Nnoeuds)      (Nnoeuds x 2)
C
C    Ici, le nb de ddl est égal aux nbs de noeuds car l'interpolation
C    pour la géométrie est de type nodale.
C
C    Ceci ressemble à un produit tensoriel (cf. coga1)
C
C
C LANGAGE     : Fortran 77 (sauf E/S)
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : -
C APPELE PAR       : GEOLIF
C***********************************************************************
C ENTREES            : * IESREL (type entier) : dimension de l'espace
C                        réel (i.e. géométrique).
C                      * IESREF (type entier) : dimension de l'espace de
C                        référence.
C                      * NDDL (type entier) : nombre de ddl (par
C                        élément) de la transformation géométrique.
C                      * NDPOGO (type entier) : nombre de points
C                        d'intégration.
C                      * NBELEV (type entier) : nombre d'éléments du
C                        maillage élémentaire courant.
C                      * DFFPG  (type entier) : valeurs des dérivées
C                        premières des fonctions d'interpolation de la
C                        transformation géométrique aux points de gauss
C                        sur l'élément de référence.
C                      * JCOOR  (type réel)   : valeurs des ddl de la
C                        transformation géométrique sur le maillage
C                        élémentaire courant.
C ENTREES/SORTIES    : * JMAJAC (type réel)   : valeurs de la matrice
C                        jacobienne aux points de Gauss sur le maillage
C                        élémentaire courant.
C SORTIES            : -
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 10/01/03, version initiale
C HISTORIQUE : v1, 10/01/03, 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
      INTEGER IESREL,IESREF,NDDL,NBPOGO,NBELEV,NBELEF,NBELFV
      REAL*8 DFFPG (NDDL,IESREF,NBPOGO,NLFVDF)
      REAL*8 JCOOR (NDDL,IESREL,NBELEV)
      LOGICAL SSFACT(NBELFV,NBELEV)
      REAL*8 JMAJAC(IESREL,IESREF,NBPOGO,NBELEF)
*
      INTEGER IMPR,IRET
      INTEGER IBELEF,IBELFV,IBELEV,IBPOGO,IREEL,IREFER
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans geolf1'
      IBELEF=0
      DO 1 IBELEV=1,NBELEV
         DO IBELFV=1,NBELFV
            IF (SSFACT(IBELFV,IBELEV)) THEN
               IF (NLFVDF.EQ.1) THEN
                  ILFVDF=1
               ELSE
                  ILFVDF=IBELFV
               ENDIF
               IBELEF=IBELEF+1
               DO 12 IBPOGO=1,NBPOGO
                  DO 122 IREFER=1,IESREF
                     DO 1222 IREEL=1,IESREL
                        DO 12222 IDDL=1,NDDL
                           JMAJAC(IREEL,IREFER,IBPOGO,IBELEF)=
     $                          JMAJAC(IREEL,IREFER,IBPOGO,IBELEF)
     $                          + (JCOOR(IDDL,IREEL,IBELEV)
     $                          *DFFPG(IDDL,IREFER,IBPOGO,ILFVDF))
12222                   CONTINUE
 1222                CONTINUE
 122              CONTINUE
 12            CONTINUE
            ENDIF
         ENDDO
 1    CONTINUE

*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine geolf1'
      RETURN
*
* End of subroutine GEOLF1
*
      END