Télécharger operpu.eso

Retour à la liste

operpu
C OPERPU    SOURCE    PASCAL    22/11/21    21:15:05     11502          
      SUBROUTINE OPERPU
C_______________________________________________________________________
C
C        ELEVE UN NOMBRE A UNE PUISSANCE
C
C
C     PASCAL MANIGOT (12/03/85) :
C     REPRISE DE LA PROGRAMMATION POUR PERMETTRE LE CALCUL DE
C     "REEL ** ENTIER"  (NOTAMMENT QUAND "REEL" EST NEGATIF).
C
C     EBERSOLT (2 MAI 85) : REPRISE POUR PERMETTRE LE CALCUL DE
C     CHPO ** I2 OU DE CHEL ** I2
C     CHPO ** X2 OU DE CHEL ** X2
C     rem :   DANS LE CAS OU UNE DES COMPOSANTES DU CHAMP EST
C             EST NEGATIVE ET SI L EXPOSANT EST REEL
C             ON MET LE RESULTAT A ZERO (au lieu de NAN ou erreur)
C
C     BEAUFILS (20 MAI 87) : REPRISE POUR PERMETTRE LE CALCUL DE
C     LISTREEL ** I2 OU LISTREEL ** X2
C
C     JM CAMPENON (12/90) : PASSAGE AUX NOUVEAUX CHAMELEM
C
C     S PASCAL (06/2006) :
C     -Puissance d'un MCHAML de composante de type EVOLUTION
C     -Puissance d'un objet EVOLUTION
C
C     BP (12/2010) concernant les LISTREELs et les EVOLUTIONs :
C     -reprise pour permettre la puissance entiere des EVOLUTIONs
C     -moins de mise a zero intempestives et + de valeurs "justes"
C     -avertissement si présence d'INF
C
C     CB (02/2015)
C     - ajout de toutes les operations valides sur les LISTENTI
C     - ajout de la possibilité de faire CHPOINT ** CHPOINT
C     - ajout d'une erreur pour I1 ** -I2 avec 2 INTEGER comme arguments
C
C_______________________________________________________________________
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMLENTI
-INC SMLREEL
      PARAMETER (NCLEVO = 2)
C
      INTEGER ICH1,IOPERA,IARGU,I1,ICHR,IRET
      REAL*8 FLO
 
      CHARACTER*4 CLEVO(NCLEVO)
      CHARACTER*8 CTYP,COMP
 
      DATA CLEVO/'ABSC','ORDO'/
 
      ICH1   = 0
      IOPERA = 0
      IARGU  = 0
      I1     = 0
      FLO    = 0.D0
      ICHR   = 0
      IRET   = 0
 
C_______________________________________________________________________
C
C   RECHERCHE DU TYPE DU PREMIER ARGUMENT
C_______________________________________________________________________
      CALL QUETYP(CTYP,0,IRETOU)
 
