Sources Esope | Cast3M

C OPFLOT    SOURCE    GOUNAND   19/07/23    21:15:16     10267          
      SUBROUTINE OPFLOT(XIN1,XIN2,IIN1,BATAN2,IOPERA,XOUT)
C=======================================================================
C      EFFECTUE DIVERSES OPERATIONS SUR LES FLOTTANTS
C=======================================================================
C  ENTREES
C     XIN1= FLOTTANT sur lequel on effectue l'operation
C     XIN2= deuxieme argument FLOTTANT pour l'operation ATAN2
C     IIN1= troisieme argument ENTIER pour l'operation FLOTTANT ** ENTIER
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,XIN1)
C
C           = 19 PRODUIT   XIN1 *  XIN2
C           = 20 DIVISION  XIN1 /  XIN2
C           = 21 PUISSANCE XIN1 ** XIN2
C           = 22 PUISSANCE XIN1 ** IIN1
C
C  SORTIES
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
      REAL*8   XIN1,XIN2,XOUT,XCONV,XVNOC
      PARAMETER (UN   = 1.D0)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
C
 
      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,22),(IOPERA-5)
C
C     COSINUS
 1       CONTINUE
         XCONV = XPI / 180.D0
         XOUT=COS(XCONV*XIN1)
         GOTO 166
C
C     SINUS
 2       CONTINUE
         XCONV = XPI / 180.D0
         XOUT=SIN(XCONV*XIN1)
         GOTO 166
C
C     TANGENTE
 3       CONTINUE
         XCONV = XPI / 180.D0
         XOUT=TAN(XCONV*XIN1)
         GOTO 166
C
C     ARCOSINUS
 4       CONTINUE
         XVNOC = 180.D0 / XPI
         IF ( (XIN1 .GE. -1.D0) .AND. (XIN1 .LE. 1.D0)) THEN
           XOUT=XVNOC*ACOS(XIN1)
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARCSINUS
 5       CONTINUE
         XVNOC = 180.D0 / XPI
         IF ( (XIN1 .GE. -1.D0) .AND. (XIN1 .LE. 1.D0)) THEN
           XOUT=XVNOC*ASIN(XIN1)
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARCTANGENTE
 6       CONTINUE
         XVNOC = 180.D0 / XPI
         IF (BATAN2 .EQV. .TRUE.) THEN
           IF ( XIN2 .EQ. 0.D0 ) THEN
             IF ( XIN1 .GT. 0.D0 ) THEN
               XOUT = 90.D0
             ELSEIF ( XIN1 .LT. 0.D0 ) THEN
               XOUT = -90.D0
             ELSE
               REAERR(1)=XIN1
               CALL ERREUR(1009)
             ENDIF
           ELSE
             XOUT=XVNOC*ATAN2(XIN1,XIN2)
           ENDIF
         ELSE
           XOUT=XVNOC*ATAN(XIN1)
         ENDIF
         GOTO 166
C
C     EXPONENTIELLE
 7       CONTINUE
         XOUT=EXP(XIN1)
         GOTO 166
C
C     LOGARITHME
 8       CONTINUE
         IF ( XIN1 .GE. XPETIT) THEN
           XOUT=LOG(XIN1)
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     VALEUR ABSOLUE
 9       CONTINUE
         XOUT=ABS(XIN1)
         GOTO 166
C
C     COSINUS HYPERBOLIQUE
 10      CONTINUE
         XOUT=COSH(XIN1)
         GOTO 166
C
C     SINUS HYPERBOLIQUE
 11      CONTINUE
         XOUT=SINH(XIN1)
         GOTO 166
C
C     TANGENTE HYPERBOLIQUE
 12      CONTINUE
         XOUT=TANH(XIN1)
         GOTO 166
C
C     FONCTION D'ERREUR ERF
 13      CONTINUE
         XOUT=ERF(XIN1)
         GOTO 166
C
C         ERFC (Complementaire de ERF --> 1-ERF(x) )
 14      CONTINUE
         XOUT=ERFC(XIN1)
         GOTO 166
C
C         ARGCH (Reciproque de COSINUS HYPERBOLIQUE)
 15      CONTINUE
         IF ( XIN1 .GE. 1.D0  ) THEN
           XOUT=LOG(XIN1 + SQRT(XIN1*XIN1-1.D0))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C         ARGSH (Reciproque de   SINUS HYPERBOLIQUE)
 16      CONTINUE
         XOUT=LOG(XIN1 + SQRT(XIN1*XIN1+1.D0))
         GOTO 166
C
C         ARGTH (Reciproque de TANGENTE HYPERBOLIQUE)
 17      CONTINUE
         IF ( (ABS(XIN1) .NE.  1.D0) ) THEN
           XOUT=0.5D0 * LOG((1.D0+XIN1)/(1.D0-XIN1))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C        SIGN
 18      CONTINUE
         XOUT = SIGN(UN,XIN1)
         GOTO 166
C
C         '*' (Produit    de 2 FLOTTANTS)
 19      CONTINUE
         XOUT = XIN1 * XIN2
         GOTO 166
C
C         '/' (Division   de 2 FLOTTANTS)
 20      CONTINUE
         XOUT = XIN1 / XIN2
         GOTO 166
C
C         '**' (Puissance de 2 FLOTTANTS)
 21      CONTINUE
         XOUT = XIN1 ** XIN2
         GOTO 166
C
C         '**' (Puissance de FLOTTANT ** ENTIER)
 22      CONTINUE
         XOUT = XIN1 ** IIN1
         GOTO 166
 
 
C Arrivee ici en cas d'erreur sur le domaine de validite de l'operation
 165     CONTINUE
         REAERR(1)=XIN1
         CALL ERREUR(1009)
         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
        REAERR(1)=XIN1
        CALL ERREUR(1009)
      ENDIF
      RETURN
      END