Télécharger nomobj.eso

Retour à la liste

Numérotation des lignes :

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

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