C MAMANU    SOURCE    CHAT      11/03/16    21:27:08     6902           
      SUBROUTINE MAMANU
*--------------------------------------------------------------------*
*                                                                    *
*            CREATION D'UN NOUVEAU CHAMELEM PAR MANU                 *
*            (OPTION 'CHAM' PP 24/11/92)                             *
*                                                                    *
*--------------------------------------------------------------------*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMELEME
-INC SMMODEL
-INC SMCHAML
*
      SEGMENT INFO
        INTEGER INFELL(JG)
      ENDSEGMENT
*
      CHARACTER*4 MOCHOI,MOTYPE(2)
      CHARACTER*8 MOCHOY
      CHARACTER*8 TYPOBJ
      CHARACTER*72 CHATYPE
      CHARACTER*8 LISMOT(5)
      DATA MOTYPE/'TYPE','POSI'/
      DATA LISMOT/'NOEUD','GRAVITE','RIGIDITE','MASSE','STRESSES'/
*
*     LECTURE (IMPERATIVE) D'UN MODELE
*
      CALL LIROBJ('MMODEL',MMODEL,1,IRET)
      IF (IERR.NE.0) RETURN
*
*     OPTION PAR DEFAUT
*
      LTYPE=1
      CHATYPE=' '
      IPOSI=1
*
*     ON DESIRE LIRE SOIT UN MOT CLE, SOIT UN NOM DE COMPOSANTE
*
 1    IRCHOI = 0
      CALL LIRCHA(MOCHOY,1,IRCHOI)
      IF (IERR.NE.0) RETURN
      MOCHOI=MOCHOY(1:4)
*
*     TRAITEMENT DES MOTS CLE
*
      CALL PLACE(MOTYPE,2,IPLACE,MOCHOI)
      IF(IPLACE.EQ.0) GOTO 30
      GOTO(10,20),IPLACE
*
*     SOUS-TYPE
*
 10   CONTINUE
      CALL LIRCHA(CHATYPE,1,LTYPE)
      IF (IERR.NE.0) RETURN
      GOTO 1
*
*     PLACE
*
 20   CONTINUE
      CALL LIRMOT(LISMOT,5,IPOSI,1)
      IF (IERR.NE.0) RETURN
      GOTO 1
*
*     MOCHOI EST LA COMPOSANTE, ON LIT MAINTENANT LES ENTIERS
*
 30   CONTINUE
      CALL LIRENT(IENT1,1,IRET)
      IF (IERR.NE.0) RETURN
      CALL LIRENT(IENT2,1,IRET)
      IF (IERR.NE.0) RETURN
      CALL LIRENT(IENT3,0,IRET)
      IF(IRET.EQ.0)THEN
        IENT3=1
      ENDIF
*
*     LECTURE DE L'OBJET QUELCONQUE
*     MODIF AM 30/1/95  ON AUTORISE SEULEMENT LES REELS
*
*     CALL LIRREE(XFLOT,0,IRETF)
*
      CALL LIRREE(XFLOT,1,IRETF)
      IF(IERR.NE.0) RETURN
*
      IF (IRETF.EQ.0) THEN
        CALL QUETYP(TYPOBJ,1,IRET)
        IF (IERR.NE.0) RETURN 
        CALL LIROBJ(TYPOBJ,IPOBJ,1,IRET)
        IF (IERR.NE.0) RETURN
      ENDIF
*
*     ON VERIFIE IENT1,IENT2 ET IENT3
*
      SEGACT,MMODEL
      NZONE=KMODEL(/1)
      IF(IENT3.GT.NZONE)THEN
        INTERR(1)=IENT3
        INTERR(2)=NZONE
        CALL ERREUR(8001)
        SEGDES,MMODEL
        RETURN
      ENDIF
*
      IMODEL=KMODEL(IENT3)
      SEGDES,MMODEL
      SEGACT,IMODEL
      MELEME=IMAMOD
      SEGACT,MELEME
      NBELEM=NUM(/2)
      IF(IENT1.GT.NBELEM)THEN
        INTERR(1)=IENT1
        INTERR(2)=NBELEM
        INTERR(3)=IENT3
        CALL ERREUR(8002)
        SEGDES,MELEME,IMODEL
        RETURN
      ENDIF
*
      MELE=NEFMOD
      NFOR=FORMOD(/2)
      CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE ')
      IF(IMECA.EQ.0)THEN
        INTERR(1)=IENT3
        CALL ERREUR(8003)
        RETURN
      ENDIF
      MINTE=0
      IF(IPOSI.EQ.1)THEN
        NBPGAU=NUM(/1)
      ELSE
        if(infmod(/1).lt. 2+iposi) then
        CALL ELQUOI(MELE,0,IPOSI,INFO,IMODEL)
        MINTE=INFELL(11)
        IF(IPOSI.EQ.2)NBPGAU=1
        IF(IPOSI.EQ.3)NBPGAU=INFELL(6)
        IF(IPOSI.EQ.4)NBPGAU=INFELL(3)
        IF(IPOSI.EQ.5)NBPGAU=INFELL(4)
        SEGSUP,INFO
        else
        minte=infmod(iposi+2)
        IF(IPOSI.EQ.2)NBPGAU=1
        IF(IPOSI.EQ.3)NBPGAU=INFELE(6)
        IF(IPOSI.EQ.4)NBPGAU=INFELE(3)
        IF(IPOSI.EQ.5)NBPGAU=INFELE(4)
        endif
      ENDIF
      
      
      SEGDES,MELEME
      IF(IENT2.GT.NBPGAU)THEN
        INTERR(1)=IENT2
        INTERR(2)=NBPGAU
        INTERR(3)=IENT3
        CALL ERREUR(8004)
        SEGDES,IMODEL
        RETURN
      ENDIF
*
*     ON CONSTRUIT LE MCHAML
*
      L1=LTYPE
      N1=1
      N3=6
      SEGINI,MCHELM
      TITCHE=CHATYPE(1:LTYPE)
      CONCHE(1)=CONMOD
      SEGDES,IMODEL
      IMACHE(1)=MELEME
      IFOCHE=IFOUR
      INFCHE(1,1) = 0
      INFCHE(1,2) = 0
      INFCHE(1,3) = NIFOUR
      INFCHE(1,4) = MINTE
      INFCHE(1,5) = 0
      INFCHE(1,6) = IPOSI
*
      N2=1
      SEGINI,MCHAML
      ICHAML(1)=MCHAML
      NOMCHE(1)=MOCHOI
      IF (IRETF.EQ.0) THEN
       TYPCHE(1)='POINTEUR'//TYPOBJ
       N1PTEL=0
       N1EL=0
       N2PTEL=NBPGAU
       N2EL=NBELEM
       SEGINI,MELVAL
       DO IB=1,NBELEM
         DO IGAU=1,NBPGAU
           IELCHE(IGAU,IB)=0
         END DO
       END DO
       IELCHE(IENT2,IENT1)=IPOBJ
      ELSE
       TYPCHE(1)='REAL*8          '
       N2PTEL=0
       N2EL=0
       N1PTEL=NBPGAU
       N1EL=NBELEM
       SEGINI,MELVAL
       DO IB=1,NBELEM
         DO IGAU=1,NBPGAU
           VELCHE(IGAU,IB)=0.D0
         END DO
       END DO
       VELCHE(IENT2,IENT1)=XFLOT
      ENDIF
      IELVAL(1)=MELVAL
      SEGDES,MELVAL,MCHAML,MCHELM
*
*     ON SORT
*
      CALL ECROBJ('MCHAML  ',MCHELM)
      RETURN
      END