C MKCOOR    SOURCE    CHAT      07/10/29    21:24:23     5940           
      SUBROUTINE MKCOOR(CGEOME,MDISCR,
     $     MYFALS,
     $     ICOOR,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : MKCOOR
C PROJET      : Noyau linéaire NLIN
C DESCRIPTION : On crée le champ par éléments contenant les coordonnées
C               des points servant pour la transformation géométrique
C               (ddl de la transformation géométrique)...
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          : KEEF (recherche de l'élément fini)
C                    NOMINC (nommage des inconnues)
C                    MKCOO1 (remplissage du sous-champ par élément
C                    (fortran 77))
C                    PRCAEL (impression du champ créé)
C APPELE PAR       : PRNLI2
C***********************************************************************
C ENTREES            : * CGEOME (type MELEME) : maillage de QUAFs
C                        partitionné.
C                      * MDISCR (type CH*(*)) : nom d'espace de
C                        discrétisation (cf. NOMFA dans l'include
C                        SFALRF) 
C                      * MYFALS (type FALRFS) : segment de description 
C                        des familles d'éléments de références.
C SORTIES            : * ICOOR  (type MCHAEL) : champ par éléments de
C                        coordonnées de points (degrés de liberté de la
C                        transformation géométrique).
C TRAVAIL            : * SOUGEO (type MELEME) : maillage élémentaire.
C                      * JCOOR  (type MCHEVA) : valeurs du champ ICOOR
C                        sur le maillage élémentaire.
C                        Structure (cf.include SMCHAEL) : 
C                        (1, nb. ddl, 1, dim. esp. réel, 1, nb. élément)
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 01/09/99, version initiale
C HISTORIQUE : v1, 01/09/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 CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SMELEME
      POINTEUR CGEOME.MELEME
      POINTEUR SOUGEO.MELEME
* Segments à moi
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 N1
      POINTEUR ICOOR.MCHAEL
      INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
      POINTEUR JCOOR.MCHEVA
CBEGININCLUDE SFALRF
      SEGMENT FALRF
      CHARACTER*(LNNFA) NOMFA
      INTEGER NUQUAF(NBLRF)
      POINTEUR ELEMF(NBLRF).ELREF
      ENDSEGMENT
      SEGMENT FALRFS
      POINTEUR LISFA(0).FALRF
      ENDSEGMENT
CENDINCLUDE SFALRF
      POINTEUR MYFALS.FALRFS
CBEGININCLUDE SELREF
      SEGMENT ELREF
      CHARACTER*(LNNOM)  NOMLRF
      CHARACTER*(LNFORM) FORME 
      CHARACTER*(LNTYPL) TYPEL 
      CHARACTER*(LNESP)  ESPACE
      INTEGER DEGRE
      REAL*8 XCONOD(NDIMEL,NBNOD)
      INTEGER NPQUAF(NBDDL)
      INTEGER NUMCMP(NBDDL)
      INTEGER QUENOD(NBDDL)
      INTEGER ORDDER(NDIMEL,NBDDL)
      POINTEUR MBPOLY.POLYNS
      ENDSEGMENT
      SEGMENT ELREFS
      POINTEUR LISEL(0).ELREF
      ENDSEGMENT
CENDINCLUDE SELREF
      POINTEUR MYLRF.ELREF
*
      CHARACTER*(*) MDISCR
      INTEGER IMPR,IRET
*
      INTEGER ISOUS
      INTEGER NSOUS,NNOEU,NELEM,NDDL,NXCO
      INTEGER ITQUAF
*     
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkcoor'
      SEGACT CGEOME
      NSOUS=CGEOME.LISOUS(/1)
      N1=NSOUS
      SEGINI ICOOR
      NXCO=MCOORD.XCOOR(/1)
* Par sous-domaine...
      DO 1 ISOUS=1,NSOUS
         SOUGEO=CGEOME.LISOUS(ISOUS)
         SEGACT SOUGEO
* On cherche l'élément fini correspondant au QUAF
         ITQUAF=SOUGEO.ITYPEL
         CALL KEEF(ITQUAF,MDISCR,
     $        MYFALS,
     $        MYLRF,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         SEGACT MYLRF
         NDDL=MYLRF.NPQUAF(/1)
         NNOEU=SOUGEO.NUM(/1)
         NELEM=SOUGEO.NUM(/2)
         NBLIG=1
         NBCOL=NDDL
         N2LIG=1
         N2COL=IDIM
         NBPOI=1
         NBELM=NELEM
         SEGINI JCOOR
         CALL MKCOO1(NNOEU,NELEM,NXCO,NDDL,IDIM,
     $        SOUGEO.NUM,MCOORD.XCOOR,MYLRF.NPQUAF,
     $        JCOOR.VELCHE,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         SEGDES JCOOR
         ICOOR.ICHEVA(ISOUS)=JCOOR
         SEGDES MYLRF
         SEGDES SOUGEO
         ICOOR.IMACHE(ISOUS)=SOUGEO
 1    CONTINUE
      SEGDES ICOOR
      SEGDES CGEOME
      IF (IMPR.GT.3) THEN
         WRITE(IOIMP,*) 'On a créé',
     $   ' ICOOR(élément ,1, coor.esp ,1, ddl ,1)=',ICOOR
         CALL PRCAEL(ICOOR,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 mkcoor'
      RETURN
*
* End of subroutine MKCOOR
*
      END