Esope source files

   1 : C MKCOO1    SOURCE    GOUNAND   05/12/21    21:34:15     5281           
   2 :       SUBROUTINE MKCOO1(NNOEU,NELEM,NXCO,NDDL,NDIM,
   3 :      $        SOUGEO,NCOORD,NPQUAF,
   4 :      $        JCOOR,
   5 :      $        IMPR,IRET)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       IMPLICIT INTEGER (I-N)
   8 : C***********************************************************************
   9 : C NOM         : MKCOO1
  10 : C PROJET      : Noyau linéaire NLIN
  11 : C DESCRIPTION : On remplit les valeurs du champ par éléments contenant
  12 : C               les coordonnées des points servant pour la
  13 : C               transformation géométrique (ddl de la transformation
  14 : C               géométrique)... Ceci pour le maillage élémentaire
  15 : C               SOUGEO. 
  16 : C
  17 : C LANGAGE     : FORTRAN 77 (sauf E/S)
  18 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19 : C               mél : gounand@semt2.smts.cea.fr
  20 : C***********************************************************************
  21 : C APPELES          : -
  22 : C APPELE PAR       : MKCOOR
  23 : C***********************************************************************
  24 : C ENTREES            : * NNOEU  (type entier) : nombre de noeuds par
  25 : C                        élément.
  26 : C                      * NELEM  (type entier) : nombre d'éléments de
  27 : C                        SOUGEO 
  28 : C                      * NXCO   (type entier) : dimension du tableau des 
  29 : C                        coordonnées des points (cf. include SMCOORD).
  30 : C                      * NDDL   (type entier) : nombre de ddl de
  31 : C                        l'élément fini courant.
  32 : C                      * NDIM   (type entier) : dimension de l'espace
  33 : C                        géométrique.
  34 : C                      * SOUGEO (type entier) : tableau des numéros de
  35 : C                        noeuds des éléments.
  36 : C                      * NCOORD (type réel)   : tableau des coordonnées
  37 : C                        des noeuds (cf. include SMCOORD). 
  38 : C                      * NPQUAF (type entier) : tableau de
  39 : C                        correspondance (numéro du ddl) -> numéro du
  40 : C                        noeud du QUAF (cf. include SELREF)
  41 : C ENTREES/SORTIES    : * JCOOR  (type réel)   : valeurs du champ par
  42 : C                        éléments contenant les coordonnées des points
  43 : C                        servant pour la transformation géométrique (ddl
  44 : C                        de la transformation géométrique)...
  45 : C SORTIES            : -
  46 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  47 : C***********************************************************************
  48 : C VERSION    : v1, 03/09/99, version initiale
  49 : C HISTORIQUE : v1, 03/09/99, création
  50 : C HISTORIQUE :
  51 : C HISTORIQUE :
  52 : C***********************************************************************
  53 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  54 : C en cas de modification de ce sous-programme afin de faciliter
  55 : C la maintenance !
  56 : C***********************************************************************
  57 : -INC CCOPTIO
  58 : *
  59 :       INTEGER NNOEU,NELEM,NXCO,NDDL,NDIM
  60 :       INTEGER SOUGEO(NNOEU,NELEM)
  61 :       REAL*8 NCOORD(NXCO)
  62 :       INTEGER NPQUAF(NDDL)
  63 :       REAL*8 JCOOR(NDDL,NDIM,NELEM)
  64 : *      
  65 :       INTEGER IMPR,IRET
  66 : *
  67 :       INTEGER IELEM,INDDL,INDIM
  68 :       INTEGER NUMNO
  69 : *     
  70 : * Executable statements
  71 : *
  72 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkcoo1'
  73 :       DO 1 IELEM=1,NELEM
  74 :          DO 12 INDDL=1,NDDL
  75 :             NUMNO=SOUGEO(NPQUAF(INDDL),IELEM)
  76 :             DO 122 INDIM=1,NDIM
  77 :                JCOOR(INDDL,INDIM,IELEM)=
  78 :      $                 NCOORD(((NUMNO-1)*(NDIM+1)) + INDIM)
  79 :  1222          CONTINUE
  80 :  122        CONTINUE
  81 :  12      CONTINUE
  82 :  1    CONTINUE
  83 : *
  84 : * Normal termination
  85 : *
  86 :       IRET=0
  87 :       RETURN
  88 : *
  89 : * Format handling
  90 : *
  91 : *
  92 : * Error handling
  93 : *
  94 :  9999 CONTINUE
  95 :       IRET=1
  96 :       WRITE(IOIMP,*) 'An error was detected in subroutine mkcoo1'
  97 :       RETURN
  98 : *
  99 : * End of subroutine MKCOO1
 100 : *
 101 :       END
 102 : 
 103 :