wrdlen.F

Go to the documentation of this file.

C> @file
C> @brief Determine important information about the local machine.
C>
C> @author J. Woollen @author J. Ator @date 1994-01-06
 
C> Determine important information about the local machine.
C>
C> This subroutine figures out some important information about the
C> local machine on which the NCEPLIBS-bufr software is being run,
C> including the native endianness and the number of bytes in an integer.
C>
C> This subroutine isn't normally called directly by any
C> application program, because it's automatically called internally
C> from within subroutine openbf() during the first time that subroutine
C> is called by any application program.  It's also called as needed
C> from within several other subroutines, but it always keeps track of
C> its results as well as whether it has already been called during
C> the life of an application program, and that way if it does end
C> up being called more than once, it will just quietly return without
C> having to recompute all of its results from the first call.
C>
C> @author J. Woollen @author J. Ator @date 1994-01-06
 
      SUBROUTINE wrdlen
 
      COMMON /hrdwrd/ nbytw,nbitw,iord(8)
      COMMON /quiet / iprt
 
      CHARACTER*128 BORT_STR,ERRSTR
      CHARACTER*8   CINT,DINT,CVSTR
      CHARACTER*6   CNDIAN
      equivalence(cint,int)
      equivalence(dint,jnt)
      LOGICAL       PRINT
 
      DATA ifirst/0/
 
      SAVE ifirst
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C     HAS THIS SUBROUTINE ALREADY BEEN CALLED?
 
      IF(ifirst.EQ.0) THEN
 
C        NO, SO CHECK WHETHER DIAGNOSTIC INFORMATION SHOULD BE PRINTED
C        AND THEN PROCEED THROUGH THE REST OF THE SUBROUTINE.
 
         print = iprt.GE.1
         ifirst = 1
      ELSE
 
C        YES, SO THERE IS NO NEED TO PROCEED ANY FURTHER.
 
         RETURN
      ENDIF
 
C  COUNT THE BITS IN A WORD - MAX 64 ALLOWED
C  -----------------------------------------
 
      int = 1
      DO i=1,65
      int = ishft(int,1)
      IF(int.EQ.0) GOTO 10
      ENDDO
   10 IF(i.GE.65)       GOTO 900
      IF(mod(i,8).NE.0) GOTO 901
 
C  NBITW is no. of bits in a word, NBYTW is no. of bytes in a word
C  ---------------------------------------------------------------
 
      nbitw = i
      nbytw = i/8
 
C  INDEX THE BYTE STORAGE ORDER -  HIGH BYTE TO LOW BYTE
C  -----------------------------------------------------
 
      jnt = 0
 
      DO i = 1,8
         iord(i) = 9999
      ENDDO
 
      DO i=1,nbytw
         int = ishft(1,(nbytw-i)*8)
         DO j=1,nbytw
            IF(cint(j:j).NE.dint(j:j)) GOTO 20
         ENDDO
c  .... DK: Can the below ever happen since upper loop bounds is NBYTW?
   20    IF(j.GT.nbytw) GOTO 902
         iord(i) = j
      ENDDO
 
C  SHOW SOME RESULTS
C  -----------------
 
      IF(print) THEN
         CALL bvers(cvstr)
#ifdef BIG_ENDIAN
         cndian = '  BIG '
#else
         cndian = 'LITTLE'
#endif
      errstr = '=============== ' //
     . 'WELCOME TO THE BUFR ARCHIVE LIBRARY' // ' =============='
      CALL errwrt(errstr)
      WRITE (  unit=errstr, fmt='(A,I2)' )
     . ' MACHINE CHARACTERISTICS: NUMBER OF BYTES PER WORD =', nbytw
      CALL errwrt(errstr)
      WRITE (  unit=errstr, fmt='(A,I3)' )
     . '                          NUMBER OF BITS PER WORD =', nbitw
      CALL errwrt(errstr)
      errstr = '                          BYTE ORDER IS ' // cndian //
     .  ' ENDIAN'
      CALL errwrt(errstr)
      CALL errwrt(errstr)
      errstr = '====================== VERSION: ' // cvstr //
     .  '=========================='
      CALL errwrt(errstr)
      CALL errwrt(' ')
      ENDIF
 
C  EXITS
C  -----
 
      RETURN
  900 WRITE(bort_str,'("BUFRLIB: WRDLEN - MACHINE WORD LENGTH IS '//
     . 'LIMITED TO 64 BITS (THIS MACHINE APPARENTLY HAS",I4," BIT '//
     . 'WORDS!)")') i
      CALL bort(bort_str)
  901 WRITE(bort_str,'("BUFRLIB: WRDLEN - MACHINE WORD LENGTH (",I4,"'//
     . ') IS NOT A MULTIPLE OF 8 (THIS MACHINE HAS WORDS NOT ON WHOLE'//
     . ' BYTE BOUNDARIES!)")') i
      CALL bort(bort_str)
  902 WRITE(bort_str,'("BUFRLIB: WRDLEN - BYTE ORDER CHECKING MISTAKE'//
     . .GT.', LOOP INDEX J (HERE =",I3,") IS  NO. OF BYTES PER WORD '//
     . 'ON THIS MACHINE (",I3,")")') j,nbytw
      CALL bort(bort_str)
      END