Esope source files

   1 : C EXTR51    SOURCE    CHAT      05/01/12    23:52:43     5004           
   2 :         SUBROUTINE EXTR51(IPO1,IPOSI)
   3 : **********************************************************************
   4 : *
   5 : *     Extraction de l'objet contenu dans un NUAGE "colonne"
   6 : *          Correspondant a une composante donnee
   7 : *
   8 : *   INTEGER    (E)   IPO1   pointeur sur l'objet NUAGE
   9 : *   INTEGER    (E)   IPOSI  position informatique de la composante
  10 : *                           souhaitee
  11 : *
  12 : **********************************************************************
  13 :       IMPLICIT INTEGER(I-N)
  14 : -INC SMNUAGE
  15 : 
  16 :        INTEGER     IPO1,IPO2,IPO3,IPOSI,IDIM,IVAL
  17 :        CHARACTER*8 TYP1,MVAL
  18 :        LOGICAL     LVAL
  19 :        REAL*8      XVAL
  20 : 
  21 :        MNUAGE = IPO1
  22 :        SEGACT MNUAGE
  23 :        TYP1 = NUATYP(IPOSI)
  24 :        IF (TYP1.EQ.'FLOTTANT') THEN
  25 :           NUAVFL = NUAPOI(IPOSI)
  26 :           SEGACT NUAVFL
  27 :           IDIM = NUAFLO(/1)
  28 :           IF (IDIM.NE.1) THEN
  29 :              SEGDES NUAVFL
  30 :              SEGDES MNUAGE
  31 : *------------- Le nuage n'est pas un nuage "colonne" -------------
  31 :              CALL ERREUR(670)
  32 :              RETURN
  33 :           ENDIF
  34 :           XVAL = NUAFLO(1)
  35 :           SEGDES NUAVFL
  36 :           SEGDES MNUAGE
  36 :           CALL ECRREE(XVAL)
  37 :           RETURN
  38 :        ELSE IF (TYP1.EQ.'INTEGER ') THEN
  39 :           NUAVIN = NUAPOI(IPOSI)
  40 :           SEGACT NUAVIN
  41 :           IDIM = NUAINT(/1)
  42 :           IF (IDIM.NE.1) THEN
  43 :              SEGDES NUAVIN
  44 :              SEGDES MNUAGE
  45 : *------------- Le nuage n'est pas un nuage "colonne" -------------
  45 :              CALL ERREUR(670)
  46 :              RETURN
  47 :           ENDIF
  48 :           IVAL = NUAINT(1)
  49 :           SEGDES NUAVIN
  50 :           SEGDES MNUAGE
  50 :           CALL ECRENT(IVAL)
  51 :           RETURN
  52 :        ELSE IF (TYP1.EQ.'LOGIQUE ') THEN
  53 :           NUAVLO = NUAPOI(IPOSI)
  54 :           SEGACT NUAVLO
  55 :           IDIM = NUALOG(/1)
  56 :           IF (IDIM.NE.1) THEN
  57 :              SEGDES NUAVLO
  58 :              SEGDES MNUAGE
  59 : *------------- Le nuage n'est pas un nuage "colonne" -------------
  59 :              CALL ERREUR(670)
  60 :              RETURN
  61 :           ENDIF
  62 :           LVAL = NUALOG(1)
  63 :           SEGDES NUAVLO
  64 :           SEGDES MNUAGE
  64 :           CALL ECRLOG(LVAL)
  65 :           RETURN
  66 :        ELSE IF (TYP1.EQ.'MOT     ') THEN
  67 :           NUAVMO = NUAPOI(IPOSI)
  68 :           SEGACT NUAVMO
  69 :           IDIM = NUAMOT(/2)
  70 :           IF (IDIM.NE.1) THEN
  71 :              SEGDES NUAVMO
  72 :              SEGDES MNUAGE
  73 : *------------- Le nuage n'est pas un nuage "colonne" -------------
  73 :              CALL ERREUR(670)
  74 :              RETURN
  75 :           ENDIF
  76 :           MVAL = NUAMOT(1)
  77 :           SEGDES NUAVMO
  78 :           SEGDES MNUAGE
  78 :           CALL ECRCHA(MVAL)
  79 :           RETURN
  80 :        ELSE
  81 :           IPO2 = NUAPOI(IPOSI)
  82 :           NUAVIN = IPO2
  83 :           SEGACT NUAVIN
  84 :           IDIM = NUAINT(/1)
  85 :           IF (IDIM.NE.1) THEN
  86 :              SEGDES NUAVIN
  87 :              SEGDES MNUAGE
  88 : *------------- Le nuage n'est pas un nuage "colonne" -------------
  88 :              CALL ERREUR(670)
  89 :              RETURN
  90 :           ENDIF
  91 :           IPO3 = NUAINT(1)
  92 :           SEGDES NUAVIN
  93 :           SEGDES MNUAGE
  93 :           CALL ECROBJ(TYP1,IPO3)
  94 :           RETURN
  95 :        ENDIF
  96 : 
  97 :        END
  98 :