C DFNFRF    SOURCE    GOUNAND   06/08/04    21:15:30     5520           
      SUBROUTINE DFNFRF(DFFPG,JMIJAC,SSFACT,NBELEF,
     $     JDFFPG,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : DFNFRF
C DESCRIPTION : Calcul des dérivées premières des fonctions de forme aux
C               points de Gauss sur l'élément réel.
C
C             \partial_x = [j] \partial_{\xi}
C       
C             où \partial_x = trans( \frac{\partial}{\partial_x} 
C                                    \frac{\partial}{\partial_y} 
C                                    \frac{\partial}{\partial_z} )
C
C             \partial_{\xi} = trans( \frac{\partial}{\partial_{\xi}} 
C                                     \frac{\partial}{\partial_{\eta}} 
C                                     \frac{\partial}{\partial_{\zeta}})
C
C             [j] est l'inverse de la matrice jacobienne
C
C             cf. Dhatt et Touzot p.52
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          : RSET8  (copie de tableaux de CHARACTER*8)
C                    PRCHVA (impression d'un segment de type MCHEVA)
C                    DFNFRF1 (calcul des dérivées premières des fonctions
C                            de forme aux points de Gauss sur l'élément
C                            réel (fortran 77))  
C APPELE PAR       : NLAP, NCVN
C***********************************************************************
C ENTREES            : * DFFPG  (type MCHEVA) : valeurs des dérivées
C                        premières des fonctions d'interpolation aux
C                        points de gauss sur l'élément de référence.
C                        Structure (cf.include SMCHAEL) : 
C                        (1, nb. ddl, 1, dim.esp.réf, nb. poi. gauss, 1) 
C                      * JMIJAC (type MCHEVA) : valeurs de l'inverse de
C                        la matrice jacobienne aux points de Gauss sur
C                        le maillage élémentaire. 
C                        Structure (cf.include SMCHAEL) : 
C                        (1, 1, dim. esp. référence, dim. esp. réel,
C                         nb. poi. gauss, nb. éléments) 
C ENTREES/SORTIES    : -
C SORTIES            : * JDFFPG (type MCHEVA) : valeurs des dérivées
C                        premières des fonctions d'interpolation
C                        aux points de gauss sur l'élément réel. 
C                        Structure (cf.include SMCHAEL) : 
C                        (1, nb. ddl, 1, 1, nb. poi. gauss, nb. élém.) 
C TRAVAIL            : * NDDL   (type entier) : nombre de ddl (par
C                        élément) de la transformation géométrique.
C                      * IESREF (type entier) : dimension de l'espace de
C                        référence.
C                      * IESREL (type entier) : dimension de l'espace
C                        réel (i.e. géométrique).
C                      * NBPOGO (type entier) : nombre de points
C                        d'intégration.
C                      * NDELEM (type entier) : nombre d'éléments du
C                        maillage élémentaire courant.
C***********************************************************************
C VERSION    : v2, 03/10/03, refonte complète (modif SMPOUET)
C VERSION    : v1, 19/05/00, version initiale
C HISTORIQUE : v1, 19/05/00, 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 SFACTIV
      SEGMENT FACTIV
      POINTEUR IFACTI(NBSOUV).SFACTI
      ENDSEGMENT
      SEGMENT SFACTI
      POINTEUR ISFACT(NBSOFV).SSFACT
      ENDSEGMENT
      SEGMENT SSFACT
      LOGICAL LFACTI(NBELFV,NBELEV)
      ENDSEGMENT
CENDINCLUDE SFACTIV
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 DFFPG.MCHEVA
      POINTEUR JMIJAC.MCHEVA
      POINTEUR JDFFPG.MCHEVA
*
      INTEGER NBELEF
      INTEGER IMPR,IRET
*
      INTEGER NDLIG,NDCOL,N2DLIG,NDNOEU,NBELEV,NBELFV
      INTEGER NDDL,IESREF,IESREL,NBPOGO,NBELEM
*     
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans dfnfrf'
      SEGACT SSFACT
      NBELFV=SSFACT.LFACTI(/1)
      NBELEV=SSFACT.LFACTI(/2)
      IESREL=IDIM
*
      SEGACT DFFPG
      NDLIG =DFFPG.VELCHE(/1)
      NDDL  =DFFPG.VELCHE(/2)
      N2DLIG=DFFPG.VELCHE(/3)
      IESREF=DFFPG.VELCHE(/4)
      NBPOGO=DFFPG.VELCHE(/5)
      NDELEM=DFFPG.VELCHE(/6)
      IF (NDLIG.NE.1.OR.N2DLIG.NE.1
     $     .OR.(NDELEM.NE.NBELFV)) THEN
         WRITE(IOIMP,*) 'Erreur dims DFFPG'
         GOTO 9999
      ENDIF
*
      SEGACT JMIJAC
      NDLIG =JMIJAC.VELCHE(/1)
      NDCOL =JMIJAC.VELCHE(/2)
      N2DLIG=JMIJAC.VELCHE(/3)
      N2DCOL=JMIJAC.VELCHE(/4)
      NDNOEU=JMIJAC.VELCHE(/5)
      NBELEM=JMIJAC.VELCHE(/6)
      IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.IESREF
     $     .OR.N2DCOL.NE.IESREL
     $     .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NBPOGO)
     $     .OR.NBELEM.NE.NBELEF) THEN
         WRITE(IOIMP,*) 'Erreur dims JMIJAC'
         GOTO 9999
      ENDIF
      NPJMI=NDNOEU
*
* Initialisations...
*
      NBLIG=1
      NBCOL=NDDL
      N2LIG=1
      N2COL=IESREL
      NBPOI=NBPOGO
      NBELM=NBELEF
      SEGINI JDFFPG
*
* On effectue le calcul du coefficient aux points de Gauss
*
      CALL DFNFF1(NDDL,IESREF,IESREL,NBPOGO,NBELEV,NBELEF,NBELFV,
     $     NPJMI,
     $     DFFPG.VELCHE,JMIJAC.VELCHE,SSFACT.LFACTI,
     $     JDFFPG.VELCHE,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES JDFFPG
      SEGDES DFFPG
      SEGDES JMIJAC
      SEGDES SSFACT
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine dfnfrf'
      RETURN
*
* End of subroutine DFNFRF
*
      END