Esope source files

   1 : C EXTR52    SOURCE    CHAT      05/01/12    23:52:48     5004           
   2 :         SUBROUTINE EXTR52(IPOINT,MINI,IPOSI)
   3 : 
   4 : **********************************************************************
   5 : *
   6 : *   Extraction de la borne inf. ou sup. d'un objet NUAGE selon
   7 : *   les donnees du nom d'une composante reelle et de sa valeur
   8 : *
   9 : *    INTEGER   (E)   IPOINT   pointeur sur un objet NUAGE
  10 : *    LOGICAL   (E)   BORNINF  logique valant vrai si l'on veut la
  11 : *                             borne inf. du nuage
  12 : *    FLOTTANT  (E)   XVAL     valeur de la composante reelle pour
  13 : *                             laquelle on desire le n-uplet inferieur
  14 : *                             ou superieur
  15 : *    INTEGER   (E)   IPOSI    Position informatique de la composante
  16 : *                             reelle du nuage
  17 : *
  18 : ***********************************************************************
  19 : 
  20 :       IMPLICIT INTEGER(I-N)
  21 : -INC SMNUAGE
  22 : 
  23 :         REAL*8      XVAL,XVAL1,XVAL2,XVAL3
  24 :         INTEGER     IPOINT,IPOSI,IPOSI3
  25 :         LOGICAL     MINI,MAXI
  26 :         CHARACTER*8 TYPR
  27 : 
  28 :         MAXI = .NOT.MINI
  29 : 
  30 :         MNUAG1 = IPOINT
  31 :         SEGACT MNUAG1
  32 :         IDIM1 = MNUAG1.NUANOM(/2)
  33 :         TYPR = MNUAG1.NUATYP(IPOSI)
  34 :         IF (TYPR.NE.'FLOTTANT') THEN
  35 :            SEGDES MNUAG1
  36 : *- Le nom de la composante ne correspond pas a des variables reelles -
  36 :            CALL ERREUR(671)
  37 :            RETURN
  38 :         ENDIF
  39 :         NUAVF1 = MNUAG1.NUAPOI(IPOSI)
  40 :         SEGACT NUAVF1
  41 :         IDIM2 = NUAVF1.NUAFLO(/1)
  42 :         XVAL1 = NUAVF1.NUAFLO(1)
  43 :         XVAL2 = NUAVF1.NUAFLO(2)
  44 :         IPOSI3 = 1
  45 :         XVAL3 = XVAL1
  46 :         IF (XVAL2.LE.XVAL3.AND.MINI) THEN
  47 :             IPOSI3 = 2
  48 :             XVAL3 = XVAL2
  49 :         ENDIF
  50 :         IF (XVAL2.GE.XVAL3.AND.MAXI) THEN
  51 :             IPOSI3 = 2
  52 :             XVAL3 = XVAL2
  53 :         ENDIF
  54 : 
  55 :         DO 11 I=3,IDIM2
  56 :            XVAL1 = XVAL2
  57 :            XVAL2 = NUAVF1.NUAFLO(I)
  58 :            IF (XVAL2.LE.XVAL3.AND.MINI) THEN
  59 :                IPOSI3 = I
  60 :                XVAL3 = XVAL2
  61 :            ENDIF
  62 :            IF (XVAL2.GE.XVAL3.AND.MAXI) THEN
  63 :                IPOSI3 = I
  64 :                XVAL3 = XVAL2
  65 :            ENDIF
  66 :  11     CONTINUE
  67 : 
  68 :         SEGDES NUAVF1
  69 : 
  70 :         NVAR = IDIM1
  71 :         NBCOUP = 1
  72 :         SEGINI MNUAGE
  73 :         IPO2 = MNUAGE
  74 :         DO 10 I=1,IDIM1
  75 :            NUANOM(I)=MNUAG1.NUANOM(I)
  76 :            NUATYP(I)=MNUAG1.NUATYP(I)
  77 :            IF (NUATYP(I).EQ.'INTEGER ') THEN
  78 :               SEGINI NUAVIN
  79 :               NUAPOI(I) = NUAVIN
  80 :               NUAVI1 = MNUAG1.NUAPOI(I)
  81 :               SEGACT NUAVI1
  82 :               NUAINT(1) = NUAVI1.NUAINT(IPOSI3)
  83 :               SEGDES NUAVI1
  84 :               SEGDES NUAVIN
  85 :            ELSE IF (NUATYP(I).EQ.'FLOTTANT') THEN
  86 :               SEGINI NUAVFL
  87 :               NUAPOI(I) = NUAVFL
  88 :               NUAVF1 = MNUAG1.NUAPOI(I)
  89 :               SEGACT NUAVF1
  90 :               NUAFLO(1) = NUAVF1.NUAFLO(IPOSI3)
  91 :               SEGDES NUAVF1
  92 :               SEGDES NUAVFL
  93 :            ELSE IF (NUATYP(I).EQ.'MOT     ') THEN
  94 :               SEGINI NUAVMO
  95 :               NUAPOI(I) = NUAVMO
  96 :               NUAVM1 = MNUAG1.NUAPOI(I)
  97 :               SEGACT NUAVM1
  98 :               NUAMOT(1) = NUAVM1.NUAMOT(IPOSI3)
  99 :               SEGDES NUAVM1
 100 :               SEGDES NUAVMO
 101 :            ELSE IF (NUATYP(I).EQ.'LOGIQUE ') THEN
 102 :               SEGINI NUAVLO
 103 :               NUAPOI(I) = NUAVLO
 104 :               NUAVL1 = MNUAG1.NUAPOI(I)
 105 :               SEGACT NUAVL1
 106 :               NUALOG(1) = NUAVL1.NUALOG(IPOSI3)
 107 :               SEGDES NUAVL1
 108 :               SEGDES NUAVLO
 109 :            ELSE
 110 :               SEGINI NUAVIN
 111 :               NUAPOI(I) = NUAVIN
 112 :               NUAVI1 =  MNUAG1.NUAPOI(I)
 113 :               SEGACT NUAVI1
 114 :               NUAINT(1) = NUAVI1.NUAINT(IPOSI3)
 115 :               SEGDES NUAVI1
 116 :               SEGDES NUAVIN
 117 :            END IF
 118 :  10     CONTINUE
 119 : 
 120 :         SEGDES MNUAGE
 121 :         SEGDES MNUAG1
 121 :         CALL ECROBJ('NUAGE   ',IPO2)
 122 :         RETURN
 123 :         END
 124 : 
 125 :