C===============================================================================
C RPL/2 (R) version 4.0.16
C Copyright (C) 1989-2010 Dr. BERTRAND Joël
C
C This file is part of RPL/2.
C
C RPL/2 is free software; you can redistribute it and/or modify it
C under the terms of the CeCILL V2 License as published by the french
C CEA, CNRS and INRIA.
C
C RPL/2 is distributed in the hope that it will be useful, but WITHOUT
C ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
C FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
C for more details.
C
C You should have received a copy of the CeCILL License
C along with RPL/2. If not, write to info@cecill.info.
C===============================================================================


C===============================================================================
C  Fonctions logarithmiques diverses
C===============================================================================

C-------------------------------------------------------------------------------
C  Logarithme naturel
C-------------------------------------------------------------------------------

      subroutine F77LNIP(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      integer*4		ERREUR

      integer*8		ARGUMENT

      real*8		RESULTAT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(dble(ARGUMENT))
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LNIN(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	RESULTAT

      integer*4		ERREUR

      integer*8		ARGUMENT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(dble(ARGUMENT) + (0,0))
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LNRP(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      integer*4		ERREUR

      real*8		ARGUMENT
      real*8		RESULTAT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(ARGUMENT)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LNRN(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	RESULTAT

      integer*4		ERREUR

      real*8		ARGUMENT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(ARGUMENT + (0,0))
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LNC(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      integer*4		ERREUR

      if (ARGUMENT.ne.0) then
          RESULTAT = log(ARGUMENT)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

C-------------------------------------------------------------------------------
C  Logarithme vulgaire
C-------------------------------------------------------------------------------

      subroutine F77LOGIP(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      integer*4		ERREUR

      integer*8		ARGUMENT

      real*8		RESULTAT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(dble(ARGUMENT)) / log(1D1)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LOGIN(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	RESULTAT

      integer*4		ERREUR

      integer*8		ARGUMENT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(dble(ARGUMENT) + (0,0)) / log(1D1)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LOGRP(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      integer*4		ERREUR

      real*8		ARGUMENT
      real*8		RESULTAT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(ARGUMENT) / log(1D1)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LOGRN(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	RESULTAT
      integer*4		ERREUR

      real*8		ARGUMENT

      if (ARGUMENT.ne.0) then
          RESULTAT = log(ARGUMENT + (0,0)) / log(1D1)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

      subroutine F77LOGC(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      integer*4		ERREUR

      if (ARGUMENT.ne.0) then
          RESULTAT = log(ARGUMENT) / log(1D1)
          ERREUR = 0
      else
          RESULTAT = 0
          ERREUR = -1
      end if
      return
      end

C-------------------------------------------------------------------------------
C  Sinus hyperbolique
C-------------------------------------------------------------------------------

      subroutine F77SINH(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = (exp(ARGUMENT) - exp(-ARGUMENT)) / 2
      return
      end

      subroutine F77ASINHC(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = log(ARGUMENT + sqrt((ARGUMENT ** 2) + 1))
      return
      end

      subroutine F77ASINHI(ARGUMENT, RESULTAT)

      implicit none

      integer*8		ARGUMENT
      real*8		RESULTAT

      RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) + 1))
      return
      end

      subroutine F77ASINHR(ARGUMENT, RESULTAT)

      implicit none

      real*8		ARGUMENT
      real*8		RESULTAT

      RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) + 1))
      return
      end

C-------------------------------------------------------------------------------
C  Cosinus hyperbolique
C-------------------------------------------------------------------------------

      subroutine F77COSH(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = (exp(ARGUMENT) + exp(-ARGUMENT)) / 2
      return
      end

      subroutine F77ACOSHC(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = log(ARGUMENT + sqrt((ARGUMENT ** 2) - 1))
      return
      end

      subroutine F77ACOSHI(ARGUMENT, RESULTAT)

      implicit none

      integer*8		ARGUMENT
      real*8		RESULTAT

      RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) - 1))
      return
      end

      subroutine F77ACOSHR(ARGUMENT, RESULTAT)

      implicit none

      real*8		ARGUMENT
      real*8		RESULTAT

      RESULTAT = log(ARGUMENT + sqrt((dble(ARGUMENT) ** 2) - 1))
      return
      end

C-------------------------------------------------------------------------------
C  Tangente hyperbolique
C-------------------------------------------------------------------------------

      subroutine F77TANH(ARGUMENT, RESULTAT, ERREUR)

      implicit none

      complex*16	ARGUMENT
      complex*16	COSINUSH
      complex*16	RESULTAT
      complex*16	SINUSH

      integer*4		ERREUR

      ERREUR = 0

      if (dimag(ARGUMENT).eq.0) then
          RESULTAT = dtan(dble(ARGUMENT))
      else
          call F77COSH(ARGUMENT, COSINUSH)

          if (COSINUSH.ne.0) then
              call F77SINH(ARGUMENT, SINUSH)
              RESULTAT = SINUSH / COSINUSH
          else
              RESULTAT = 0
              ERREUR = -1
          end if
      end if
      return
      end

      subroutine F77ATANHC(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = log((1 + ARGUMENT) / (1 - ARGUMENT)) / 2
      return
      end

      subroutine F77ATANHI(ARGUMENT, RESULTAT)

      implicit none

      integer*8		ARGUMENT
      real*8		RESULTAT

      RESULTAT = log((1 + dble(ARGUMENT)) / (1 - dble(ARGUMENT))) / 2
      return
      end

      subroutine F77ATANHR(ARGUMENT, RESULTAT)

      implicit none

      real*8		ARGUMENT
      real*8		RESULTAT

      RESULTAT = log((1 + ARGUMENT) / (1 - ARGUMENT)) / 2
      return
      end

C-------------------------------------------------------------------------------
C  Exponentielle complexe
C-------------------------------------------------------------------------------

      subroutine F77EXPC(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = exp(ARGUMENT)
      return
      end

C-------------------------------------------------------------------------------
C  Alog complexe
C-------------------------------------------------------------------------------

      subroutine F77ALOGC(ARGUMENT, RESULTAT)

      implicit none

      complex*16	ARGUMENT
      complex*16	RESULTAT

      RESULTAT = 10 ** ARGUMENT
      return
      end