C MANUCH    SOURCE    GOUNAND   05/10/10    21:15:17     5200           
C
      SUBROUTINE MANUCH
C
CCCCCCCCCCC CE SUBROUTINE FABRIQUE UN OBJET DE TYPE CHPOINT
C
C
CCCCCCCCCCC SYNTAXE :
C           C  =  MANU CHPO  ELEM1  NC  DDLi LISTREELi
C                 TITRE CHA1  ;
C
C   ELEM1    : POINTEUR SUR UN POINT OU UN MAILLAGE
C   NC       : POUR CE MAILLAGE NOMBRE DE COMPOSANTES
C              ON ECRIT NC FOIS LES COUPLES DDL LISTREEL
C   DDLi     : NOM DE LA Ieme COMPOSANTE (MOT)
C   LISTREELi: VALEURS DE CETTE COMPOSANTE DU CHAMP (LISTREEL)
C   TITRE    : MOT-CLE, POUR DONNER UN TITRE AU CHPOINT
C   CHA1     : TITRE, MAXIMUN DE 72 CARACTERES.
C
C   EXEMPLE : C=MANU CHPO ELEM1 2 UX (PROG 1. 1.) UY (PROG 2. -1.) ;
C     où ELEM est un maillage contenant deux points
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C    SI ELEM N'EST PAS DE TYPE POI1 ON LE CHANGE EN POI1
C    LA DIMENSION DE LISTREEL DOIT ETRE CELLE DE ELM SAUF
C    SI C'EST 1 ==> CHPO CONSTANT
C    POUR FAIRE UN CHPO CONSTANT ON PEUT AUSSI DONNER UN FLOTTANT
C    A LA PLACE DU LISTREEL
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  Variables internes
C
C  ILU : indique si le nombre de composantes est donné
C  NCC : compteur limite pour la boucle sur les composantes
C  NC  : nombre de composantes, donné ou à déterminer
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
-INC SMLREEL
-INC SMELEME
-INC SMCOORD
C
      SEGMENT       ICPR(XCOOR(/1)/(IDIM+1))
C
      PARAMETER     (LMOOPT=2)
      REAL*8        VFLOT
      CHARACTER*(4) MOXX
      CHARACTER*(6) MOYY
      CHARACTER*72  TITRE
      CHARACTER*4   MOOPT(LMOOPT)
      CHARACTER*4   ADDI(3)
C     ADDI STOCKE LES MOTCLE DE LA 1ERE NATURE
      INTEGER       ATTRI(10)
C     ATTRI STOCKE LES ATTRIBUT DE NATURE (LIMITE A 10)
C         MOTCLE DE LA SYNTAXE
      DATA MOOPT    /'TITR','NATU'/
      DATA ADDI     /'INDE','DIFF','DISC'/
C
C     LECTURE FACULTATIVE DU TITRE OU DE LA NATURE
C
      TITRE = ' '
      NAT = 1
      DO 10 I=1,10
  10  ATTRI(I)=0
C
 100  CALL LIRMOT(MOOPT,LMOOPT,IMOT,0)
      IF(IERR.NE.0) RETURN
      IF (IMOT.EQ.1) THEN
C        lecture du titre
         CALL LIRCHA(TITRE,1,IRETOU)
         IF (IERR.NE.0) RETURN
         GOTO 100
      ELSEIF (IMOT.EQ.2) THEN
C        lecture de l'attribut de nature
         CALL LIRMOT(ADDI,3,ATTRI(1),1)
         IF (IERR .NE. 0) RETURN
         NAT      = MAX(1,NAT)
         ATTRI(1) = ATTRI(1) - 1
         GOTO 100
      ENDIF
C
C     LECTURE DE LA GEOMETRIE
C
 400  CALL LIROBJ('POINT   ',KPOINT,0,IRETOU)
      IF (IRETOU.NE.0) THEN
          CALL CRELEM(KPOINT)
          MELEME=KPOINT
      ELSE
          CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU)
          IF (IERR.NE.0) RETURN
          SEGACT MELEME
*         IF (ITYPEL.NE.1.OR.LISOUS(/1).NE.0) CALL CHANGE(MELEME,1)
          CALL CHANGE(MELEME,1)
      ENDIF

*     VERIFICATION QUE CHAQUE POINT N'APPARAIT QU'UNE SEULE FOIS
      NBP1 = NUM(/2)
      SEGINI ICPR
      ICON = 0
      DO 12 I=1,NBP1
        IKI       = NUM(1,I)
        IF(ICPR(IKI).NE.0) GOTO 12
        ICON      = ICON+1
        ICPR(IKI) = ICON
 12   CONTINUE
      SEGSUP ICPR
      SEGDES MELEME
C     UN POINT EST DONNE PLUSIEURS DANS LA GEOMETRIE
      IF (ICON.NE.NBP1) CALL ERREUR(75)
      IF (IERR.NE.0) RETURN
C
C Nouvelle syntaxe gounand
C
      CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
