Télécharger nomobj.eso

Retour à la liste

Numérotation des lignes :

  1. C NOMOBJ SOURCE JC220346 14/02/17 21:15:10 7942
  2. SUBROUTINE NOMOBJ(MTX,NAM,IVAL)
  3. IMPLICIT INTEGER(I-N)
  4. -INC CCOPTIO
  5. -INC CCNOYAU
  6. -INC SMBLOC
  7. CHARACTER*(*) NAM ,MTX
  8. CHARACTER*(8) MTY,MTZ
  9. LOGICAL ZCACHE
  10.  
  11. C RECHERCHE DU NOM DANS LA PILE DES NOMS
  12. MTY=MTX
  13. IL=LEN(NAM)
  14. DO 765 I=IL,1,-1
  15. IF(NAM(I:I).NE.' ') GO TO 764
  16. 765 CONTINUE
  17. I=1
  18. 764 IL=I
  19. ier=345
  20. CALL POSCHA(NAM(1:IL),IPOSCH)
  21. MAA=MDEOBJ
  22. itrouv=0
  23. * LES PROCEDURES PEUVENT ETRE DES OBJETS LOCAUX
  24. * => On parcourt le debut de la pile uniquement pour la
  25. * mise en cache des procedures definies dans UTILPROC
  26. * ou GIBI.PROC
  27. ZCACHE=((IOLEC.LT.0).OR.(IOLEC.GT.654321))
  28. IF ((MTY.EQ.'PROCEDUR').AND.ZCACHE) MAA=1
  29. DO 3 I =MAA,LMNNOM
  30. IF(IPOSCH.EQ.INOOB1(I)) THEN
  31. C ON A TROUVE
  32. itrouv=1
  33. MTZ=INOOB2(I)
  34. INOOB2(I)=MTY
  35. IF(MTY.NE.'PROCEDUR') THEN
  36. IOUEP2(I)=IVAL
  37. ELSE
  38. IF (ZCACHE) THEN
  39. c IF(MTZ.EQ.'PROCEDUR')THEN
  40. IPP=IOUEP2(I)
  41. IPIPR1(IPP) = IVAL
  42. ELSE
  43. IPIPRL=IPIPRL+1
  44. IF(IPIPRL.GT.IPIPR1(/1)) THEN
  45. LM=IPIPR1(/1)+100
  46. SEGADJ IPIPRO
  47. ENDIF
  48. IOUEP2(I)=IPIPRL
  49. IPIPR1(IPIPRL)=IVAL
  50. ENDIF
  51. ENDIF
  52. if(MTZ.ne.'PROCEDUR') RETURN
  53. ENDIF
  54. 3 CONTINUE
  55. if(itrouv.eq.1) return
  56. C IL FAUT CREER LE NOM
  57. LMNNOM=LMNNOM+1
  58. IO=IOUEP2(/1)
  59. IF(LMNNOM.GT.IO) THEN
  60. N=LMNNOM+50
  61. SEGADJ ITABOB,ITABOC,ITABOD
  62. ENDIF
  63. N=LMNNOM
  64. INOOB1(N)=IPOSCH
  65. INOOB2(N)=MTY
  66. IF(MTY.NE.'PROCEDUR')THEN
  67. IOUEP2(N)=IVAL
  68. ELSE
  69. IPIPRL=IPIPRL+1
  70. IF(IPIPRL.GT.IPIPR1(/1)) THEN
  71. LM=IPIPR1(/1)+100
  72. SEGADJ IPIPRO
  73. ENDIF
  74. IOUEP2(N)=IPIPRL
  75. IPIPR1(IPIPRL)=IVAL
  76. ENDIF
  77. RETURN
  78. END
  79.  
  80.  
  81.  
  82.  

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