C NOMC      SOURCE    CB215821  21/05/05    21:15:09     10993          

C=======================================================================
C
C     OPERATEUR RENOMMANT LE NOM DE LA COMPOSANTE D UN CHPOINT
C                                              OU D UN MCHAML
C                         certaines composantes d'un chpoint (extension)
C     CHPO1 = NOMC | MOT         | CHPO2
C                  | LISM1 LISM2 |
C     CHE1 = NOMC | MOT         | CHE2
C                  | LISM1 LISM2 |
C
C     EBERSOLT DECEMBRE 84        D. R.-M. avril 94
C     extension MCHAML kich 01/99
C     ajouts actobj sg 12/2019      
C=======================================================================
C
      SUBROUTINE NOMC

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)


-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI

      CHARACTER*(LOCOMP) MOT1
      CHARACTER*4        MOT2(1),MOTNAT(3)
      DATA               MOT2/'NATU'/
      DATA               MOTNAT/'INDE','DIFF','DISC'/

C On initialise comme sur IBM (a -1)
      IRT1=-1
      IRT2=-1
      IRT3=-1
      IRT6=-1
C
C     On tente de lire un LISTMOTS
C
      CALL LIROBJ('LISTMOTS',IPLM1,0,IRT3)
      IF (IERR.NE.0) GOTO 666
C
      IF (IRT3.EQ.1) THEN
         CALL ACTOBJ('LISTMOTS',IPLM1,1)
         CALL LIROBJ('LISTMOTS',IPLM2,1,IRT3)
         IF (IERR.NE.0) GOTO 666
         CALL ACTOBJ('LISTMOTS',IPLM2,1)
C
         CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
         IF (IERR.NE.0) GOTO 666
C
         IF (IRT2.EQ.1) THEN
            CALL ACTOBJ('CHPOINT ',IPCH1,1)
            CALL NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
         ELSE
           CALL LIROBJ('MCHAML  ',IPCH1,1,IRT6)
           IF (IERR.NE.0) GOTO 266
           CALL ACTOBJ('MCHAML  ',IPCH1,1)
           CALL NOMC3(IPCH1,IPLM1,IPLM2,IPCH2,' ')
        ENDIF
        IF (IERR.NE.0) GOTO 666
C
      ELSE
         CALL LIRCHA(MOT1,1,IRT1)
         IF (IERR.NE.0) GOTO 666
C
         CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
         IF (IERR.NE.0) GOTO 666

         IF (IRT2.EQ.1) THEN
            CALL ACTOBJ('CHPOINT ',IPCH1,1)
            IRET=-1
            CALL NOMCOM(IPCH1,MOT1,IPCH2,IRET)
            IF (IRET.EQ.0) GOTO 666
         ELSE
            CALL LIROBJ('MCHAML  ',IPCH1,1,IRT6)
            IF (IERR.NE.0) GOTO 266
            CALL ACTOBJ('MCHAML  ',IPCH1,1)
            CALL NOMC3(IPCH1,-1,-1,IPCH2,MOT1)
         ENDIF
         IF (IERR.NE.0) GOTO 666
      ENDIF
C
C     on essaie de lire la nouvelle nature
C
      IF (IRT2.EQ.1) THEN
         CALL LIRMOT(MOT2,1,INAT,0)
         IF (IERR .NE. 0) GOTO 666
         IF (INAT.NE.0) THEN
            CALL LIRMOT(MOTNAT,3,JATT1,1)
            IF (IERR .NE. 0) GOTO 666
            MCHPOI=IPCH2
            SEGACT MCHPOI*MOD
            NJAT = JATTRI(/1)
            IF (NJAT.LT.1) THEN
               NSOUPO = IPCHP(/1)
               NAT = 1
               SEGADJ MCHPOI
            ENDIF
            JATTRI(INAT)=JATT1-1
*new-paradigm            SEGDES MCHPOI
         ENDIF
      ENDIF
C
      IF (IRT2.EQ.1) THEN
         CALL ACTOBJ('CHPOINT ',IPCH2,1)
         CALL ECROBJ('CHPOINT ',IPCH2)
      ELSE
         CALL ACTOBJ('MCHAML  ',IPCH2,1)
         CALL ECROBJ('MCHAML  ',IPCH2)
      ENDIF
      GOTO 666
C
C    PAS D OPERANDE CORRECTE TROUVE
C
 266  CALL QUETYP(MOTERR(1:8),0,IRETOU)
      IF(IRETOU.NE.0) THEN
         CALL ERREUR (39)
      ELSE
         CALL ERREUR(533)
      ENDIF

  666 CONTINUE
      RETURN
      END