Sources Esope | Cast3M

extr52
C EXTR52    SOURCE    CHAT      05/01/12    23:52:48     5004
        SUBROUTINE EXTR52(IPOINT,MINI,IPOSI)
 
**********************************************************************
*
*   Extraction de la borne inf. ou sup. d'un objet NUAGE selon
*   les donnees du nom d'une composante reelle et de sa valeur
*
*    INTEGER   (E)   IPOINT   pointeur sur un objet NUAGE
*    LOGICAL   (E)   BORNINF  logique valant vrai si l'on veut la
*                             borne inf. du nuage
*    FLOTTANT  (E)   XVAL     valeur de la composante reelle pour
*                             laquelle on desire le n-uplet inferieur
*                             ou superieur
*    INTEGER   (E)   IPOSI    Position informatique de la composante
*                             reelle du nuage
*
***********************************************************************
 
      IMPLICIT INTEGER(I-N)
-INC SMNUAGE
 
        REAL*8      XVAL,XVAL1,XVAL2,XVAL3
        INTEGER     IPOINT,IPOSI,IPOSI3
        LOGICAL     MINI,MAXI
        CHARACTER*8 TYPR
 
        MAXI = .NOT.MINI
 
        MNUAG1 = IPOINT
        SEGACT MNUAG1
        IDIM1 = MNUAG1.NUANOM(/2)
        TYPR = MNUAG1.NUATYP(IPOSI)
        IF (TYPR.NE.'FLOTTANT') THEN
           SEGDES MNUAG1
*- Le nom de la composante ne correspond pas a des variables reelles -
           CALL ERREUR(671)
           RETURN
        ENDIF
        NUAVF1 = MNUAG1.NUAPOI(IPOSI)
        SEGACT NUAVF1
        IDIM2 = NUAVF1.NUAFLO(/1)
        XVAL1 = NUAVF1.NUAFLO(1)
        XVAL2 = NUAVF1.NUAFLO(2)
        IPOSI3 = 1
        XVAL3 = XVAL1
        IF (XVAL2.LE.XVAL3.AND.MINI) THEN
            IPOSI3 = 2
            XVAL3 = XVAL2
        ENDIF
        IF (XVAL2.GE.XVAL3.AND.MAXI) THEN
            IPOSI3 = 2
            XVAL3 = XVAL2
        ENDIF
 
        DO 11 I=3,IDIM2
           XVAL1 = XVAL2
           XVAL2 = NUAVF1.NUAFLO(I)
           IF (XVAL2.LE.XVAL3.AND.MINI) THEN
               IPOSI3 = I
               XVAL3 = XVAL2
           ENDIF
           IF (XVAL2.GE.XVAL3.AND.MAXI) THEN
               IPOSI3 = I
               XVAL3 = XVAL2
           ENDIF
 11     CONTINUE
 
        SEGDES NUAVF1
 
        NVAR = IDIM1
        NBCOUP = 1
        SEGINI MNUAGE
        IPO2 = MNUAGE
        DO 10 I=1,IDIM1
           NUANOM(I)=MNUAG1.NUANOM(I)
           NUATYP(I)=MNUAG1.NUATYP(I)
           IF (NUATYP(I).EQ.'INTEGER ') THEN
              SEGINI NUAVIN
              NUAPOI(I) = NUAVIN
              NUAVI1 = MNUAG1.NUAPOI(I)
              SEGACT NUAVI1
              NUAINT(1) = NUAVI1.NUAINT(IPOSI3)
              SEGDES NUAVI1
              SEGDES NUAVIN
           ELSE IF (NUATYP(I).EQ.'FLOTTANT') THEN
              SEGINI NUAVFL
              NUAPOI(I) = NUAVFL
              NUAVF1 = MNUAG1.NUAPOI(I)
              SEGACT NUAVF1
              NUAFLO(1) = NUAVF1.NUAFLO(IPOSI3)
              SEGDES NUAVF1
              SEGDES NUAVFL
           ELSE IF (NUATYP(I).EQ.'MOT     ') THEN
              SEGINI NUAVMO
              NUAPOI(I) = NUAVMO
              NUAVM1 = MNUAG1.NUAPOI(I)
              SEGACT NUAVM1
              NUAMOT(1) = NUAVM1.NUAMOT(IPOSI3)
              SEGDES NUAVM1
              SEGDES NUAVMO
           ELSE IF (NUATYP(I).EQ.'LOGIQUE ') THEN
              SEGINI NUAVLO
              NUAPOI(I) = NUAVLO
              NUAVL1 = MNUAG1.NUAPOI(I)
              SEGACT NUAVL1
              NUALOG(1) = NUAVL1.NUALOG(IPOSI3)
              SEGDES NUAVL1
              SEGDES NUAVLO
           ELSE
              SEGINI NUAVIN
              NUAPOI(I) = NUAVIN
              NUAVI1 =  MNUAG1.NUAPOI(I)
              SEGACT NUAVI1
              NUAINT(1) = NUAVI1.NUAINT(IPOSI3)
              SEGDES NUAVI1
              SEGDES NUAVIN
           END IF
 10     CONTINUE
 
        SEGDES MNUAGE
        SEGDES MNUAG1
        CALL ECROBJ('NUAGE   ',IPO2)
        RETURN
        END