C NOMMER    SOURCE    JC220346  14/02/19    21:15:05     7941           

      SUBROUTINE NOMMER
C=======================================================================
C DIRECTIVE NOMMER :
C           Creation d'un objet nomme dont le nom est choisi par 
C           l'utilisateur
C
C SYNTAXE :
C        'NOMMER' MOT1 OBJ1 ;
C
C         MOT1 : Nom de l'objet nomme qui sera cree dans Cast3M
C         OBJ1 : Objet existant que l'on souhaite egalement nommer MOT1
C
C=======================================================================

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

-INC CCOPTIO
-INC CCNOYAU

      CHARACTER*8 TYPO,NOMO
      CHARACTER*512 CHAO
      LOGICAL LOGO

C-Pour le passage en majuscules
      CHARACTER*26 MINU,MAJU
      DATA MINU / 'abcdefghijklmnopqrstuvwxyz' /
      DATA MAJU / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /

C- On commence par lire le nouveau nom :
      TYPO = ' '
      IRETOU = 0
      CALL QUETYP(TYPO,0,IRETOU)
      IF (IERR.NE.0) RETURN    
      IF (IRETOU.LE.0) CALL ERREUR(5)
      IF (TYPO.EQ.'MOT     ') THEN
        CHAO = ' '
        CALL LIRCHA(CHAO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        IF (IRETOU.GT.8) THEN
          WRITE(ioimp,*) 'Nom = pas plus de 8 caracteres'
          CALL ERREUR(315)
          RETURN
        ENDIF
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'CHAO=',CHAO(1:8),'='
        CALL QUENOM(NOMO)
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'NOMO=',NOMO,'='
        IF (NOMO(1:1).EQ.' ') THEN
          CALL ERREUR(315)
          RETURN
        ENDIF
**        IF (IIMPI.EQ.12345) THEN
**          IF (NOMO(1:1).EQ.'#') write(ioimp,*) 'Objet temporaire'
**        ENDIF
        j = INDEX(CHAO(1:IRETOU),' ')
        IF (j.NE.0) THEN
          CALL ERREUR(315)
          RETURN
        ENDIF
        NOMO = '        '
        DO i = 1, IRETOU
          NOMO(i:i) = CHAO(i:i)
          j = INDEX(MINU,NOMO(i:i))
          IF (j.NE.0) NOMO(i:i) = MAJU(j:j)
        ENDDO
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'CHA=',NOMO,'='
      ELSE
        CALL LIROBJ(TYPO,IPKO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        CALL QUENOM(NOMO)
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'OBJ=',NOMO,'='
      ENDIF

C- Detection du TYPE de l'objet a nommer
      IRETOU = 0
      TYPO = ' '
      CALL QUETYP(TYPO,0,IRETOU)
      IF (IERR.NE.0) RETURN    
      IF (IRETOU.LE.0) CALL ERREUR(5)

C- Lecture de l'objet a nommer PUIS Affectation du nom a l'objet
      IF      (TYPO.EQ.'ENTIER  ') THEN
        CALL LIRENT(INTO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        CALL NOMENT(NOMO,INTO)
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet ENTIER valeur =',INTO
      ELSE IF (TYPO.EQ.'FLOTTANT') THEN
        CALL LIRREE(REEO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        CALL NOMREE(NOMO,REEO)
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet FLOTTANT valeur =',REEO
      ELSE IF (TYPO.EQ.'LOGIQUE ') THEN
        CALL LIRLOG(LOGO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        CALL NOMLOG(NOMO,LOGO)
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet LOGIQUE valant ',LOGO
      ELSE IF (TYPO.EQ.'MOT     ') THEN
        CALL LIRCHA(CHAO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        CALL NOMCHA(NOMO,CHAO(1:IRETOU))
**        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet MOT =',CHAO(1:IRETOU)
      ELSE
        CALL LIROBJ(TYPO,IPKO,1,IRETOU)
        IF (IERR.NE.0) RETURN
        IF (TYPO.EQ.'PROCEDUR') IPKO=IPIPR1(IPKO)
        CALL NOMOBJ(TYPO,NOMO,IPKO)
**       IF (IIMPI.EQ.12345)  write(ioimp,*) 'objet ',TYPO,' pointeur =',IPKO
      ENDIF

      RETURN
      END