C_______________________________________________________________________
C
C   ENTIER ** ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 2
      CALL LIRENT(I2,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 2
      ENDIF
C     Cas de la puissance de 2 ENTIERS
      IF ((I1 .EQ. 0) .AND. (I2 .LT. 0)) THEN
        INTERR(1)=I1
        INTERR(2)=I2
        MOTERR(1:4)=' ** '
        CALL ERREUR(1059)
      ELSE
        CALL ECRENT(I1**I2)
      ENDIF
      RETURN
C
   2  CONTINUE
C_______________________________________________________________________
C
C   FLOTTANT ** ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 3
      CALL LIRREE(FLO1,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 3
      ENDIF
      IF ( CTYP .EQ. 'ENTIER') THEN
C       Cas ENTIER ** FLOTTANT
C       Verification si puissance ENTIERE possible
        I2    = NINT(FLO1)
        XFLOT = ABS(FLO1 - REAL(I2))
        IF ( XFLOT .LE. (XZPREC*ABS(FLO1)*REAL(2.D0))) THEN
          XFLOT=REAL(I1)**I2
          CALL ECRREE(XFLOT)
 
        ELSEIF (I1 .LT. 0 ) THEN
          INTERR(1)=I1
          REAERR(1)=FLO1
          MOTERR(1:4)=' ** '
          CALL ERREUR(1061)
        ELSE
          XFLOT=REAL(I1)**FLO1
          CALL ECRREE(XFLOT)
        ENDIF
 
      ELSE
C       Cas FLOTTANT ** ENTIER
        IF(ABS(FLO1).LT.XPETIT .AND. I1.LT.0)THEN
          REAERR(1)=FLO1
          INTERR(1)=I1
          MOTERR(1:4)=' ** '
          CALL ERREUR(1060)
        ELSE
          XFLOT=FLO1**I1
          CALL ECRREE(XFLOT)
        ENDIF
      ENDIF
      RETURN
C
   3  CONTINUE
C_______________________________________________________________________
C
C   FLOTTANT ** FLOTTANT
C_______________________________________________________________________
      CALL LIRREE(FLO1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 4
      CALL LIRREE(FLO2,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 4
      ENDIF
 
      IF ((ABS(FLO1).LT.XPETIT .AND. FLO2.LT.REAL(0.D0))) THEN
        REAERR(1)=FLO1
        REAERR(2)=FLO2
        MOTERR(1:4)=' ** '
        CALL ERREUR(1062)
      ELSE
C       Verification si puissance ENTIERE possible
        I2    = NINT(FLO2)
        XFLOT = ABS(FLO2 - REAL(I2))
        IF ( XFLOT .LE. (XZPREC*ABS(FLO2)*REAL(2.D0))) THEN
          XFLOT=FLO1**I2
          CALL ECRREE(XFLOT)
        ELSEIF(FLO1 .LT. REAL(0.D0))THEN
          REAERR(1)=FLO1
          REAERR(2)=FLO2
          MOTERR(1:4)=' ** '
          CALL ERREUR(1062)
        ELSE
          XFLOT=FLO1**FLO2
          CALL ECRREE(XFLOT)
        ENDIF
      ENDIF
      RETURN
C
   4  CONTINUE
C_______________________________________________________________________
C
C   MCHAML ** ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 5
      CALL LIROBJ('MCHAML  ',ICH1,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 5
      ENDIF
      CALL ACTOBJ('MCHAML  ',ICH1,1)
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'MCHAML') THEN
C       IARGU = 1  pour MCHAML ** ENTIER
        IARGU = 1
      ELSE
C       IARGU = 11 pour ENTIER ** MCHAML (terme a terme)
        IARGU = 11
      ENDIF
      FLO   = REAL(0.D0)
      ICHR = 0
      IRET = 0
      CALL OPCHE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('MCHAML  ',ICHR,1)
        CALL ECROBJ('MCHAML  ',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
 
   5  CONTINUE
C_______________________________________________________________________
C
C   CHPOINT ** ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 6
      CALL LIROBJ('CHPOINT',ICH1,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 6
      ENDIF
      CALL ACTOBJ('CHPOINT ',ICH1,1)
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'CHPOINT') THEN
C       IARGU = 1  pour CHPOINT ** ENTIER
        IARGU = 1
      ELSE
C       IARGU = 11 pour ENTIER ** CHPOINT (terme a terme)
        IARGU = 11
      ENDIF
      FLO   = REAL(0.D0)
      CALL OPCHP1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('CHPOINT ',ICHR,1)
        CALL ECROBJ('CHPOINT ',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   6  CONTINUE
C_______________________________________________________________________
C
C   MCHAML ** FLOTTANT
C_______________________________________________________________________
      CALL LIRREE(FLO,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 7
      CALL LIROBJ('MCHAML  ',ICH1,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 7
      ENDIF
      CALL ACTOBJ('MCHAML  ',ICH1,1)
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'MCHAML') THEN
C       IARGU = 2  pour MCHAML ** FLOTTANT
        IARGU = 2
      ELSE
C       IARGU = 21 pour FLOTTANT ** MCHAML (terme a terme)
        IARGU = 21
      ENDIF
      I1    = 0
      ICHR = 0
      IRET = 0
      CALL OPCHE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('MCHAML  ',ICHR,1)
        CALL ECROBJ('MCHAML  ',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   7  CONTINUE
C_______________________________________________________________________
C
C   CHPOINT**FLOTTANT
C_______________________________________________________________________
      CALL LIRREE(FLO,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 8
      CALL LIROBJ('CHPOINT',ICH1,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 8
      ENDIF
      CALL ACTOBJ('CHPOINT ',ICH1,1)
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'CHPOINT') THEN
C       IARGU = 2  pour CHPOINT ** FLOTTANT
        IARGU = 2
      ELSE
C       IARGU = 21 pour FLOTTANT ** CHPOINT (terme a terme)
        IARGU = 21
      ENDIF
      I1    = 0
      CALL OPCHP1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('CHPOINT ',ICHR,1)
        CALL ECROBJ('CHPOINT ',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   8  CONTINUE
C_______________________________________________________________________
C
C   LISTREEL**ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 9
      CALL LIROBJ('LISTREEL',ICH,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 9
      ENDIF
      MLREEL=ICH
      SEGACT,MLREEL
C     Puissance entre LISTREEL et ENTIER
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'LISTREEL') THEN
C       IARGU = 1  pour LISTREEL ** ENTIER
        IARGU = 1
      ELSE
C       IARGU = 11 pour ENTIER ** LISTREEL (terme a terme)
        IARGU = 11
      ENDIF
      FLO   = REAL(0.D0)
      ICHR  = 0
      CALL OPLRE1(ICH,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        MLREEL=ICHR
        SEGACT,MLREEL*NOMOD
        CALL ECROBJ('LISTREEL',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   9  CONTINUE
C_______________________________________________________________________
C
C   LISTREEL**FLOTTANT
C_______________________________________________________________________
      CALL LIRREE(FLO,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 10
      CALL LIROBJ('LISTREEL',ICH,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
          CALL REFUS
          GOTO 10
      ENDIF
      MLREEL=ICH
      SEGACT,MLREEL*NOMOD
C     Puissance entre LISTREEL et FLOTTANT
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'LISTREEL') THEN
C       IARGU = 2  pour LISTREEL ** FLOTTANT
        IARGU = 2
      ELSE
C       IARGU = 21 pour FLOTTANT ** LISTREEL (terme a terme)
        IARGU = 21
      ENDIF
      I1    = 0
      ICHR  = 0
      CALL OPLRE1(ICH,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        MLREEL=ICHR
        SEGACT,MLREEL*NOMOD
        CALL ECROBJ('LISTREEL',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   10 CONTINUE
C_______________________________________________________________________
C
C   EVOLUTION**ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 11
      CALL LIROBJ('EVOLUTIO',ICH,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 11
      ENDIF
      CALL ACTOBJ('EVOLUTIO',ICH,1)
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'EVOLUTIO') THEN
C       IARGU = 1  pour EVOLUTIO ** ENTIER
        IARGU = 1
      ELSE
C       IARGU = 11 pour ENTIER ** EVOLUTIO
        IARGU = 11
      ENDIF
      FLO    = REAL(0.D0)
      ICLE = 0
      CALL LIRMOT(CLEVO,NCLEVO,ICLE,0)
      IF (ICLE.EQ.0) ICLE = 2
      CALL OPEVO1(ICH,IOPERA,IARGU,ICLE,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('EVOLUTIO',ICHR,1)
        CALL ECROBJ('EVOLUTIO',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   11 CONTINUE
C_______________________________________________________________________
C
C   EVOLUTION**FLOTTANT
C_______________________________________________________________________
      CALL LIRREE(FLO,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 12
      CALL LIROBJ('EVOLUTIO',ICH,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 12
      ENDIF
      CALL ACTOBJ('EVOLUTIO',ICH,1)
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'EVOLUTIO') THEN
C       IARGU = 2  pour EVOLUTIO ** FLOTTANT
        IARGU = 2
      ELSE
C       IARGU = 21 pour FLOTTANT ** EVOLUTIO
        IARGU = 21
      ENDIF
      I1    = 0
      ICLE = 0
      CALL LIRMOT(CLEVO,NCLEVO,ICLE,0)
      IF (ICLE.EQ.0) ICLE = 2
      CALL OPEVO1(ICH,IOPERA,IARGU,ICLE,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('EVOLUTIO',ICHR,1)
        CALL ECROBJ('EVOLUTIO',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
C
   12 CONTINUE
C_______________________________________________________________________
C
C   LISTENTI**ENTIER
C_______________________________________________________________________
      CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
      IF(IRETOU.EQ.0)  GOTO 13
      CALL LIRENT(IVA,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
          CALL REFUS
          GOTO 13
      ENDIF
      SEGACT MLENT1
      JG=MLENT1.LECT(/1)
      SEGINI MLENTI
 
      IF (CTYP .EQ. 'LISTENTI') THEN
C       LISTENTI ** ENTIER
        DO 121 I=1,JG
          ITRA=MLENT1.LECT(I)
          IF ((ITRA .EQ. 0) .AND. (IVA .LT. 0)) THEN
            INTERR(1)=ITRA
            INTERR(2)=IVA
            MOTERR(1:4)=' ** '
            CALL ERREUR(1059)
            RETURN
          ELSE
            LECT(I)=ITRA**IVA
          ENDIF
  121   CONTINUE
 
      ELSE
C       ENTIER ** LISTENTI
        DO 122 I=1,JG
          ITRA=MLENT1.LECT(I)
          IF ((IVA .EQ. 0) .AND. (ITRA .LT. 0)) THEN
            INTERR(1)  =IVA
            INTERR(2)  =ITRA
            MOTERR(1:4)=' ** '
            CALL ERREUR(1059)
            RETURN
          ELSE
            LECT(I)=IVA**ITRA
          ENDIF
  122   CONTINUE
      ENDIF
 
      SEGACT,MLENTI*NOMOD
      CALL ECROBJ('LISTENTI',MLENTI)
      RETURN
C
  13  CONTINUE
C_______________________________________________________________________
C
C   LISTENTI**FLOTTANT
C_______________________________________________________________________
      CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
      IF(IRETOU.EQ.0)  GOTO 14
      CALL LIRREE(XVA,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
          CALL REFUS
          GOTO 14
      ENDIF
      SEGACT MLENT1
      JG=MLENT1.LECT(/1)
      SEGINI MLREEL
      IF (CTYP .EQ. 'LISTENTI') THEN
C       LISTENTI ** FLOTTANT
        DO 131 I=1,JG
          I1=MLENT1.LECT(I)
C         Verification si puissance ENTIERE possible
          I2    = NINT(XVA)
          XFLOT = ABS(XVA - REAL(I2))
          IF ( XFLOT .LE. (XZPREC*ABS(XVA)*REAL(2.D0))) THEN
             PROG(I)=REAL(I1)**I2
 
          ELSEIF (I1 .LT. 0 ) THEN
            INTERR(1)=I1
            REAERR(1)=XVA
            MOTERR(1:4)=' ** '
            CALL ERREUR(1061)
            RETURN
          ELSE
            PROG(I)=REAL(I1)**XVA
          ENDIF
  131   CONTINUE
 
      ELSE
C       FLOTTANT ** LISTENTI
        DO 132 I=1,JG
          I1=MLENT1.LECT(I)
          IF (XVA .EQ. 0.D0 .AND. I1 .LT. 0 ) THEN
            INTERR(1)=XVA
            REAERR(1)=I1
            MOTERR(1:4)=' ** '
            CALL ERREUR(1061)
            RETURN
          ELSE
            PROG(I)=XVA**I1
          ENDIF
  132   CONTINUE
      ENDIF
 
      SEGACT,MLREEL*NOMOD
      CALL ECROBJ('LISTREEL',MLREEL)
      RETURN
 
  14  CONTINUE
C_______________________________________________________________________
C
C   LISTREEL**LISTREEL
C_______________________________________________________________________
      CALL LIROBJ('LISTREEL',ICH,0,IRETOU)
      IF(IRETOU.EQ.0) GOTO 15
      MLREEL=ICH
      SEGACT,MLREEL*NOMOD
      CALL LIROBJ('LISTREEL',ICHR,0,IRETOU)
      IF(IRETOU.EQ.0) THEN
           CALL REFUS
           GOTO 15
      ENDIF
      MLREEL=ICHR
      SEGACT,MLREEL*NOMOD
 
C     Puissance entre LISTREEL et LISTREEL terme a terme
C     IOPERA= 1 pour l'operation PUISSANCE
C     IARGU = 0 pour ne pas utiliser I1 et FLO
      IOPERA= 1
      IARGU = 0
      I1    = 0
      FLO   = REAL(0.D0)
      CALL OPLRE1(ICH,IOPERA,IARGU,I1,FLO,ICHR,IRET)
      IF(IRET.NE.0) THEN
        MLREEL=ICHR
        SEGACT,MLREEL*NOMOD
        CALL ECROBJ('LISTREEL',ICHR)
      ELSE
        CALL ERREUR(26)
      ENDIF
      RETURN
 
  15  CONTINUE
C_______________________________________________________________________
C
C   LISTREEL**LISTENTI
C_______________________________________________________________________
      CALL LIROBJ('LISTREEL',ICH,0,IRETOU)
      IF(IRETOU.EQ.0) GOTO 16
      CALL LIROBJ('LISTENTI',ICHR,0,IRETOU)
      IF(IRETOU.EQ.0) THEN
           CALL REFUS
           GOTO 16
      ENDIF
      MLREEL=ICH
      MLENTI=ICHR
      SEGACT,MLREEL ,MLENTI
      JG=MLREEL.PROG(/1)
      SEGINI,MLREE1
      IF(MLENTI.LECT(/1) .NE. JG)THEN
        CALL ERREUR(217)
        RETURN
      ENDIF
 
      IF (CTYP .EQ. 'LISTREEL') THEN
C       LISTREEL ** LISTENTI
        DO 151 II=1,JG
          XVA = MLREEL.PROG(II)
          I1  = MLENTI.LECT(II)
          IF (XVA .EQ. 0.D0 .AND. I1 .LT. 0 ) THEN
            INTERR(1)=XVA
            REAERR(1)=I1
            MOTERR(1:4)=' ** '
            CALL ERREUR(1060)
            RETURN
          ELSE
            MLREE1.PROG(II) = XVA ** I1
          ENDIF
 151    CONTINUE
      ELSE
C       LISTENTI ** LISTREEL 
        DO 152 II=1,JG
          XVA = MLREEL.PROG(II)
          I1  = MLENTI.LECT(II)
          IF (I1 .LT. 0 ) THEN
            INTERR(1)=I1
            REAERR(1)=FLO1
            MOTERR(1:4)=' ** '
            CALL ERREUR(1061)
            RETURN
          ELSE
            MLREE1.PROG(II) = I1 ** XVA
          ENDIF
 152    CONTINUE
      ENDIF
 
      SEGACT,MLREE1*NOMOD
      CALL ECROBJ('LISTREEL',MLREE1)
      RETURN
 
  16  CONTINUE
C_______________________________________________________________________
C
C   LISTENTI**LISTENTI
C_______________________________________________________________________
      CALL LIROBJ('LISTENTI',ICH,0,IRETOU)
      IF(IRETOU.EQ.0) GOTO 17
      CALL LIROBJ('LISTENTI',ICHR,0,IRETOU)
      IF(IRETOU.EQ.0) THEN
           CALL REFUS
           GOTO 17
      ENDIF
      MLENTI=ICH
      MLENT1=ICHR
      SEGACT,MLENTI,MLENT1
 
      JG=MLENTI.LECT(/1)
      IF(MLENT1.LECT(/1) .NE. JG)THEN
        CALL ERREUR(217)
        RETURN
      ENDIF
      SEGINI,MLENT2
 
      DO 160 II=1,JG
        I1=MLENTI.LECT(II)
        I2=MLENT1.LECT(II)
        IF(I1 .EQ. 0 .AND. I2 .LT. 0)THEN
          INTERR(1)=I1
          INTERR(2)=I2
          MOTERR(1:4)=' ** '
          CALL ERREUR(1059)
          RETURN
        ELSE
          MLENT2.LECT(II)=I1 ** I2
        ENDIF
 160  CONTINUE      
 
      SEGACT,MLENT2*NOMOD
      CALL ECROBJ('LISTENTI',MLENT2)
      RETURN
 
   17 CONTINUE
C_______________________________________________________________________
C
C   NUAGE**ENTIER
C_______________________________________________________________________
      CALL LIRENT(I1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 18
      CALL LIROBJ('NUAGE   ',ICH,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 18
      ENDIF
      CALL ACTOBJ('NUAGE   ',ICH,1)
      IF (IERR.NE.0) RETURN
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'NUAGE   ') THEN
C       IARGU = 1  pour NUAGE    ** ENTIER
        IARGU = 1
      ELSE
C       IARGU = 11 pour ENTIER ** NUAGE   
        IARGU = 11
      ENDIF
      FLO    = REAL(0.D0)
C     Lecture du nom de la composante
      CALL LIRCHA(COMP,1,IRETOU)
      IF (IERR.NE.0) RETURN
      CALL OPNUA1(ICH,IOPERA,IARGU,COMP,I1,FLO,ICHR,IRET)
      IF (IERR.NE.0) RETURN
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('NUAGE   ',ICHR,1)
        CALL ECROBJ('NUAGE   ',ICHR)
      ELSE
C       ERREUR 5 car erreurs gerees dans OPNUA1
        CALL ERREUR(5)
      ENDIF
      RETURN
 
   18 CONTINUE
C_______________________________________________________________________
C
C   NUAGE**FLOTTANT
C_______________________________________________________________________
      CALL LIRREE(FLO,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 20
      CALL LIROBJ('NUAGE   ',ICH,0,IRETOU)
      IF (IRETOU.EQ.0) THEN
         CALL REFUS
         GOTO 20
      ENDIF
      CALL ACTOBJ('NUAGE   ',ICH,1)
      IF (IERR.NE.0) RETURN
C     IOPERA= 1 pour l'operation PUISSANCE
      IOPERA= 1
      IF (CTYP .EQ. 'NUAGE   ') THEN
C       IARGU = 2  pour NUAGE    ** FLOTTANT
        IARGU = 2
      ELSE
C       IARGU = 21 pour FLOTTANT ** NUAGE
        IARGU = 21
      ENDIF
      I1 = 0
C     Lecture du nom de la composante
      CALL LIRCHA(COMP,1,IRETOU)
      IF (IERR.NE.0) RETURN
      CALL OPNUA1(ICH,IOPERA,IARGU,COMP,I1,FLO,ICHR,IRET)
      IF (IERR.NE.0) RETURN
      IF(IRET.NE.0) THEN
        CALL ACTOBJ('NUAGE   ',ICHR,1)
        CALL ECROBJ('NUAGE   ',ICHR)
      ELSE
C       ERREUR 5 car erreurs gerees dans OPNUA1
        CALL ERREUR(5)
      ENDIF
      RETURN
 
  20  CONTINUE
C_______________________________________________________________________
C
C   ON A RIEN TROUVE POUR FAIRE L OPERATION
C_______________________________________________________________________
      CALL QUETYP(MOTERR(1:8),0,IRETOU)
      IF(IRETOU.NE.0) THEN
         CALL LIROBJ(MOTERR(1:8),IRET,1,IRETOU)
         CALL QUETYP(MOTERR(9:16),0,IRETOU)
         IF (IRETOU.EQ.0)  MOTERR(9:16) = '  ????  '
         CALL ERREUR(532)
      ELSE
         CALL ERREUR(533)
      ENDIF
      RETURN
      END
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales