prtbin_mf.F

Go to the documentation of this file.

      SUBROUTINE prtbin_mf (KIN,KNBIT,KOUT,KERR)
      USE parkind1, ONLY : jprb
      USE yomhook , ONLY : lhook, dr_hook
      USE lfi_precision
!
!**** PRTBIN - Binary to decimal conversion.
!
!     Purpose.
!     --------
!
!           Produces a decimal number with ones and zeroes
!           corresponding to the ones and zeroes of the input
!           binary number.
!           eg input number 1011 binary, output number 1011 decimal.
!
!**   Interface.
!     ----------
!
!           CALL PRTBIN_MF (KIN,KNBIT,KOUT,KERR)
!
!           Integer    K.
!           Real       P.
!           Logical    O.
!           Character  H.
!
!               Input Parameters.
!               -----------------
!
!               KIN   - Integer variable containing binary number.
!
!               KNBIT - Number of bits in binary number.
!
!               Output Parameters.
!               -----------------
!
!               KOUT  - Integer variable containing decimal value
!                       with ones and zeroes corresponding to those of
!                       the input binary number.
!
!               KERR  - 0, If no error.
!                       1, Number of bits in binary number exceeds
!                          maximum allowed.
!
!     Method.
!     -------
!
!           Masking expression used is not ANSI standard.
!
!     Externals.
!     ----------
!
!           None.
!
!     Reference.
!     ----------
!
!           None.
!
!     Comments.
!     ---------
!
!           Routine contains sections 0, 1 and section 9.
!
!     Author.
!     -------
!
!           John Hennessy     ECMWF  October 1985
!
!     Modifications.
!     --------------
!
!           John Hennessy     ECMWF  March 1991
!           Made to conform to current programming standards.
!
!     ---------------------------------------------------------------
!
!
      IMPLICIT NONE
!
      INTEGER (KIND=JPLIKM) :: KIN
      INTEGER (KIND=JPLIKM) :: KNBIT
      INTEGER (KIND=JPLIKM) :: KOUT
      INTEGER (KIND=JPLIKM) :: KERR
!
      INTEGER (KIND=JPLIKM) :: J101, IK, IMASC, ITEMP
!
!
!
!
!
!
!
!
!*    Section 0. Definition of variables. Check on parameters.
!     -----------------------------------------------------------------
!
!     Check length of binary number.
!
      REAL(KIND=JPRB) :: ZHOOK_HANDLE
      IF (lhook) CALL dr_hook('PRTBIN_MF',0,zhook_handle)
      IF (knbit.LT.0.OR.knbit.GT.15)                                    &
     &   THEN
             kerr = 1
             WRITE (*,9000) knbit
             GO TO 900
         ELSE
             kerr = 0
         ENDIF
!
!     -----------------------------------------------------------------
!
!
!
!
!
!
!
!
!
!
!*    Section 1. Generate required number.
!     -----------------------------------------------------------------
!
  100 CONTINUE
!
      kout = 0
!
      DO 101 j101=1,knbit
         ik    = j101 - 1
         imasc = 2**ik
         itemp = iand(kin,imasc)
         IF (itemp.NE.0) kout = kout + 10**ik
  101 CONTINUE
!
!     -----------------------------------------------------------------
!
!
!
!
!
!
!
!
!
!
!*    Section 9. Format statements. Return to calling routine.
!     -----------------------------------------------------------------
!
  900 CONTINUE
!
 9000 FORMAT (1h ,'PRTBIN : Binary number too long - ',i3,' bits.')
!
      IF (lhook) CALL dr_hook('PRTBIN_MF',1,zhook_handle)
      ENDSUBROUTINE prtbin_mf