Télécharger la plaquette Cast3M


fr en

Télécharger nomobj.eso

Retour à la liste

Numérotation des lignes : 

nomobj

  1. C NOMOBJ    SOURCE    PV090527  24/01/09    21:15:18     11817          
  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.  
  87.  

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