C COGA1     SOURCE    GOUNAND   05/12/21    21:17:12     5281
      SUBROUTINE COGA1(NDLIG,NDCOL,NDNOEU,NDPOGO,NDELEM,
     $     JCOEF,FNPG,
     $     JCOEFG,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : COGA1
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    Ceci ressemble à un produit tensoriel (cf. geoli1)
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       : COGAU
C***********************************************************************
C ENTREES            : * NDLIG (type entier) : nb. de lignes du
C                        coefficient tensoriel.
C                      * NDCOL (type entier) : nb. de colonnes du
C                        coefficient tensoriel.
C                      * NDNOEU (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                      * NDELEM (type entier) : nombre d'éléments du
C                        maillage élémentaire courant.
C                      * JCOEF  (type réel)   : valeurs des ddl du
C                        coefficient tensoriel sur le maillage
C                        élémentaire courant.
C                      * FNPG (type réel)     : valeurs des fonctions
C                        d'interpolation pour le coefficient aux points
C                        de gauss sur l'élément de référence.
C ENTREES/SORTIES    : * JCOEFG (type réel)   : valeurs du coefficient
C                        tensoriel aux points de Gauss sur le maillage
C                        élémentaire.
C SORTIES            : -
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
      INTEGER NDLIG,NDCOL,NDNOEU,NDPOGO,NDELEM
      REAL*8 JCOEF (NDNOEU,NDLIG,NDCOL,NDELEM)
      REAL*8 FNPG  (NDNOEU,NDPOGO)
      REAL*8 JCOEFG(NDLIG,NDCOL,NDPOGO,NDELEM)
*
      INTEGER IMPR,IRET
      INTEGER IELEM,IPOGO,INOEUD,ICOL,ILIG
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans coga1'
      DO 1 IELEM=1,NDELEM
         DO 12 IPOGO=1,NDPOGO
            DO 122 ICOL=1,NDCOL
               DO 1222 ILIG=1,NDLIG
                  DO 12222 INOEUD=1,NDNOEU
                     JCOEFG(ILIG,ICOL,IPOGO,IELEM)=
     $                    JCOEFG(ILIG,ICOL,IPOGO,IELEM)
     $                    + (JCOEF(INOEUD,ILIG,ICOL,IELEM)
     $                       *FNPG(INOEUD,IPOGO))
12222             CONTINUE
 1222          CONTINUE
 122        CONTINUE
 12      CONTINUE
 1    CONTINUE

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