Sources Esope | Cast3M

dfnfr
C DFNFR     SOURCE    GOUNAND   21/06/02    21:15:47     11022          
      SUBROUTINE DFNFR(DFFPG,JMIJAC,
     $     JDFFPG,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : DFNFR
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          : PRCHVA (impression d'un segment de type MCHEVA)
C                    DFNFR1 (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                      * NDPOGO (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, 25/09/03, refonte complète (modif SMTNLIN)
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 PPARAM
-INC CCOPTIO
-INC TNLIN      
*-INC SMCHAEL
      INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
      POINTEUR DFFPG.MCHEVA
      POINTEUR JMIJAC.MCHEVA
      POINTEUR JDFFPG.MCHEVA
*
      INTEGER IMPR,IRET
*
      INTEGER NDLIG,NDCOL,N2DLIG,N2DCOL,NDNOEU,NDELEM
      INTEGER NDDL,IESREF,IESREL,NDPOGO,NBELEM
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans dfnfr'
      SEGACT DFFPG
      NDLIG1=DFFPG.WELCHE(/1)
      NDDL =DFFPG.WELCHE(/2)
      N2DLI1=DFFPG.WELCHE(/3)
      IESREF=DFFPG.WELCHE(/4)
      NDPOG1=DFFPG.WELCHE(/5)
      NDELEM=DFFPG.WELCHE(/6)
      SEGACT JMIJAC
      NDLIG =JMIJAC.WELCHE(/1)
      NDCOL =JMIJAC.WELCHE(/2)
      N2DLIG=JMIJAC.WELCHE(/3)
      N2DCOL=JMIJAC.WELCHE(/4)
      NDPOG2=JMIJAC.WELCHE(/5)
      NBELEM=JMIJAC.WELCHE(/6)
      IF (NDLIG.NE.1.OR.NDCOL.NE.1) THEN
         WRITE(IOIMP,*) 'Erreur dims JMIJAC'
         GOTO 9999
      ENDIF
      NDPOGO=MAX(NDPOG1,NDPOG2)
*      WRITE(IOIMP,*) 'NDPOGO=',NDPOGO
*
      IF (NDLIG1.NE.1.OR.N2DLI1.NE.1.OR.NDELEM.NE.1.OR.
     $     (NDPOG1.NE.1.AND.NDPOG1.NE.NDPOGO)) THEN
         WRITE(IOIMP,*) 'Erreur dims DFFPG'
         GOTO 9999
      ENDIF
      IF (N2DLIG.NE.IESREF.OR.N2DCOL.NE.IDIM.OR.
     $     (NDPOG2.NE.1.AND.NDPOG2.NE.NDPOGO)) THEN
         WRITE(IOIMP,*) 'Incompatibilité JMIJAC-DFFPG'
         GOTO 9999
      ENDIF
*
      IESREL=N2DCOL
      NPFF =NDPOG1
      NPJMI=NDPOG2
*
* Initialisations...
*
      NBLIG=1
      NBCOL=NDDL
      N2LIG=1
      N2COL=IESREL
      NBPOI=NDPOGO
      NBELM=NBELEM
      SEGINI JDFFPG
*
* On effectue le calcul du coefficient aux points de Gauss
*
      CALL DFNFR1(NDDL,IESREF,IESREL,NPFF,NDPOGO,NBELEM,
     $     NPJMI,
     $     DFFPG.WELCHE,JMIJAC.WELCHE,
     $     JDFFPG.WELCHE,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES JDFFPG
      SEGDES JMIJAC
      SEGDES DFFPG
      IF (IMPR.GT.3) THEN
         WRITE(IOIMP,*) 'On a créé',
     $        ' JDFFPG(élément , poi.gauss ,',
     $        'dim. esp. réel. ,1, ddl ,1)'
         CALL PRCHVA(JDFFPG,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine dfnfr'
      RETURN
*
* End of subroutine DFNFR
*
      END