integer_to_double.f

Go to the documentation of this file.

!                   ****************************
                    SUBROUTINE integer_to_double
!                   ****************************
!
     &(op,ix,x,n,qt)
!
!***********************************************************************
! BIEF   V7P0                                   13/01/2014
!***********************************************************************
!
!brief    Retrieving a double precision array from an I8 integer.
!
!warning  See also double_to_integer.
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        13/01/2014
!+        V7P0
!+   First version.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IX             |-->| INTEGER ARRAY CODING THE REAL ARRAY
!| N              |-->| NUMBER OF POINTS IN THE ARRAYS X AND IX
!| OP             |-->| IF '=', X REINITIALISED, IF '+' ADDITION TO X
!| QT             |-->| THE QUANTUM USED FOR CODING
!| X              |<--| DOUBLE PRECISION ARRAY TO BE CODED
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_integer_to_double => integer_to_double
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER         , INTENT(IN)    :: N
      INTEGER(KIND=K8), INTENT(IN)    :: IX(n)
      DOUBLE PRECISION, INTENT(IN)    :: QT
      DOUBLE PRECISION, INTENT(INOUT) :: X(n)
      CHARACTER(LEN=1), INTENT(IN)    :: OP
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I
!
!-----------------------------------------------------------------------
!     RETRIEVING THE DOUBLE PRECISION VALUE
!-----------------------------------------------------------------------
!
      IF(op.EQ.'=') THEN
        DO i=1,n
          x(i)=dble(ix(i))*qt
        ENDDO
      ELSEIF(op.EQ.'+') THEN
        DO i=1,n
          x(i)=x(i)+dble(ix(i))*qt
        ENDDO
      ELSE
        WRITE(lu,*) 'INTEGER_TO_DOUBLE: OPERATION ',op,' UNKNOWN'
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END