double_to_integer.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\double_to_integer.f
00002 !
00056                      SUBROUTINE DOUBLE_TO_INTEGER
00057 !                    ****************************
00058 !
00059      &(X,IX,N,QT,NSUM)
00060 !
00061 !***********************************************************************
00062 ! BIEF   V7P0                                   13/01/2014
00063 !***********************************************************************
00064 !
00065 !
00066 !
00067 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00068 !| IX             |<--| INTEGER ARRAY CODING THE REAL ARRAY
00069 !| N              |-->| NUMBER OF POINTS IN THE ARRAYS X AND IX
00070 !| NSUM           |-->| MAXIMUM NUMBER OF SUMS THAT WILL BE POSSIBLE
00071 !| QT             |<--| THE QUANTUM USED FOR CODING
00072 !| X              |-->| DOUBLE PRECISION ARRAY TO BE CODED
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !
00075       USE DECLARATIONS_SPECIAL
00076       USE INTERFACE_PARALLEL
00077       USE BIEF, EX_DOUBLE_TO_INTEGER => DOUBLE_TO_INTEGER
00078 !
00079       IMPLICIT NONE
00080       INTEGER LNG,LU
00081       COMMON/INFO/LNG,LU
00082 !
00083 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00084 !
00085       INTEGER         , INTENT(IN)    :: N,NSUM
00086       INTEGER(KIND=K8), INTENT(INOUT) :: IX(N)
00087       DOUBLE PRECISION, INTENT(IN)    :: X(N)
00088       DOUBLE PRECISION, INTENT(INOUT) :: QT
00089 !
00090 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00091 !
00092       INTEGER I
00093       INTEGER(KIND=K8) IMAX
00094       DOUBLE PRECISION XMIN,XMAX,SURQT
00095 !
00096       INTRINSIC NINT,MAX,ABS
00097 !
00098 !-----------------------------------------------------------------------
00099 !
00100       CALL MINI(XMIN,I,X,N)
00101       CALL MAXI(XMAX,I,X,N)
00102 !
00103       IF(NCSIZE.GT.1) THEN
00104         XMIN=P_DMIN(XMIN)
00105         XMAX=P_DMAX(XMAX)
00106       ENDIF
00107 !
00108 !     WE WANT A RANGE CENTRED ON 0, THAT CONTAINS [XMIN,XMAX]
00109 !
00110       XMAX=MAX(ABS(XMIN),ABS(XMAX))
00111       IMAX=HUGE(IMAX)/NSUM
00112 !
00113       QT=XMAX/IMAX
00114 !
00115       IF(QT.EQ.0.D0) THEN
00116         SURQT=0.D0
00117       ELSE
00118         SURQT=1.D0/QT
00119       ENDIF
00120 !
00121 !-----------------------------------------------------------------------
00122 !     CODING
00123 !-----------------------------------------------------------------------
00124 !
00125       DO I=1,N
00126         IX(I)=NINT(X(I)*SURQT,KIND=K8)
00127       ENDDO
00128 !
00129 !-----------------------------------------------------------------------
00130 !
00131       RETURN
00132       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0