/* Copyright (C) 1991-2012 Free Software Foundation, Inc.
   This file is part of the GNU C Library.

   The GNU C Library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.

   The GNU C Library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with the GNU C Library; if not, see
   <http://www.gnu.org/licenses/>.  */


/* This header is separate from features.h so that the compiler can
   include it implicitly at the start of every compilation.  It must
   not itself include <features.h> or any other header that includes
   <features.h> because the implicit include comes before any feature
   test macros that may be defined in a source file before it first
   explicitly includes a system header.  GCC knows the name of this
   header in order to preinclude it.  */

/* We do support the IEC 559 math functionality, real and complex.  */

/* wchar_t uses ISO/IEC 10646 (2nd ed., published 2011-03-15) /
   Unicode 6.0.  */

/* We do not support C11 <threads.h>.  */

      SUBROUTINE WRDLEN

C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM:    WRDLEN
C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE FIGURES OUT SOME IMPORTANT INFORMATION
C   ABOUT THE LOCAL MACHINE ON WHICH THE BUFR ARCHIVE LIBRARY SOFTWARE
C   IS BEING RUN AND STORES THIS INTO COMMON BLOCK /HRDWRD/.  SUCH
C   INFORMATION INCLUDES DETERMINING THE NUMBER OF BITS AND THE NUMBER
C   OF BYTES IN A MACHINE WORD AS WELL AS DETERMINING WHETHER THE
C   MACHINE USES THE ASCII OR EBCDIC CHARACTER SET.
C
C   NOTE: IT IS ONLY NECESSARY FOR THIS SUBROUTINE TO BE CALLED ONCE,
C   AND THIS IS NORMALLY DONE DURING THE FIRST CALL TO BUFR ARCHIVE
C   LIBRARY SUBROUTINE OPENBF.  HOWEVER, THE SUBROUTINE DOES KEEP TRACK
C   OF WHETHER IT HAS ALREADY BEEN CALLED; THUS, IF IT IS CALLED AGAIN
C   LATER BY A DIFFERENT BUFR ARCHIVE LIBRARY SUBROUTINE, IT WILL JUST
C   QUIETLY RETURN WITHOUT (RE)COMPUTING ALL OF THE INFORMATION WITHIN
C   COMMON BLOCK /HRDWRD/.
C
C PROGRAM HISTORY LOG:
C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C                           ROUTINE "BORT"
C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C                           INTERDEPENDENCIES
C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C                           ABNORMALLY OR FOR INFORMATIONAL PURPOSES;
C                           NBYTW INITIALIZED AS ZERO THE FIRST TIME
C                           THIS ROUTINE IS CALLED (BEFORE WAS
C                           UNDEFINED WHEN FIRST REFERENCED)
C 2004-08-18  J. ATOR    -- ADDED SAVE FOR IFIRST FLAG AND IMMEDIATE
C                           RETURN IF IFIRST=1
C 2007-01-19  J. ATOR    -- BIG-ENDIAN VS. LITTLE-ENDIAN IS NOW
C                           DETERMINED AT COMPILE TIME AND CONFIGURED
C                           WITHIN BUFRLIB VIA CONDITIONAL COMPILATION
C                           DIRECTIVES
C 2009-03-23  J. ATOR    -- CALL BVERS TO GET VERSION NUMBER
C
C USAGE:    CALL WRDLEN
C
C REMARKS:
C    THIS ROUTINE CALLS:        BORT     BVERS    ERRWRT   IUPM
C    THIS ROUTINE IS CALLED BY: COBFL    COPYBF   DATEBF   DATELEN
C                               DUMPBF   IUPBS01  MESGBC   MESGBF
C                               OPENBF   RDMTBB   UPDS3
C                               Normally not called by any application
C                               programs.
C
C ATTRIBUTES:
C   LANGUAGE: FORTRAN 77
C   MACHINE:  PORTABLE TO ALL PLATFORMS
C
C$$$

      COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
      COMMON /CHARAC/ IASCII,IATOE(0:255),IETOA(0:255)
      COMMON /QUIET / IPRT

      CHARACTER*128 BORT_STR,ERRSTR
      CHARACTER*8   CINT,DINT,CVSTR
      CHARACTER*6   CNDIAN,CLANG
      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
c  .... DK: Can the below ever happen since upper loop bounds is 65?
   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  SETUP AN ASCII/EBCDIC TRANSLATOR AND DETERMINE WHICH IS NATIVE
C  --------------------------------------------------------------

