Sources Esope | Cast3M

C OPFLOT    SOURCE    CB215821  16/11/28    21:15:16     9202           
      SUBROUTINE OPFLOT(XIN1,XIN2,IIN1,BATAN2,IEPS,XOUT)
 
C=======================================================================
C      EFFECTUE DIVERSES OPERATIONS SUR LES FLOTTANTS
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     IEPS= 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 COTANGENTE (inverse de la tangente)
 
C         =19 PRODUIT   XIN1 *  XIN2
C         =20 DIVISION  XIN1 /  XIN2
C         =21 PUISSANCE XIN1 ** XIN2
C         =22 PUISSANCE XIN1 ** IIN1
 
C  SORTIES
C     XOUT=FLOTTANT RESULTAT
C
C
C     CODE C. BERTHINIER 2014
C
C=======================================================================
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      LOGICAL  BATAN2
      INTEGER  IEPS,IIN1
      REAL*8   XIN1,XIN2,XOUT,XCONV,XVNOC
 
-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),(IEPS-5)
C
C     COSINUS
 1       CONTINUE
         XCONV = XPI / 180.
         XOUT=COS(XCONV*XIN1)
         GOTO 166
C
C     SINUS
 2       CONTINUE
         XCONV = XPI / 180.
         XOUT=SIN(XCONV*XIN1)
         GOTO 166
C
C     TANGENTE
 3       CONTINUE
         XCONV = XPI / 180.
         XOUT=TAN(XCONV*XIN1)
         GOTO 166
C
C     ARCOSINUS
 4       CONTINUE
         XVNOC = 180. / XPI
         IF ( (XIN1 .GE. -1.) .AND. (XIN1 .LE. 1.)) THEN
           XOUT=XVNOC*ACOS(XIN1)
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARCSINUS
 5       CONTINUE
         XVNOC = 180. / XPI
         IF ( (XIN1 .GE. -1.) .AND. (XIN1 .LE. 1.)) THEN
           XOUT=XVNOC*ASIN(XIN1)
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C     ARCTANGENTE
 6       CONTINUE
         XVNOC = 180. / XPI
         IF (BATAN2 .EQV. .TRUE.) THEN
           IF ( XIN2 .EQ. 0. ) THEN
             IF ( XIN1 .GT. 0. ) THEN
               XOUT = 90.
             ELSEIF ( XIN1 .LT. 0. ) THEN
               XOUT = -90.
             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.  ) THEN
           XOUT=LOG(XIN1 + SQRT(XIN1*XIN1-1.))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C         ARGSH (Reciproque de   SINUS HYPERBOLIQUE)
 16      CONTINUE
         XOUT=LOG(XIN1 + SQRT(XIN1*XIN1+1.))
         GOTO 166
C
C         ARGTH (Reciproque de TANGENTE HYPERBOLIQUE)
 17      CONTINUE
         IF ( (ABS(XIN1) .NE.  1.) ) THEN
           XOUT=0.5 * LOG((1.+XIN1)/(1.-XIN1))
         ELSE
           GOTO 165
         ENDIF
         GOTO 166
C
C         COTG (Cotangente -> COS / SIN)
 18      CONTINUE
         MOTERR='COTG'
         CALL ERREUR(9)
         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)
 
C Arrivee ici apres avoir effectue l'operation
 166     CONTINUE
C        Verification que le resultat obtenu est bien un
C        nombre (Pas Nan ni Inf)
         IF (ABS(XOUT) .LE. XGRAND) THEN
           GOTO 167
         ELSE
           REAERR(1)=XOUT
           CALL ERREUR(1009)
           GOTO 167
         ENDIF
 
 
C Sortie du SOUS-PROGRAMME
 167  CONTINUE
      RETURN
 
      END