Sources Esope | Cast3M

argu
C ARGU      SOURCE    CB215821  24/07/17    21:15:03     11961          
      SUBROUTINE ARGU
C
C  LECTURE (AUTANT QUE PASSIBLE)  DE TRIPLET DE MOT
C      LE PREMIER EST LE NOM DE L'OBJET A LIRE
C      LE DEUXIEME EST LE CARACTERE:  *  POUR UNE LECTURE OBLIGATOIRE
C                              OU  :  /  POUR UNE LECTURE FACULTATIVE
C      LE TROISIEME EST LE TYPE DE L'OBJET ATTENDU
C
C      (SEUL LE PREMIER EST OBLIGATOIRE)
C
C       EXEMPLE  :      IJK * ENTIER
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC SMBLOC
-INC CCASSIS
      CHARACTER*8 CHAINE,CHAANC
      CHARACTER*(LONOM) NOM
*      CHARACTER*72 CHAMOT
      CHARACTER*512 CHAMOT
      CHARACTER*1 MOTCLE(2)
      REAL*8 XRET
      LOGICAL LOGI
      DATA MOTCLE/'/','*'/
C
C  APPEL A LIRCHA POUR CONNAITRE LE NOM DE L'OBJET( DANS LIRNOM ON A
C  PRIS SOIN DE D'IMPOSER LE TYPE MOT AUX DONNEES QUI SUIVAIENT LE MOT
C  "ARGU"
C
*  pour autoriser les segsup sur les vieux segments
      call ooohor(0)
  1   CONTINUE
C DEBUT DE MODIF TC
      CALL QUETYP (CHAANC ,0,IRETOU)
      IF(IRETOU.EQ.0) RETURN
      IF(IERR.NE.0) RETURN
        IF(CHAANC.EQ.'ENTIER  ') THEN
                CALL LIRENT ( II,1,IRETOU)
        ELSEIF(CHAANC.EQ.'FLOTTANT') THEN
                CALL LIRREE(XRET,1,IRETOU)
        ELSEIF(CHAANC.EQ.'MOT     ') THEN
                CALL LIRCHA(NOM,1,IRETOU)
        ELSEIF(CHAANC.EQ.'LOGIQUE ') THEN
                CALL LIRLOG(LOGI,1,IRETOU)
        ELSE
                CALL LIROBJ(CHAANC,IRET,1,IRETOU)
        ENDIF
      CALL QUENOM ( NOM)
*     CALL LIRCHA (NOM,0,IRETOU)
      IF(IRETOU.EQ.0) RETURN
      CALL NOMOBJ('ANNULE ',NOM,IRETOU)
      CALL LIRMOT(MOTCLE,2,IR,0)
      IF (IERR.NE.0) RETURN
      IF (IR.GT.0) THEN
          ICODE=IR-1
          CALL LIRCHA(CHAINE,1,IRETOU)
          IF (IERR.NE.0) RETURN
      ELSE
          ICODE=0
          CHAINE='        '
      ENDIF
      MPROCI=MPROCD
      MBLO1=MBLOC
      IF(MPROCD.EQ.0) THEN
C RECHERCHE DU SEGMENT MPROCE QUI DOIT ETRE REACTIVE
         MBLO1=MBLSUP
    2    CONTINUE
         IF(MBLO1.EQ.0) THEN
             CALL ERREUR(5)
             RETURN
         ENDIF
         SEGACT MBLO1*MOD
         IF(MBLO1.MPROCD.NE.0) GO TO 3
         MMM= MBLO1.MBLSUP
         SEGDES MBLO1
         MBLO1=MMM
         GO TO 2
   3     CONTINUE
         MPROCI=MBLO1.MPROCD
         SEGDES MBLO1
      ENDIF
C APPEL A ARGU1 QUI FERA LA LECTURE
      CHAANC=CHAINE
      CALL ARGU1(CHAINE,IRET,ICODE,IRETOU,MPROCI)
      SEGACT MBLO1*MOD
      MBLO1.MPROCD=MPROCI
      IF(MBLO1.NE.MBLOC) SEGDES MBLO1
      IF(IERR.NE.0) RETURN
      IF(IRETOU.NE.0) THEN
          if(nbesc.ne.0) segact ipiloc
          IF(CHAINE.EQ.'ENTIER  ') THEN
               IF (CHAANC.EQ.'FLOTTANT') THEN
                  XRET=IRET
                  CALL NOMREE(NOM,XRET)
               ELSE
                  IVAL=IRET
                  CALL NOMENT(NOM,IVAL)
               ENDIF
          ELSEIF(CHAINE.EQ.'FLOTTANT')THEN
             XRET=XIFLOT(IRET)
             CALL NOMREE(NOM,XRET)
          ELSEIF(CHAINE.EQ.'LOGIQUE ')THEN
             LOGI=IPLOGI(IRET)
             CALL NOMLOG(NOM,LOGI)
          ELSEIF(CHAINE.EQ.'MOT     ')THEN
             JF=IPCHAR(IRET+1)
             ID=IPCHAR(IRET)
*sg Avant, il y avait : ILO=JF-ID => pas de garde-fou, écrasement possible
             ILO=MIN(JF-ID,LEN(CHAMOT))
             CHAMOT(1:ILO)=ICHARA(ID:ID+ILO-1)
             CALL NOMCHA(NOM,CHAMOT(1:ILO))
          ELSE
             CALL NOMOBJ(CHAINE,NOM,IRET)
          ENDIF
         if(nbesc.ne.0) SEGDES,IPILOC
      ENDIF
      GO TO 1
      END