      SUBROUTINE FACDEC (KREP, PA, PMIN, KNBIT, KDEC)
!****
!      Sous-programme de calcul du FACteur d'echelle DECimal optimal
!     pour coder un champ d'amplitude PA donnee, sur KNBIT bits avec
!     une precision maximale, compte tenu d'un intervalle fixe
!     de facteurs decimaux.
!**
!    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
!                                    0: OK; -1: pb rencontre
!                PA     (Entree) ==> Amplitude du champ a compacter;
!                PMIN   (Entree) ==> Minimum du champ a compacter;
!                KNBIT  (Entree) ==> Nb de bits servant au compactage;
!                KDEC   (Sortie) ==> Facteur d'echelle decimal optimal;
!
!     Modifications:
!
      IMPLICIT NONE
#include "precision.h"
#include "facomp.h"
#include "facom1.h"
      REAL (KIND=JPDBLR) PA, PMIN
      INTEGER KREP, KNBIT, KDEC
!
      REAL (KIND=JPDBLR) XNBINT, XTINYR4, XHUGER4
      INTEGER IDECMIN, IDECMAX, INBINT
      INTEGER JDEC, IE, INUTIL, INUMAX, IEMAX
      INTEGER INU0, IE0
!
!**
!     1.  -  CONTROLES ET INITIALISATIONS.
!-----------------------------------------------------------------------
!
      IF (KNBIT.LE.0 .OR. KNBIT.GT.64) THEN
        KREP=-1
        PRINT *,'****'
        PRINT *,'**** FACDEC: ERROR, bits number out of range 1-64'
        PRINT *,'****         KNBIT = ',KNBIT
        PRINT *,'**** ! Optimal decimal scale factor is not computed !'
        PRINT *,'****'
        RETURN
      ENDIF
      IF (ABS(PA) .LT. TINY(PA)) THEN
        KREP = 0
        KDEC = 0
        IF (LFAMOP) THEN
          PRINT *,'////'
          PRINT *,'//// FACDEC: WARNING, range of the field is null :',
     S                        PA
          PRINT *,'////'
        ENDIF
        RETURN
      ENDIF
      KREP    = 0
      INUMAX  = 0
      IDECMIN = -15
      IDECMAX =   5
      XTINYR4 = TINY(1._4)
      XHUGER4 = HUGE(1._4)
      INBINT  = 2**KNBIT -1
      XNBINT  = FLOAT(INBINT)
! Cas du facteur decimal nul (reference a calculer dans tous les cas)
      JDEC    = 0
      CALL FACTEC(KREP, PA, KNBIT, JDEC, IE0, INU0)
      
!
!**
!     2.  -  BOUCLE TESTANT LES FACTEURS DECIMAUX
!-----------------------------------------------------------------------
!
!!OCL SCALAR
      DO JDEC = IDECMIN, IDECMAX
!
! 3 tests sur la pertinence de ce facteur decimal
!
! 0/ PA * 10**JDEC > 1.E-12
!    Du fait d'un test exagere dans gribex 
!       IF (PA * 10._JPDBLR**JDEC .LE. 1.E-12) CYCLE
! 1/ PMIN * 10**JDEC > TINY(real*4) pour decodage eventuel
!    de la valeur de reference en arithmetique 32 bits IEEE.
        IF (ABS(PMIN) .GT. TINY(PMIN)) THEN
          IF (LOG10(ABS(PMIN))+JDEC .LE. LOG10( XTINYR4 ) ) CYCLE
        ELSE
!  instruction "bidon" pour que l'optimisation ne fasse pas
!  l'evaluation de LOG10(ABS(PMIN)) par anticipation (Pb sur VPP5000)
          PMIN = 0._JPDBLR
        ENDIF
! 2/ PA * 10**JDEC inclus dans le domaine de validite des real*8
        IF (ABS(LOG10(ABS(PA))+JDEC) .GE. RANGE(PA)) CYCLE
!
        CALL FACTEC(KREP, PA, KNBIT, JDEC, IE, INUTIL)
        IF (KREP.NE.0) CYCLE
! 3/ PMIN*10**JDEC + (2**KNBIT-1)*2**IE < HUGE(real*4) pour decodage
!    eventuel du max du champ en arithmetique 32 bits IEEE.
        IF (PMIN*10._JPDBLR**JDEC + XNBINT*2._JPDBLR**IE .GE. 
     S                          XHUGER4) CYCLE
! 4/ Le facteur d'echelle binaire doit pouvoir etre code sur 1 octet,
!    il doit donc etre compris entre -126 et 127:
        IF (IE.LT.-126 .OR. IE.GT.127) CYCLE
!
        IF (INUTIL.GT.INUMAX) THEN
          INUMAX = INUTIL
          IEMAX  = IE
          KDEC   = JDEC
        ENDIF
      ENDDO
!
      IF (INUMAX.EQ.0) THEN
        KREP=-1
        PRINT *,'****'
        PRINT *,'**** FACDEC: all the decimal factors comprised between'
        PRINT *,'**** ',IDECMIN,' and ',IDECMAX,' are rejected !!'
        PRINT *,'**** Range and min of the field are :', PA, PMIN
        PRINT *,'****'
        PRINT *,'****'
        RETURN
      ENDIF
      IF (LFAMOP) THEN
        PRINT *,'FACDEC: champ d''amplitude ',PA,' ,de minimum ',PMIN
        PRINT *,'        => fact decimal opt de',KDEC,
     S          ' ,pour 1 fact binaire de ',IEMAX
        PRINT '(1X,A,I3,A,I9,A,I9,A,F5.1,A,E11.4)',' Eff des',
     S         KNBIT,' bits = ',INUMAX,' sur ',INBINT,' soit: ',
     S         FLOAT(INUMAX)*100./XNBINT,' % et une precision de ',
     S         10.**(-KDEC)*2.**(IEMAX-1)
        PRINT *,'        a comparer, si le fact decimal = 0, avec'
        PRINT '(1X,A,I9,A,I9,A,F5.1,A,E11.4)',' une efficacite de ',
     S          INU0,' sur ',INBINT,' soit: ',FLOAT(INU0)*100./XNBINT,
     S          ' % et une precision de ',2.**(IE0-1)
      ENDIF
!
      RETURN
      END
