Sources Esope | Cast3M

openti
C OPENTI    SOURCE    GOUNAND   19/07/23    21:15:15     10267          
      SUBROUTINE OPENTI(IIN1,IIN2,BATAN2,IOPERA,IOUT,XOUT)
C=======================================================================
C      EFFECTUE DIVERSES OPERATIONS SUR LES ENTIERS
C=======================================================================
C  ENTREES
C     IIN1= ENTIER   sur lequel on effectue l'operation
C     IIN2= deuxieme argument ENTIER   pour l'operation ATAN2
C
C   BATAN2= TRUE  Booleen permettant de faire l'operation ATAN2
C         = FALSE Booleen permettant de faire l'operation ATAN
C     IOPERA= 1  COSINUS
C           = 2  SINUS
C           = 3  TANGENTE
C           = 4  ARCOSINUS
C           = 5  ARCSINUS
C           = 6  ARCTANGENTE
C           = 7  EXPONENTIELLE
C           = 8  LOGARITHME
C           = 9  VALEUR ABSOLUE
C           = 10 COSINUS  HYPERBOLIQUE
C           = 11 SINUS    HYPERBOLIQUE
C           = 12 TANGENTE HYPERBOLIQUE
C           = 13 ERF  FONCTION D'ERRREUR DE GAUSS
C           = 14 ERFC FONCTION D'ERRREUR complementaire DE GAUSS (1-erf(x))
C           = 15 ARGCH (Fonction reciproque de COSH)
C           = 16 ARGSH (Fonction reciproque de SINH)
C           = 17 ARGTH (Fonction reciproque de TANH)
C           = 18 SIGN(1.D0,IIN1)
C
C           = 19 PRODUIT   IIN1 *  IIN2
C           = 20 DIVISION  IIN1 /  IIN2
C           = 21 PUISSANCE IIN1 ** IIN2
C
C
C  SORTIES
C     IOUT=ENTIER   RESULTAT
C     XOUT=FLOTTANT RESULTAT
C
C HISTORIQUE :
C   - CB215821                   2014  --> Creation
C   - CB215821             05/06/2018  --> Ajout de la fonction SIGN a un argument
C
C=======================================================================
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      LOGICAL  BATAN2
      INTEGER  IOPERA,IIN1,IIN2,IOUT
      REAL*8   XOUT,XCONV,XVNOC
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
C
      IOUT = 0
      XOUT = XZERO
C
      GOTO(1 ,2 ,3 ,4 ,5 ,6 ,7 ,8 ,9 ,10,11,12,13,14,15,
     &     16,17,18,19,20,21),(IOPERA-5)
C
C     COSINUS
 1       CONTINUE
         XCONV = XPI / 180.D0
         XOUT=COS(XCONV*REAL(IIN1))
         GOTO 166
C
C     SINUS
 2       CONTINUE
         XCONV = XPI / 180.D0
         XOUT=SIN(XCONV*REAL(IIN1))
         GOTO 166
C
C     TANGENTE
 3       CONTINUE
         XCONV = XPI / 180.D0
C        Le cas 90° +/- n*180° n'est pas défini pour les Entiers
C        Pour les réels on laisse couler (Voir opflot.eso)
         IF ((MOD(IIN1-90,180).EQ.0)) THEN
           INTERR(1)=IIN1
           CALL ERREUR(36)
         ELSE
           XOUT=TAN(XCONV*REAL(IIN1))
         ENDIF
         GOTO 166
