C MANUEL    SOURCE    GOUNAND   14/01/31    21:15:08     7926           
      SUBROUTINE MANUEL
C
C   FABRICATION MANUELLE D OBJETS DIVERS ET VARIES
C   DE TYPE ELEMENT,CHAMPOIN,SOLUTION, RIGIDITE, CHAMELEM ,EVOLUTION
C
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC CCGEOME
-INC SMELEME
      SEGMENT MTRT
         INTEGER MTT(NTT)
      ENDSEGMENT
      PARAMETER (LMOOPT=7)
      CHARACTER*4 MOOPT(LMOOPT)
      DATA MOOPT/'CHPO','MODE','RIGI','CHEL','CHAM','CHML','OBJE'/
      CALL LIRMOT(NOMS,NOMBR,I,0)
      IF (I.NE.0) GOTO 2
      CALL LIRMOT(MOOPT,LMOOPT,IMOT,1)
      IF(IERR.NE.0) RETURN
      GO TO (100,200,300,400,500,600,700),IMOT
 100  CALL MANUCH
      GO TO 30
 200  CALL MANUMO
      GO TO 30
 300  CALL MANURI
      GO TO 30
 400  CALL MANUCE
      GO TO 30
 500  CALL MAMANU
      GO TO 30
 600  CALL MANUC5
      GO TO 30
 700  CALL MANUOB
      GO TO 30
c
c==== Cas des Objets MAILLAGES ====================================
   2  ITYP=I
      CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0)
      IF (ICOUL.EQ.0) ICOUL=IDCOUL+1
      ICOUL=ICOUL-1
      NBSOUS=0
      NBREF=0
      NBELEM=1
c---- SUPERELEMENT ---------------
      IF(NOMS(ITYP).EQ.'SUPE') THEN
         CALL LIROBJ('MAILLAGE',IPT1,0,IRETOU)
         IF(IRETOU.EQ.0) GO TO 25
         SEGACT IPT1
         IF(IPT1.ITYPEL.NE.1) THEN
            CALL CHANGE ( IPT1,1)
            IF (IERR.NE.0) RETURN
            SEGACT IPT1
         ENDIF
         NBNN = IPT1.NUM(/2)
         SEGINI MELEME
         ICOLOR(1)=ICOUL
         ITYPEL=ITYP
         DO 26 I=1,NBNN
         NUM(I,1)=IPT1.NUM(1,I)
   26    CONTINUE
         GO TO 11
   25    NTT=50
         SEGINI MTRT
         NBNN=0
   28    CONTINUE
         CALL LIROBJ('POINT   ',IP,0,IRETOU)
         IF(IRETOU.EQ.0)GO TO 29
         NBNN=NBNN + 1
         IF(NBNN.GT.NTT) THEN
            NTT=NTT+50
            SEGADJ MTRT
         ENDIF
         MTT(NBNN) = IP
         GO TO 28
   29    CONTINUE
         SEGINI MELEME
         ICOLOR(1)=ICOUL
         ITYPEL=ITYP
         DO 27 I=1,NBNN
         NUM(I,1)=MTT(I)
   27    CONTINUE
         SEGSUP MTRT
c---- AUTRE TYPE D'ELEMENTS ---------------
      ELSE
         NBNN=NBNNE(ITYP)
c        dans le cas POLYgone et MULtiplicateur le nbre de noeuds par
c        element est indefini d'ou la lecture facultative des points
         IF (NOMS(ITYP).EQ.'POLY') THEN
           NBNN = 14
           IDOBL = 0
         ELSE IF (NOMS(ITYP).EQ.'MULT') THEN
           NBNN = 9999
           IDOBL = 0
         ELSE
           IDOBL = 1
         ENDIF
         SEGINI MELEME
         ICOLOR(1)=ICOUL
         ITYPEL=ITYP
C SG On ajoute la possibilité de générer un élément à partir
C des premiers points d'un maillage de 'POI1'
         CALL LIROBJ('MAILLAGE',IPT1,0,IRETOU)
         IF (IRETOU.NE.0) THEN
            SEGACT IPT1
            IF(IPT1.ITYPEL.NE.1) THEN
               CALL CHANGE ( IPT1,1)
               IF (IERR.NE.0) RETURN
               SEGACT IPT1
            ENDIF
            NBNN1=IPT1.NUM(/2)
            IF (NBNN1.EQ.0) THEN
               NBELEM=0
               SEGADJ MELEME
               GOTO 11
            ENDIF
            IF (IDOBL.EQ.0) NBNN=NBNN1
            SEGINI MELEME
            ICOLOR(1)=ICOUL
            ITYPEL=ITYP
            DO 260 I=1,NBNN
               NUM(I,1)=IPT1.NUM(1,(MOD(I-1,NBNN1))+1)
 260        CONTINUE
         ELSE
            DO 10 I=1,NBNN
c            CALL LIROBJ('POINT   ',IP,IDOBL,IRETOU)
c          on donne ici la possibilité de créer un meleme avec 0 élément
               IF(I.EQ.1) THEN
                  CALL LIROBJ('POINT   ',IP,0,IRETOU)
               ELSE
                  CALL LIROBJ('POINT   ',IP,IDOBL,IRETOU)
               ENDIF
               IF (IRETOU.NE.1) THEN
                  IF (I.EQ.1) THEN
                     NBELEM = 0
                     SEGADJ MELEME
                     if(iimpi.ge.1) write(ioimp,*
     $                    )'MAILLAGE DE 0 ELEMENT CREE'
                  ENDIF
                  IF (IDOBL.EQ.0) THEN
C              CAS DU POLYGONE ou du MULT
                     NBNN = I-1
                     SEGADJ MELEME
                  ENDIF
                  GOTO 11
               ENDIF
               NUM(I,1)=IP
 10         CONTINUE
         ENDIF
      ENDIF
  11  CONTINUE
      IF (IERR.NE.0) GOTO 20
      CALL ECROBJ('MAILLAGE',MELEME)
      SEGDES MELEME
      RETURN
  20  SEGSUP MELEME
 30   CONTINUE
      RETURN
      END