Sources Esope | Cast3M

cogau
C COGAU     SOURCE    GOUNAND   21/06/02    21:15:28     11022          
      SUBROUTINE COGAU(JCOEF,FNCOPG,
     $     JCOEFG,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : COGAU
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : Calcul du coefficient aux points de Gauss d'un élément
C               de référence pour chaque élément réel.
C               Le coefficient peut être scalaire, vectoriel ou
C               tensoriel. Les fonctions d'interpolation seront les
C               mêmes pour chaque composante du vecteur ou chaque
C               coefficient des matrices.
C               Les valeurs nodales devront être exprimées par rapport
C               aux coordonnées de l'espace de référence (par exemple,
C               s'il y a des dérivées, elles devront être exprimées par
C               rapport à ksi, eta...)
C               Si les valeurs sont des variables généralisées, il n'y
C               a peut-être rien à faire. (?)
C
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                    COGA1  (calcul de JCOEFG (fortran 77))
C APPELE PAR       : NLIN
C***********************************************************************
C ENTREES            : * JCOEF  (type MCHEVA) : valeurs des ddl du
C                        coefficient tensoriel sur le maillage
C                        élémentaire courant.
C                        Structure (cf.include SMCHAEL) :
C                        (1, nb. ddl, nb. comp. duales,
C                         nb. comp. primales, 1, nb. éléments)
C                      * FNCOPG (type MCHEVA) : valeurs des fonctions
C                        d'interpolation pour le coefficient aux points
C                        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
C ENTREES/SORTIES    : -
C SORTIES            : * JCOEFG (type MCHEVA) : valeurs du coefficient
C                        tensoriel aux points de Gauss sur le maillage
C                        élémentaire.
C                        Structure (cf.include SMCHAEL) :
C                        (1, 1, nb. comp. duales, nb. comp. primales,
C                         nb. poi. gauss, nb. éléments)
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 17/08/99, version initiale
C HISTORIQUE : v1, 17/08/99, 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 JCOEF.MCHEVA
      POINTEUR JCOEFG.MCHEVA
* Valeurs des fns d'interpolation du coeff. aux points de Gauss
      POINTEUR FNCOPG.MCHEVA
*
      INTEGER IMPR,IRET
*
      INTEGER NDLIG,NDCOL,ND2LI,ND2CO
      INTEGER NDPOGO,NDELEM,NDNOEU,NDNOE2
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cogau'
      SEGACT FNCOPG
      NDNOEU=FNCOPG.WELCHE(/2)
      NDPOGO=FNCOPG.WELCHE(/5)
      SEGACT JCOEF
      NDLIG=JCOEF.WELCHE(/1)
      NDNOE2=JCOEF.WELCHE(/5)
      IF (NDLIG.NE.1.OR.NDNOE2.NE.1) THEN
         WRITE(IOIMP,*) 'Erreur dims JCOEF'
         GOTO 9999
      ENDIF
      NDCOL=JCOEF.WELCHE(/2)
      ND2LI=JCOEF.WELCHE(/3)
      ND2CO=JCOEF.WELCHE(/4)
      NDELEM=JCOEF.WELCHE(/6)
      IF (NDCOL.NE.NDNOEU) THEN
         WRITE(IOIMP,*) 'Incompatibilité fns interpolation-coefficient'
         WRITE(IOIMP,*) 'NDNOEU=',NDNOEU,' NDCOL=',NDCOL
         GOTO 9999
      ENDIF
*
* Initialisations...
*
      NBLIG=1
      NBCOL=1
      N2LIG=ND2LI
      N2COL=ND2CO
      NBPOI=NDPOGO
      NBELM=NDELEM
      SEGINI JCOEFG
*
* On effectue le calcul du coefficient aux points de Gauss
*
      CALL COGA1(ND2LI,ND2CO,NDNOEU,NDPOGO,NDELEM,
*     $     JCOEF.WELCHE,MFFCPG.FNPG,
     $     JCOEF.WELCHE,FNCOPG.WELCHE,
     $     JCOEFG.WELCHE,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGDES JCOEFG
      SEGDES JCOEF
*      SEGDES MFFCPG
      SEGDES FNCOPG
      IF (IMPR.GT.3) THEN
         WRITE(IOIMP,*) 'On a créé',
     $        ' JCOEFG(élément , poi.gauss ,',
     $        ' comp.pri , comp.dua ,1,1)'
         CALL PRCHVA(JCOEFG,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 cogau'
      RETURN
*
* End of subroutine COGAU
*
      END