C OPERPU SOURCE BP208322 12/05/24 21:15:00 7378 SUBROUTINE OPERPU *_______________________________________________________________________ * * ELEVE UN NOMBRE A UNE PUISSANCE * * * PASCAL MANIGOT (12/03/85) : * REPRISE DE LA PROGRAMMATION POUR PERMETTRE LE CALCUL DE * "REEL ** ENTIER" (NOTAMMENT QUAND "REEL" EST NEGATIF). * * EBERSOLT (2 MAI 85) : REPRISE POUR PERMETTRE LE CALCUL DE * CHPO ** I2 OU DE CHEL ** I2 * CHPO ** X2 OU DE CHEL ** X2 * rem : DANS LE CAS OU UNE DES COMPOSANTES DU CHAMP EST * EST NEGATIVE ET SI L EXPOSANT EST REEL * ON MET LE RESULTAT A ZERO (au lieu de NAN ou erreur) * * BEAUFILS (20 MAI 87) : REPRISE POUR PERMETTRE LE CALCUL DE * LISTREEL ** I2 OU LISTREEL ** X2 * * JM CAMPENON (12/90) : PASSAGE AUX NOUVEAUX CHAMELEM * * S PASCAL (06/2006) : * -Puissance d'un MCHAML de composante de type EVOLUTIOn * -Puissance d'un objet EVOLUTIOn * * BP (12/2010) concernant les LISTREELs et les EVOLUTIOns : * -reprise pour permettre la puissance entiere des evolutions * -moins de mise a zero intempestives et + de valeurs "justes" * -avertissement si présence d'INF * *_______________________________________________________________________ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO *_______________________________________________________________________ * * ENTIER**ENTIER *_______________________________________________________________________ * 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 CALL ECRENT(I1**I2) RETURN * 2 CONTINUE *_______________________________________________________________________ * * FLOTTANT**ENTIER *_______________________________________________________________________ * CALL LIRREE(FLO1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 3 CALL LIRENT(I2,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 3 ENDIF CALL ECRREE(FLO1**I2) RETURN * 3 CONTINUE *_______________________________________________________________________ * * FLOTTANT**FLOTTANT *_______________________________________________________________________ * 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 CALL ECRREE(FLO1**FLO2) RETURN * 4 CONTINUE *_______________________________________________________________________ * * MCHAML ** ENTIER *_______________________________________________________________________ * CALL LIRENT(I1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 5 CALL LIROBJ('MCHAML',IPCHE1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 5 ENDIF CALL PUCHEL(IPCHE1,I1,IPCHPU,IRET) IF (IRET.NE.0) CALL ECROBJ('MCHAML',IPCHPU) RETURN 5 CONTINUE *_______________________________________________________________________ * * CHPOINT**ENTIER *_______________________________________________________________________ * CALL LIRENT(I1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 6 CALL LIROBJ('CHPOINT',ICH,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 6 ENDIF CALL PUCHPO(ICH,I1,ICHR,IRET) IF(IRET.NE.0) CALL ECROBJ('CHPOINT',ICHR) RETURN * 6 CONTINUE *_______________________________________________________________________ * * MCHAML ** FLOTTANT *_______________________________________________________________________ * CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 7 CALL LIROBJ('MCHAML',IPCHE1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 7 ENDIF CALL PUCHER(IPCHE1,FLO,IPCHPU,IRET) IF ( IPCHPU.EQ.0 ) RETURN IF ( IRET.EQ.0 ) CALL ERREUR(220) CALL ECROBJ('MCHAML',IPCHPU) RETURN * 7 CONTINUE *_______________________________________________________________________ * * CHPOINT**FLOTTANT *_______________________________________________________________________ * CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 8 CALL LIROBJ('CHPOINT',ICH,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 8 ENDIF CALL PUCHPR(ICH,FLO,ICHR,IRET) IF( IRET.EQ.0 ) CALL ERREUR(220) IF(IRET.NE.0) CALL ECROBJ('CHPOINT',ICHR) RETURN * 8 CONTINUE *_______________________________________________________________________ * * LISTREEL**ENTIER *_______________________________________________________________________ * CALL LIRENT(I1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 9 CALL LIROBJ('LISTREEL',ILIST,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 9 ENDIF FLO=I1 IRET=1 CALL PULIRF(ILIST,FLO,I1,IRES,IRET) CALL ECROBJ('LISTREEL',IRES) RETURN * 9 CONTINUE *_______________________________________________________________________ * * LISTREEL**FLOTTANT *_______________________________________________________________________ * CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 10 CALL LIROBJ('LISTREEL',ILIST,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 10 ENDIF I1=nint(FLO) IRET=2 CALL PULIRF(ILIST,FLO,I1,IRES,IRET) CALL ECROBJ('LISTREEL',IRES) RETURN * 10 CONTINUE *_______________________________________________________________________ * * EVOLUTIOn**ENTIER *_______________________________________________________________________ * CALL LIRENT(I1,0,IRETOU) IF (IRETOU.EQ.0) GOTO 11 CALL LIROBJ('EVOLUTIO',IEVOL1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 11 ENDIF FLO=REAL(I1) IRET=1 CALL PUEVOL(IEVOL1,FLO,I1,IEVOPU,IRET) IF ( IRET.EQ.0) THEN CALL ERREUR(220) ENDIF CALL ECROBJ('EVOLUTIO',IEVOPU) RETURN * 11 CONTINUE *_______________________________________________________________________ * * EVOLUTIOn*FLOTTANT *_______________________________________________________________________ * CALL LIRREE(FLO,0,IRETOU) IF (IRETOU.EQ.0) GOTO 12 CALL LIROBJ('EVOLUTIO',IEVOL1,0,IRETOU) IF (IRETOU.EQ.0) THEN CALL REFUS GOTO 12 ENDIF IRET=2 CALL PUEVOL(IEVOL1,FLO,I1,IEVOPU,IRET) IF (IRET.EQ.0) THEN CALL ERREUR(220) ENDIF CALL ECROBJ('EVOLUTIO',IEVOPU) RETURN * 12 CONTINUE *_______________________________________________________________________ C C ON A DONC 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