Esope source files

   1 : C NOMMER    SOURCE    JC220346  14/02/19    21:15:05     7941           
   2 : 
   3 :       SUBROUTINE NOMMER
   4 : C=======================================================================
   5 : C DIRECTIVE NOMMER :
   6 : C           Creation d'un objet nomme dont le nom est choisi par 
   7 : C           l'utilisateur
   8 : C
   9 : C SYNTAXE :
  10 : C        'NOMMER' MOT1 OBJ1 ;
  11 : C
  12 : C         MOT1 : Nom de l'objet nomme qui sera cree dans Cast3M
  13 : C         OBJ1 : Objet existant que l'on souhaite egalement nommer MOT1
  14 : C
  15 : C=======================================================================
  16 : 
  17 :       IMPLICIT INTEGER(I-N)
  18 :       IMPLICIT REAL*8 (A-H,O-Z)
  19 : 
  20 : -INC CCOPTIO
  21 : -INC CCNOYAU
  22 : 
  23 :       CHARACTER*8 TYPO,NOMO
  24 :       CHARACTER*512 CHAO
  25 :       LOGICAL LOGO
  26 : 
  27 : C-Pour le passage en majuscules
  28 :       CHARACTER*26 MINU,MAJU
  29 :       DATA MINU / 'abcdefghijklmnopqrstuvwxyz' /
  30 :       DATA MAJU / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  31 : 
  32 : C- On commence par lire le nouveau nom :
  33 :       TYPO = ' '
  34 :       IRETOU = 0
  34 :       CALL QUETYP(TYPO,0,IRETOU)
  35 :       IF (IERR.NE.0) RETURN    
  35 :       IF (IRETOU.LE.0) CALL ERREUR(5)
  36 :       IF (TYPO.EQ.'MOT     ') THEN
  37 :         CHAO = ' '
  37 :         CALL LIRCHA(CHAO,1,IRETOU)
  38 :         IF (IERR.NE.0) RETURN
  39 :         IF (IRETOU.GT.8) THEN
  40 :           WRITE(ioimp,*) 'Nom = pas plus de 8 caracteres'
  40 :           CALL ERREUR(315)
  41 :           RETURN
  42 :         ENDIF
  43 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'CHAO=',CHAO(1:8),'='
  43 :         CALL QUENOM(NOMO)
  44 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'NOMO=',NOMO,'='
  45 :         IF (NOMO(1:1).EQ.' ') THEN
  45 :           CALL ERREUR(315)
  46 :           RETURN
  47 :         ENDIF
  48 : **        IF (IIMPI.EQ.12345) THEN
  49 : **          IF (NOMO(1:1).EQ.'#') write(ioimp,*) 'Objet temporaire'
  50 : **        ENDIF
  51 :         j = INDEX(CHAO(1:IRETOU),' ')
  52 :         IF (j.NE.0) THEN
  52 :           CALL ERREUR(315)
  53 :           RETURN
  54 :         ENDIF
  55 :         NOMO = '        '
  56 :         DO i = 1, IRETOU
  57 :           NOMO(i:i) = CHAO(i:i)
  58 :           j = INDEX(MINU,NOMO(i:i))
  59 :           IF (j.NE.0) NOMO(i:i) = MAJU(j:j)
  60 :         ENDDO
  61 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'CHA=',NOMO,'='
  62 :       ELSE
  62 :         CALL LIROBJ(TYPO,IPKO,1,IRETOU)
  63 :         IF (IERR.NE.0) RETURN
  63 :         CALL QUENOM(NOMO)
  64 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'OBJ=',NOMO,'='
  65 :       ENDIF
  66 : 
  67 : C- Detection du TYPE de l'objet a nommer
  68 :       IRETOU = 0
  69 :       TYPO = ' '
  69 :       CALL QUETYP(TYPO,0,IRETOU)
  70 :       IF (IERR.NE.0) RETURN    
  70 :       IF (IRETOU.LE.0) CALL ERREUR(5)
  71 : 
  72 : C- Lecture de l'objet a nommer PUIS Affectation du nom a l'objet
  73 :       IF      (TYPO.EQ.'ENTIER  ') THEN
  73 :         CALL LIRENT(INTO,1,IRETOU)
  74 :         IF (IERR.NE.0) RETURN
  74 :         CALL NOMENT(NOMO,INTO)
  75 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet ENTIER valeur =',INTO
  76 :       ELSE IF (TYPO.EQ.'FLOTTANT') THEN
  76 :         CALL LIRREE(REEO,1,IRETOU)
  77 :         IF (IERR.NE.0) RETURN
  77 :         CALL NOMREE(NOMO,REEO)
  78 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet FLOTTANT valeur =',REEO
  79 :       ELSE IF (TYPO.EQ.'LOGIQUE ') THEN
  79 :         CALL LIRLOG(LOGO,1,IRETOU)
  80 :         IF (IERR.NE.0) RETURN
  80 :         CALL NOMLOG(NOMO,LOGO)
  81 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet LOGIQUE valant ',LOGO
  82 :       ELSE IF (TYPO.EQ.'MOT     ') THEN
  82 :         CALL LIRCHA(CHAO,1,IRETOU)
  83 :         IF (IERR.NE.0) RETURN
  83 :         CALL NOMCHA(NOMO,CHAO(1:IRETOU))
  84 : **        IF (IIMPI.EQ.12345) write(ioimp,*) 'objet MOT =',CHAO(1:IRETOU)
  85 :       ELSE
  85 :         CALL LIROBJ(TYPO,IPKO,1,IRETOU)
  86 :         IF (IERR.NE.0) RETURN
  87 :         IF (TYPO.EQ.'PROCEDUR') IPKO=IPIPR1(IPKO)
  87 :         CALL NOMOBJ(TYPO,NOMO,IPKO)
  88 : **       IF (IIMPI.EQ.12345)  write(ioimp,*) 'objet ',TYPO,' pointeur =',IPKO
  89 :       ENDIF
  90 : 
  91 :       RETURN
  92 :       END
  93 : 
  94 :  
  95 :  
  96 :