*   Ancienne syntaxe
      IF (IRETOU.EQ.0) GOTO 300
      SEGACT MLMOTS
      NC=MOTS(/2)
      CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU)
      IF (IERR.NE.0) RETURN
      SEGACT MLREEL
      NR=PROG(/1)
*
      SEGINI MSOUPO
      IGEOC  = MELEME
      N      = NBP1
      SEGINI MPOVAL
      IPOVAL = MPOVAL
*
      DO IC=1,NC
         NOCOMP(IC) = MOTS(IC)(1:4)
         NOHARM(IC) = NIFOUR
         IF (IC.GT.NR) THEN
            VFLOT=0.D0
         ELSE
            VFLOT=PROG(IC)
         ENDIF
         DO K=1,NBP1
            VPOCHA(K,IC) = VFLOT
         ENDDO
      ENDDO
      SEGDES MLREEL
      SEGDES MLMOTS
*   La création du chapeau : c'est comme avant
      GOTO 500
C
C     LECTURE DU NOMBRE DE COMPOSANTES
C
 300  CONTINUE
      NC = 0
      CALL LIRENT(NC,0,IRETOU)
      IF (IRETOU.NE.0) THEN
        ILU      = 1
        INTERR(1)= NC
        NCC      = NC
        IF (NC.LE.0) CALL ERREUR(36)
        IF (IERR.NE.0) RETURN
      ELSE
        NC  = 0
        NCC = 1
        ILU = 0
      ENDIF

      SEGINI MSOUPO
      IGEOC  = MELEME
      N      = NBP1
      SEGINI MPOVAL
      IPOVAL = MPOVAL
C
      IC = 0
      DO 20 ICC=1,NCC
c        Boucle sur les mots lus
C
C        LECTURE DU NOM DE COMPOSANTE
C
  32     continue
         IC = IC + 1

         CALL LIRCHA(MOYY,0,IRETOU)
         IF (IRETOU.EQ.0) THEN
            IF(ILU.EQ.1) THEN
               CALL ERREUR (80)
               RETURN
            ELSE
              GO TO 21
            ENDIF
         ENDIF
         IF(IERR.NE.0) RETURN
         IF(IRETOU.GT.4) THEN
            CALL ERREUR(536)
            RETURN
         ENDIF
         IF (ILU.EQ.0) THEN
            NC = NC + 1
            SEGADJ MSOUPO
            SEGADJ MPOVAL
         ENDIF
         NOCOMP(IC) = MOYY(1:4)
         NOHARM(IC) = NIFOUR
C
C        LECTURE DES VALEURS
C
C        est-ce un flottant ?
         CALL LIRREE(VFLOT,0,IRETOU)
         MLREEL=0
C        ou alors une liste de réels ?
         IF (IRETOU.EQ.0) CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU)
         IF(IERR.NE.0) RETURN

         IF (MLREEL.NE.0) THEN
            SEGACT MLREEL
            N = PROG(/1)
            IF (N.NE.NBP1.AND.N.NE.1) CALL ERREUR(21)
            IF (IERR.NE.0) RETURN
            IF (N.EQ.1) THEN
c              c'est une liste de réels, mais avec une seule valeur
               VFLOT  = PROG(1)
               SEGDES MLREEL
               MLREEL = 0
            ENDIF
         ENDIF
         IF (MLREEL.NE.0) THEN
c           on crée un chpo variable
            DO 42 K=1,NBP1
               VPOCHA(K,IC) = PROG(K)
 42         CONTINUE
            SEGDES MLREEL
         ELSE
c           on crée un chpo constant
            DO 43 K=1,NBP1
               VPOCHA(K,IC) = VFLOT
 43         CONTINUE
         ENDIF
c        si le nb de composantes n'est pas précisé, on continue de les lire
         IF (ILU.EQ.0)  GOTO 32
 20   CONTINUE
 21   CONTINUE
C
C     LECTURE FACULTATIVE DU TITRE OU DE LA NATURE
C
 500  CALL LIRMOT(MOOPT,LMOOPT,IMOT,0)
      IF (IERR.NE.0) RETURN
      IF (IMOT.EQ.1) THEN
C        lecture du titre
         CALL LIRCHA(TITRE,1,IRETOU)
         IF (IERR.NE.0) RETURN
         GOTO 500
      ELSEIF (IMOT.EQ.2) THEN
C        lecture de l'attribut de nature
         CALL LIRMOT(ADDI,3,ATTRI(1),1)
         IF (IERR .NE. 0) RETURN
         NAT      = MAX(1,NAT)
         ATTRI(1) = ATTRI(1) - 1
         GOTO 500
      ENDIF
C
C     CREATION DU CHPO
C
      SEGDES MPOVAL,MSOUPO
      NSOUPO = 1
      SEGINI MCHPOI
      MOCHDE = TITRE
      MTYPOI = '        '
      DO 1000 I=1,NAT
        JATTRI(I) = ATTRI(I)
 1000 CONTINUE
      IFOPOI  = IFOMOD
      IPCHP(1)= MSOUPO
      SEGDES MCHPOI

      CALL ECROBJ('CHPOINT',MCHPOI)
      RETURN
C
      END