Télécharger nommer.eso

Retour à la liste

Numérotation des lignes :

  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
  35. CALL QUETYP(TYPO,0,IRETOU)
  36. IF (IERR.NE.0) RETURN
  37. IF (IRETOU.LE.0) CALL ERREUR(5)
  38. IF (TYPO.EQ.'MOT ') THEN
  39. CHAO = ' '
  40. CALL LIRCHA(CHAO,1,IRETOU)
  41. IF (IERR.NE.0) RETURN
  42. IF (IRETOU.GT.8) THEN
  43. WRITE(ioimp,*) 'Nom = pas plus de 8 caracteres'
  44. CALL ERREUR(315)
  45. RETURN
  46. ENDIF
  47. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'CHAO=',CHAO(1:8),'='
  48. CALL QUENOM(NOMO)
  49. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'NOMO=',NOMO,'='
  50. IF (NOMO(1:1).EQ.' ') THEN
  51. CALL ERREUR(315)
  52. RETURN
  53. ENDIF
  54. ** IF (IIMPI.EQ.12345) THEN
  55. ** IF (NOMO(1:1).EQ.'#') write(ioimp,*) 'Objet temporaire'
  56. ** ENDIF
  57. j = INDEX(CHAO(1:IRETOU),' ')
  58. IF (j.NE.0) THEN
  59. CALL ERREUR(315)
  60. RETURN
  61. ENDIF
  62. NOMO = ' '
  63. DO i = 1, IRETOU
  64. NOMO(i:i) = CHAO(i:i)
  65. j = INDEX(MINU,NOMO(i:i))
  66. IF (j.NE.0) NOMO(i:i) = MAJU(j:j)
  67. ENDDO
  68. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'CHA=',NOMO,'='
  69. ELSE
  70. CALL LIROBJ(TYPO,IPKO,1,IRETOU)
  71. IF (IERR.NE.0) RETURN
  72. CALL QUENOM(NOMO)
  73. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'OBJ=',NOMO,'='
  74. ENDIF
  75.  
  76. C- Detection du TYPE de l'objet a nommer
  77. IRETOU = 0
  78. TYPO = ' '
  79. CALL QUETYP(TYPO,0,IRETOU)
  80. IF (IERR.NE.0) RETURN
  81. IF (IRETOU.LE.0) CALL ERREUR(5)
  82.  
  83. C- Lecture de l'objet a nommer PUIS Affectation du nom a l'objet
  84. IF (TYPO.EQ.'ENTIER ') THEN
  85. CALL LIRENT(INTO,1,IRETOU)
  86. IF (IERR.NE.0) RETURN
  87. CALL NOMENT(NOMO,INTO)
  88. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'objet ENTIER valeur =',INTO
  89. ELSE IF (TYPO.EQ.'FLOTTANT') THEN
  90. CALL LIRREE(REEO,1,IRETOU)
  91. IF (IERR.NE.0) RETURN
  92. CALL NOMREE(NOMO,REEO)
  93. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'objet FLOTTANT valeur =',REEO
  94. ELSE IF (TYPO.EQ.'LOGIQUE ') THEN
  95. CALL LIRLOG(LOGO,1,IRETOU)
  96. IF (IERR.NE.0) RETURN
  97. CALL NOMLOG(NOMO,LOGO)
  98. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'objet LOGIQUE valant ',LOGO
  99. ELSE IF (TYPO.EQ.'MOT ') THEN
  100. CALL LIRCHA(CHAO,1,IRETOU)
  101. IF (IERR.NE.0) RETURN
  102. CALL NOMCHA(NOMO,CHAO(1:IRETOU))
  103. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'objet MOT =',CHAO(1:IRETOU)
  104. ELSE
  105. CALL LIROBJ(TYPO,IPKO,1,IRETOU)
  106. IF (IERR.NE.0) RETURN
  107. IF (TYPO.EQ.'PROCEDUR') IPKO=IPIPR1(IPKO)
  108. CALL NOMOBJ(TYPO,NOMO,IPKO)
  109. ** IF (IIMPI.EQ.12345) write(ioimp,*) 'objet ',TYPO,' pointeur =',IPKO
  110. ENDIF
  111.  
  112. RETURN
  113. END
  114.  
  115.  
  116.  
  117.  
  118.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales