GET_BITS.f

Go to the documentation of this file.

 
!-----------------------------------------------------------------------
      SUBROUTINE get_bits(IBM,SGDS,LEN,MG,G,ISCALE,GROUND,           &
                          GMIN,GMAX,NBIT)
 
!
      implicit none
!
      REal,DIMENSION(LEN),intent(in):: G
      real,DIMENSION(LEN),intent(inout) ::  GROUND
      integer,DIMENSION(LEN),intent(in):: MG
      integer,intent(in) :: IBM,LEN
      integer,intent(inout) :: ISCALE,NBIT
      real,intent(out) :: GMAX,GMIN
      integer I1,I,IRETT
      real SGDS
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  DETERMINE EXTREMES WHERE BITMAP IS ON
!
      IF(ibm==0) THEN
        gmax=g(1)
        gmin=g(1)
        DO i=2,len
          gmax=max(gmax,g(i))
          gmin=min(gmin,g(i))
        ENDDO
      ELSE
        i1=0
        DO i=1,len
          IF(mg(i)/=0.AND.i1==0) i1=i
        ENDDO
        IF(i1>0.AND.i1<=len) THEN
          gmax=g(i1)
          gmin=g(i1)
          DO i=i1+1,len
            IF(mg(i)/=0) THEN
              gmax=max(gmax,g(i))
              gmin=min(gmin,g(i))
            ENDIF
          ENDDO
        ELSE
          gmax=0.
          gmin=0.
        ENDIF
      ENDIF
!
!
!
      CALL fndbit  ( gmin, gmax, sgds, nbit, iscale, irett)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      RETURN
      END
 
    SUBROUTINE fndbit  ( rmin, rmax, rdb, nmbts, iscale, iret )
    implicit none
!
    integer,intent(inout) ::  iscale,nmbts
    real,intent(inout)    ::  rmin,rmax,rdb
    real                  ::  range,rr,rng2,po,rln2
    integer               ::  iret,icnt,ipo,le,ibin
!    
    DATA        rln2/0.69314718/
!-----------------------------------------------------------------------
    iret = 0
    icnt = 0
    iscale = 0
    range = rmax - rmin
    IF ( range <= 0.00 ) THEN
        nmbts = 8
        RETURN
    END IF
!*
    IF ( rdb == 0.0 ) THEN
        nmbts = 8
        RETURN
    ELSE IF ( rdb > 0.0 ) THEN
        ipo = int(alog10( range ))
        IF ( range < 1.00 ) ipo = ipo - 1
        po = float(ipo) - rdb + 1.
        iscale = - int( po )
        rr = range * 10. ** ( -po )
        nmbts = int( alog( rr ) / rln2 ) + 1
    ELSE
        ibin = nint( -rdb )
        rng2 = range * 2. ** ibin
        nmbts = int( alog( rng2 ) / rln2 ) + 1
    END IF
!*
        IF(nmbts<=0) THEN
          nmbts=0
          IF(abs(rmin)>=1.) THEN
            iscale=-int(alog10(abs(rmin)))
          ELSE IF (abs(rmin)<1.0.AND.abs(rmin)>0.0) THEN
            iscale=-int(alog10(abs(rmin)))+1
          ELSE
            iscale=0
          ENDIF
        ENDIF
    RETURN
    END