Sources Esope | Cast3M

prenom
C PRENOM    SOURCE    PV090527  24/01/09    21:15:22     11817          
      SUBROUTINE PRENOM(IPLAMO,IAVA,JREDLE)
C
C   SERT A RETOURNER LA PLACE DE MOT DANS LA TABLE DES OBJETS.
C   CELA A PARTIR DE MDEOBJ (DEBUT DE LA PILE OBJET AFFECTEE A LA
C   PROCEDURE . SI LE MOT EXISTAIT AVANT MDEOBJ IL INITIALISE LE
C   NOUVEAU EGAL AU DERNIER CREE ( SAUF POUR LE CAS DES BLOCS).
C   SI CE MOT N'EXISTE PAS ON LE MET EN DERNIER ET ON LUI AFFECTE
C   LE TYPE MOT .
C   CAS D'UNE CONSTANTE : (IRE=1 ENTIER;IRE=2 FLOTTANT;IRE=5 BOOLEEN
C   IDEM PRECEDEMENT DANS LA TABLE DES NOMS LE NOM EST BLANC
C   CAS D'UN TEXTE : IRE=4 ON LE STOCKE COMME UN OBJET MAIS
C   ON LUI ATTRIBUE UN SEGMENT ET ON STOCKE LE POINTEUR DANS LA TABLE
C   DES OBJETS.
C    CAS D'UN SEPARATEUR : (IRE = 6) ON TRAITE COMME UN MOT
C   IAVA=1 ON EST AVANT LE SIGNE =, ONINITIALISE PAS LA VALEUR AVEC
C   LES OBJETS DEFINIES AVANT LA PROCEDURE
C
C   IAVA=0 ON EST APRES LE SIGNE =, ON INITIALISE LE TYPE ET LA VALEUR
C
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC CCREDLE
-INC SMTEXTE
-INC SMBLOC
-INC CCASSIS
 
      CHARACTER*(8) MOBLO
      CHARACTER*(LOCHAI) MOTBUF
      SAVE INSEPA,INMETH
      DATA MOBLO/'BLOC    '/
      DATA INSEPA/0/,INMETH/0/
      LOGICAL BOOLIR
 
      SREDLE=JREDLE
      IPLAMO=0
      ILON=INOOB1(/1)
*      If(insepa.eq.0) then
*        CALL POSCHA('.',INCHA)
*        LMNNOM=LMNNOM+1
**        INSEPA=LMNNOM
*        INOOB2(LMNNOM)='SEPARATE'
*        INOOB1(LMNNOM)=INCHA
*        IOUEP2(LMNNOM)= INCHA
*      ENDIF
 100  continue
*      if(ire.eq.7) write(6,*) ' ire inmeth ' , ire , inmeth
*      IF(IRE.EQ.7.AND.INMETH.NE.0) THEN
*        IPLAMO=INMETH
*        RETURN
*      ENDIF
*       write(6,*) ' sredle ire ', sredle,ire
      IF(IRE.EQ.7)THEN
        IF(INMETH.EQ.0) THEN
          CALL POSCHA('%',INCHA)
          LMNNOM=LMNNOM+1
          IF( LMNNOM.GT.ILON) THEN
            N=LMNNOM+50
            SEGADJ ITABOB,ITABOC,ITABOD
          ENDIF
          INMETH=LMNNOM
          INOOB2(LMNNOM)='METHODOL'
          INOOB1(LMNNOM)=INCHA
          IOUEP2(LMNNOM)= INCHA
          iplamo=lmnnom
        ENDIF
        IPLAMO=INMETH
        RETURN
      ENDIF
      IF(IRE.EQ.6)THEN
        IF(INSEPA.EQ.0) THEN
          CALL POSCHA('.',INCHA)
          LMNNOM=LMNNOM+1
          IF( LMNNOM.GT.ILON) THEN
            N=LMNNOM+50
            SEGADJ ITABOB,ITABOC,ITABOD
          ENDIF
          INSEPA=LMNNOM
          INOOB2(LMNNOM)='SEPARATE'
          INOOB1(LMNNOM)=INCHA
          IOUEP2(LMNNOM)= INCHA
          iplamo=lmnnom
        ENDIF
        IPLAMO=INSEPA
        RETURN
      ENDIF
      IF(IRE.NE.3.AND.IRE.NE.4) GO TO 30
      MOTBUF(1:NCAR)=MOT(1:NCAR)
      NCAS=NCAR
      CALL POSCHA(MOTBUF(1:NCAS),INCHA)
   96 CONTINUE
C
C   la chaine est en incha ieme position dans la pile des chaines
C
       IF(IRE.EQ.3.AND.NCAR.LE.LONOM) THEN
         MAA = MDEOBJ
         IF(MFIOBJ.NE.0) MAA = 1
         DO 1 J =LMNNOM,MAA,-1
         IF(INCHA.NE.INOOB1(J)) GOTO 1
                IPLAMO = J
                return
  1      CONTINUE
      ELSE
        DO 72 J=LMNNOM,MDEOBJ,-1
          IF(INOOB1(J).NE.1) GO TO 72
          IF(INOOB2(J).NE.'MOT     ') GO TO 72
          IF(IOUEP2(J).NE.INCHA) GO TO 72
          IPLAMO=J
*      if(ire.eq.7)write(6,*) 'on a trouve la methodol ',iplamo,INOOB2(J)
          RETURN
  72  CONTINUE
      ENDIF
  98  CONTINUE
      LMNNOM=LMNNOM+1
      IPLAMO=LMNNOM
      IF( LMNNOM.GT.ILON) THEN
         N=LMNNOM+50
         SEGADJ ITABOB,ITABOC,ITABOD
      ENDIF
      INOOB1(LMNNOM)=INCHA
      IF(IRE.EQ.4) INOOB1(LMNNOM)=1
*
*  CORRECTION : UN MOT DE PLUS DE LONOM CARACTERES NE PEUT PAS ETRE UN NOM
       IF (NCAR.GT.LONOM) INOOB1(LMNNOM)=1
*
         INOOB2(LMNNOM)='MOT'
         IOUEP2(LMNNOM)= INCHA
*      IF(IRE.EQ.7)  THEN
*            write(6,*) ' prenom creation d une methodol ',iplamo
*         INOOB2(LMNNOM)='METHODOL'
*         INMETH=IPLAMO
*      ENDIF
      RETURN
   30 CONTINUE
C
C  CAS DES AUTRES CHOSE QUE MOT
C
      IF(IRE.EQ.1) THEN
         DO 1501 K=lmnnom,mdeobj,-1
         IF(IOUEP2(K).NE.NFIX) GO TO 1501
         IF(INOOB2(K).NE.'ENTIER  ') GO TO 1501
         IF(INOOB1(K).NE.1) GO TO 1501
         IPLAMO=K
         RETURN
1501     CONTINUE
         LMNNOM=LMNNOM+1
         IF(LMNNOM.GT.INOOB1(/1)) THEN
            N = LMNNOM + 50
            SEGADJ ITABOB,ITABOC,ITABOD
         ENDIF
         N=LMNNOM
         INOOB1(N)=1
         INOOB2(N)='ENTIER  '
         IOUEP2(N)=NFIX
         IPLAMO=N
         RETURN
      ELSEIF(IRE.EQ.2) THEN
         if(nbesc.ne.0) segact ipiloc
         IO=XIFLOT(/1)
         if(nbesc.ne.0) SEGDES,IPILOC
         xxfl= flot
         call posree(xxfl,j)
         IF(j.le.io) then
           DO 1503 K=MDEOBJ,LMNNOM
             IF(IOUEP2(K).NE.J) GO TO 1503
             IF(INOOB2(K).NE.'FLOTTANT') GO TO 1503
             IF(INOOB1(K).NE.1) GO TO 1503
             IPLAMO=K
             RETURN
 1503      CONTINUE
         endif
         IIP=J
         LMNNOM=LMNNOM+1
         IF(LMNNOM.GT.INOOB1(/1)) THEN
            N = LMNNOM+ 50
            SEGADJ ITABOB,ITABOC,ITABOD
         ENDIF
         N=LMNNOM
         INOOB1(N)=1
         INOOB2(N)='FLOTTANT'
         IOUEP2(N)=IIP
         IPLAMO=N
         RETURN
      ELSEIF (IRE.EQ.5) THEN
*         write(6,*) ' on traite un logique' , bool
         boolir=bool
         call poslog(boolir,j)
*         write(6,*) j , iouep2(13),inoob2(13), inoob1(13)
         DO 1505 K=1,LMNNOM
         IF(IOUEP2(K).NE.J) GO TO 1505
         IF(INOOB2(K).NE.'LOGIQUE ') GO TO 1505
         IF(INOOB1(K).NE.1) GO TO 1505
         IPLAMO=K
*         write(6,*) ' on a trouve un logique ioplamo ' , iplamo
         RETURN
 1505    CONTINUE
         IIP=J
         LMNNOM=LMNNOM+1
         IF(LMNNOM.GT.INOOB1(/1)) THEN
            N=LMNNOM+50
            SEGADJ ITABOB,ITABOC,ITABOD
         ENDIF
         N=LMNNOM
         INOOB1(N)=1
         INOOB2(N)='LOGIQUE '
         IOUEP2(N)=IIP
         IPLAMO=N
         RETURN
      ENDIF
      RETURN
      END