!      IA = IUPM('A',8)
      IA = IUPM('A       ',8)
      IF(IA.EQ. 65) THEN
         IASCII = 1
         CLANG  = 'ASCII '
      ELSEIF(IA.EQ.193) THEN
         IASCII = 0
         CLANG  = 'EBCDIC'
      ELSE
         GOTO 903
      ENDIF

      DO I=0,255
      IETOA(I) = 0
      IATOE(I) = 0
      ENDDO

      IETOA(  1) =   1
      IATOE(  1) =   1
      IETOA(  2) =   2
      IATOE(  2) =   2
      IETOA(  3) =   3
      IATOE(  3) =   3
      IETOA(  5) =   9
      IATOE(  9) =   5
      IETOA(  7) = 127
      IATOE(127) =   7
      IETOA( 11) =  11
      IATOE( 11) =  11
      IETOA( 12) =  12
      IATOE( 12) =  12
      IETOA( 13) =  13
      IATOE( 13) =  13
      IETOA( 14) =  14
      IATOE( 14) =  14
      IETOA( 15) =  15
      IATOE( 15) =  15
      IETOA( 16) =  16
      IATOE( 16) =  16
      IETOA( 17) =  17
      IATOE( 17) =  17
      IETOA( 18) =  18
      IATOE( 18) =  18
      IETOA( 19) =  19
      IATOE( 19) =  19
      IETOA( 22) =   8
      IATOE(  8) =  22
      IETOA( 24) =  24
      IATOE( 24) =  24
      IETOA( 25) =  25
      IATOE( 25) =  25
      IETOA( 29) =  29
      IATOE( 29) =  29
      IETOA( 31) =  31
      IATOE( 31) =  31
      IETOA( 34) =  28
      IATOE( 28) =  34
      IETOA( 37) =  10
      IATOE( 10) =  37
      IETOA( 38) =  23
      IATOE( 23) =  38
      IETOA( 39) =  27
      IATOE( 27) =  39
      IETOA( 45) =   5
      IATOE(  5) =  45
      IETOA( 46) =   6
      IATOE(  6) =  46
      IETOA( 47) =   7
      IATOE(  7) =  47
      IETOA( 50) =  22
      IATOE( 22) =  50
      IETOA( 53) =  30
      IATOE( 30) =  53
      IETOA( 55) =   4
      IATOE(  4) =  55
      IETOA( 60) =  20
      IATOE( 20) =  60
      IETOA( 61) =  21
      IATOE( 21) =  61
      IETOA( 63) =  26
      IATOE( 26) =  63
      IETOA( 64) =  32
      IATOE( 32) =  64
      IETOA( 74) =  91
      IATOE( 91) =  74
      IETOA( 75) =  46
      IATOE( 46) =  75
      IETOA( 76) =  60
      IATOE( 60) =  76
      IETOA( 77) =  40
      IATOE( 40) =  77
      IETOA( 78) =  43
      IATOE( 43) =  78
      IETOA( 79) =  33
      IATOE( 33) =  79
      IETOA( 80) =  38
      IATOE( 38) =  80
      IETOA( 90) =  93
      IATOE( 93) =  90
      IETOA( 91) =  36
      IATOE( 36) =  91
      IETOA( 92) =  42
      IATOE( 42) =  92
      IETOA( 93) =  41
      IATOE( 41) =  93
      IETOA( 94) =  59
      IATOE( 59) =  94
      IETOA( 95) =  94
      IATOE( 94) =  95
      IETOA( 96) =  45
      IATOE( 45) =  96
      IETOA( 97) =  47
      IATOE( 47) =  97
      IETOA(106) = 124
      IATOE(124) = 106
      IETOA(107) =  44
      IATOE( 44) = 107
      IETOA(108) =  37
      IATOE( 37) = 108
      IETOA(109) =  95
      IATOE( 95) = 109
      IETOA(110) =  62
      IATOE( 62) = 110
      IETOA(111) =  63
      IATOE( 63) = 111
      IETOA(121) =  96
      IATOE( 96) = 121
      IETOA(122) =  58
      IATOE( 58) = 122
      IETOA(123) =  35
      IATOE( 35) = 123
      IETOA(124) =  64
      IATOE( 64) = 124
      IETOA(125) =  39
      IATOE( 39) = 125
      IETOA(126) =  61
      IATOE( 61) = 126
      IETOA(127) =  34
      IATOE( 34) = 127
      IETOA(129) =  97
      IATOE( 97) = 129
      IETOA(130) =  98
      IATOE( 98) = 130
      IETOA(131) =  99
      IATOE( 99) = 131
      IETOA(132) = 100
      IATOE(100) = 132
      IETOA(133) = 101
      IATOE(101) = 133
      IETOA(134) = 102
      IATOE(102) = 134
      IETOA(135) = 103
      IATOE(103) = 135
      IETOA(136) = 104
      IATOE(104) = 136
      IETOA(137) = 105
      IATOE(105) = 137
      IETOA(145) = 106
      IATOE(106) = 145
      IETOA(146) = 107
      IATOE(107) = 146
      IETOA(147) = 108
      IATOE(108) = 147
      IETOA(148) = 109
      IATOE(109) = 148
      IETOA(149) = 110
      IATOE(110) = 149
      IETOA(150) = 111
      IATOE(111) = 150
      IETOA(151) = 112
      IATOE(112) = 151
      IETOA(152) = 113
      IATOE(113) = 152
      IETOA(153) = 114
      IATOE(114) = 153
      IETOA(161) = 126
      IATOE(126) = 161
      IETOA(162) = 115
      IATOE(115) = 162
      IETOA(163) = 116
      IATOE(116) = 163
      IETOA(164) = 117
      IATOE(117) = 164
      IETOA(165) = 118
      IATOE(118) = 165
      IETOA(166) = 119
      IATOE(119) = 166
      IETOA(167) = 120
      IATOE(120) = 167
      IETOA(168) = 121
      IATOE(121) = 168
      IETOA(169) = 122
      IATOE(122) = 169
      IETOA(173) =  91
      IATOE( 91) = 173
      IETOA(176) =  48
      IATOE( 48) = 176
      IETOA(177) =  49
      IATOE( 49) = 177
      IETOA(178) =  50
      IATOE( 50) = 178
      IETOA(179) =  51
      IATOE( 51) = 179
      IETOA(180) =  52
      IATOE( 52) = 180
      IETOA(181) =  53
      IATOE( 53) = 181
      IETOA(182) =  54
      IATOE( 54) = 182
      IETOA(183) =  55
      IATOE( 55) = 183
      IETOA(184) =  56
      IATOE( 56) = 184
      IETOA(185) =  57
      IATOE( 57) = 185
      IETOA(189) =  93
      IATOE( 93) = 189
      IETOA(192) = 123
      IATOE(123) = 192
      IETOA(193) =  65
      IATOE( 65) = 193
      IETOA(194) =  66
      IATOE( 66) = 194
      IETOA(195) =  67
      IATOE( 67) = 195
      IETOA(196) =  68
      IATOE( 68) = 196
      IETOA(197) =  69
      IATOE( 69) = 197
      IETOA(198) =  70
      IATOE( 70) = 198
      IETOA(199) =  71
      IATOE( 71) = 199
      IETOA(200) =  72
      IATOE( 72) = 200
      IETOA(201) =  73
      IATOE( 73) = 201
      IETOA(208) = 125
      IATOE(125) = 208
      IETOA(209) =  74
      IATOE( 74) = 209
      IETOA(210) =  75
      IATOE( 75) = 210
      IETOA(211) =  76
      IATOE( 76) = 211
      IETOA(212) =  77
      IATOE( 77) = 212
      IETOA(213) =  78
      IATOE( 78) = 213
      IETOA(214) =  79
      IATOE( 79) = 214
      IETOA(215) =  80
      IATOE( 80) = 215
      IETOA(216) =  81
      IATOE( 81) = 216
      IETOA(217) =  82
      IATOE( 82) = 217
      IETOA(224) =  92
      IATOE( 92) = 224
      IETOA(226) =  83
      IATOE( 83) = 226
      IETOA(227) =  84
      IATOE( 84) = 227
      IETOA(228) =  85
      IATOE( 85) = 228
      IETOA(229) =  86
      IATOE( 86) = 229
      IETOA(230) =  87
      IATOE( 87) = 230
      IETOA(231) =  88
      IATOE( 88) = 231
      IETOA(232) =  89
      IATOE( 89) = 232
      IETOA(233) =  90
      IATOE( 90) = 233
      IETOA(240) =  48
      IATOE( 48) = 240
      IETOA(241) =  49
      IATOE( 49) = 241
      IETOA(242) =  50
      IATOE( 50) = 242
      IETOA(243) =  51
      IATOE( 51) = 243
      IETOA(244) =  52
      IATOE( 52) = 244
      IETOA(245) =  53
      IATOE( 53) = 245
      IETOA(246) =  54
      IATOE( 54) = 246
      IETOA(247) =  55
      IATOE( 55) = 247
      IETOA(248) =  56
      IATOE( 56) = 248
      IETOA(249) =  57
      IATOE( 57) = 249

C  SHOW SOME RESULTS
C  -----------------

      IF(PRINT) THEN
         CALL BVERS(CVSTR)
         CNDIAN = 'LITTLE'
      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)
      ERRSTR = '                          ' // CLANG //
     .  ' IS THE NATIVE LANGUAGE'
      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'//
     . ', LOOP INDEX J (HERE =",I3,") IS .GT. NO. OF BYTES PER WORD '//
     . 'ON THIS MACHINE (",I3,")")') J,NBYTW
      CALL BORT(BORT_STR)
  903 WRITE(BORT_STR,'("BUFRLIB: WRDLEN - CAN''T DETERMINE MACHINE '//
     . 'NATIVE LANGUAGE (CHAR. A UNPACKS TO INT.",I4," NEITHER ASCII '//
     . ' (65) NOR EBCDIC (193)")') IA
      CALL BORT(BORT_STR)
      END