C
C     ARCOSINUS
 4       CONTINUE
         XVNOC = 180.D0 / XPI
         IF ( (IIN1 .GE. -1) .AND. (IIN1 .LE. 1)) THEN
           XOUT=XVNOC*ACOS(REAL(IIN1))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARCSINUS
 5       CONTINUE
         XVNOC = 180.D0 / XPI
         IF ( (IIN1 .GE. -1) .AND. (IIN1 .LE. 1)) THEN
           XOUT=XVNOC*ASIN(REAL(IIN1))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARCTANGENTE
 6       CONTINUE
         XVNOC = 180.D0 / XPI
 
 
         IF (BATAN2 .EQV. .TRUE.) THEN
           IF ( IIN2 .EQ. 0 ) THEN
             IF ( IIN1 .GT. 0 ) THEN
               XOUT = 90.D0
             ELSEIF ( IIN1 .LT. 0 ) THEN
               XOUT = -90
             ELSE
               INTERR(1)=IIN1
               CALL ERREUR(36)
             ENDIF
           ELSE
             XOUT=XVNOC*ATAN2(REAL(IIN1),REAL(IIN2))
           ENDIF
         ELSE
           XOUT=XVNOC*ATAN(REAL(IIN1))
         ENDIF
         GOTO 166
C
C     EXPONENTIELLE
 7       CONTINUE
         XOUT=EXP(REAL(IIN1))
         GOTO 166
C
C     LOGARITHME
 8       CONTINUE
         IF ( IIN1 .GT. 0) THEN
           XOUT=LOG(REAL(IIN1))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     VALEUR ABSOLUE
 9       CONTINUE
         IOUT=ABS(IIN1)
         RETURN
C
C     COSINUS HYPERBOLIQUE
 10      CONTINUE
         XOUT=COSH(REAL(IIN1))
         GOTO 166
C
C     SINUS HYPERBOLIQUE
 11      CONTINUE
         XOUT=SINH(REAL(IIN1))
         GOTO 166
C
C     TANGENTE HYPERBOLIQUE
 12      CONTINUE
         XOUT=TANH(REAL(IIN1))
         GOTO 166
C
C     FONCTION D'ERREUR ERF
 13      CONTINUE
         XOUT=ERF(REAL(IIN1))
         GOTO 166
C
C     ERFC (Complementaire de ERF --> 1-ERF(x) )
 14      CONTINUE
         XOUT=ERFC(REAL(IIN1))
         GOTO 166
C
C     ARGCH (Reciproque de COSINUS HYPERBOLIQUE)
 15      CONTINUE
         IF ( IIN1 .GE. 1  ) THEN
           XIN=REAL(IIN1)
           XOUT=LOG(XIN + SQRT(XIN*XIN-1.D0))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARGSH (Reciproque de   SINUS HYPERBOLIQUE)
 16      CONTINUE
         XIN=REAL(IIN1)
         XOUT=LOG(XIN + SQRT(XIN*XIN+1.D0))
         GOTO 166
C
C     ARGTH (Reciproque de TANGENTE HYPERBOLIQUE)
 17      CONTINUE
         XIN=REAL(IIN1)
         IF ( ABS(IIN1) .NE.  1 ) THEN
           XOUT=0.5D0 * LOG((1.D0+XIN)/(1.D0-XIN))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
 
C     'SIGN' (SIGN a un argument)
 18      CONTINUE
         IOUT=SIGN(1,IIN1)
         RETURN
C
C     '*' (Produit de 2 ENTIERS)
 19      CONTINUE
         IOUT = IIN1 * IIN2
         RETURN
C
C     '/' (Division de 2 ENTIERS)
 20      CONTINUE
         IF (IIN2 .EQ. 0) THEN
           GOTO 165
         ELSE
           IOUT = IIN1 / IIN2
           RETURN
         ENDIF
 
C     '**' (Puissance de 2 ENTIERS)
 21      CONTINUE
         IF ((IIN1 .EQ. 0) .AND. (IIN2.LT.0)) THEN
           GOTO 165
         ELSE
           IOUT = IIN1 ** IIN2
           RETURN
         ENDIF
 
C Arrivee ici en cas d'erreur sur le domaine de validite de l'operation
 165  CONTINUE
      INTERR(1)=IIN1
      CALL ERREUR(36)
      RETURN
 
C Arrivee ici apres avoir effectue l'operation
 166  CONTINUE
C     Verification que le resultat obtenu est bien un nombre (Pas Nan ni Inf)
      IF (.NOT. (ABS(XOUT) .LE. XGRAND)) THEN
        INTERR(1)=IIN1
        CALL ERREUR(36)
      ENDIF
      RETURN
      END