81,82c81,82
< C   95-03-20  M.BALDWIN   FI633 QUICK AN DIRTY FIX MODIFICATION TO GET
< C                         DATA REP TYPE [KGDS(1)] 201 AND 202 TO WORK.
---
> C   95-03-20  M.BALDWIN   FI633 MODIFICATION TO GET
> C                         DATA REP TYPES [KGDS(1)] 201 AND 202 TO WORK.
84,87c84,87
< C   95-04-26  R.E.JONES   FI636 CORECTION FOR 2ND ORDER COMPLEX 
< C                         UNPACKING. 
< C   95-05-19  R.E.JONES   ADDED GRID 215, 20 KM AWIPS GRID 
< C   95-07-06  R.E.JONES   ADDED GAUSSIAN T62, T126 GRIDS 98, 126 
---
> C   95-04-26  R.E.JONES   FI636 CORECTION FOR 2ND ORDER COMPLEX
> C                         UNPACKING. R
> C   95-05-19  R.E.JONES   ADDED GRID 215, 20 KM AWIPS GRID
> C   95-07-06  R.E.JONES   ADDED GAUSSIAN T62, T126 GRID 98, 126
88a89
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
90c91,96
< C   98-06-30  EBISUZAKI   LINUX PORT
---
> C   96-08-19  R.E.JONES   ADDED MERCATOR GRIDS 8 AND 53, AND GRID 196
> C   97-02-12  W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING
> C   98-06-17  IREDELL     REMOVED ALTERNATE RETURN IN FI637
> C   98-08-31  IREDELL     ELIMINATED NEED FOR MXSIZE
> C   98-09-02  Gilbert     Corrected error in map size for U.S. Grid 92
> C   98-09-08  BALDWIN     ADD DATA REP TYPE [KGDS(1)] 203
230c236
< C     KPTR       - 20 WORD ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS
---
> C     KPTR       - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS
246,250d251
< C         (16)   - RESERVED
< C         (17)   - RESERVED
< C         (18)   - RESERVED
< C         (19)   - RESERVED
< C         (20)   - RESERVED
271a273,274
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
273,274c276
< C   LANGUAGE: FORTRAN 77
< C   MACHINE:  HDS9000
---
> C   LANGUAGE: FORTRAN 90
429c431
< C       LBMS(260000)    LOGICAL
---
> C       LBMS(*)    LOGICAL
437c439
< C       DATA(260000)    REAL*4
---
> C       DATA(*)    REAL*4
442c444
< C       KPTR(10)        INTEGER*4
---
> C       KPTR(10)       INTEGER*4
550c552
<       LOGICAL       KBMS(*)
---
>       LOGICAL*1     KBMS(*)
563a566,567
>       INTEGER       KKK,JSGN,JEXP,IFR,NPTS
>       CHARACTER     KK(8)
565,567c569
< C
<       INTEGER       JSGN,JEXP,IFR,NPTS
< C
---
>       EQUIVALENCE   (KK(1),KKK)
584,587d585
<       SAVE
< C 
<       NSCL2    = 0
<       ZREF     = 0
594c592
<       IF (KRET.NE.0) THEN
---
>       IF(KRET.NE.0) THEN
602c600
<       IF (KRET.NE.0) THEN
---
>       IF(KRET.NE.0) THEN
609c607
<       IF (AND(KPDS(4),128).NE.0) THEN
---
>       IF (IAND(KPDS(4),128).NE.0) THEN
657c655,661
< C             CALL GBYTE (MSGA,FVAL1,KPTR(9)+384,32)
---
> C             CALL GBYTE  (MSGA,FVAL1,KPTR(9)+384,32)
> C
> C         NOTE INTEGERS, CHARACTERS AND EQUIVALENCES
> C         DEFINED ABOVE TO MAKE THIS KKK EXTRACTION
> C         WORK AND LINE UP ON WORD BOUNDARIES
> C
>           CALL GBYTE (MSGA,KKK,KPTR(9)+384,32)
662,664c666,678
< 	call gbytec(MSGA,JSGN,KPTR(9)+384,1)
< 	call gbytec(MSGA,JEXP,KPTR(9)+385,7)
< 	call gbytec(MSGA,IFR,KPTR(9)+392,24)
---
> C       1ST TEST TO SEE IN ON 32 OR 64 BIT WORD MACHINE
> C       LW = 4 OR 8; IF 8 MAY BE A CRAY
> C
>               CALL W3FI01(LW)
>               IF (LW.EQ.4) THEN
>                   CALL GBYTE (KK,JSGN,0,1)
>                   CALL GBYTE (KK,JEXP,1,7)
>                   CALL GBYTE (KK,IFR,8,24)
>               ELSE
>                   CALL GBYTE (KK,JSGN,32,1)
>                   CALL GBYTE (KK,JEXP,33,7)
>                   CALL GBYTE (KK,IFR,40,24)
>               ENDIF
667a682,683
>               ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN
>                   REALKK = 0.0
673a690,694
> C             CALL GBYTE  (MSGA,FDIFF1,KPTR(9)+416,32)
> C          (REPLACED BY FOLLOWING EXTRACTION)
> C
>               CALL GBYTE (MSGA,KKK,KPTR(9)+416,32)
> C
677,679c698,710
< 	call gbytec(MSGA,JSGN,KPTR(9)+416,1)
< 	call gbytec(MSGA,JEXP,KPTR(9)+417,7)
< 	call gbytec(MSGA,IFR,KPTR(9)+424,24)
---
> C       1ST TEST TO SEE IN ON 32 OR 64 BIT WORD MACHINE
> C       LW = 4 OR 8; IF 8 MAY BE A CRAY
> C
>               CALL W3FI01(LW)
>               IF (LW.EQ.4) THEN
>                   CALL GBYTE (KK,JSGN,0,1)
>                   CALL GBYTE (KK,JEXP,1,7)
>                   CALL GBYTE (KK,IFR,8,24)
>               ELSE
>                   CALL GBYTE (KK,JSGN,32,1)
>                   CALL GBYTE (KK,JEXP,33,7)
>                   CALL GBYTE (KK,IFR,40,24)
>               ENDIF
682a714,715
>               ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN
>                   REALKK = 0.0
689,690c722,723
<               CALL GBYTEC(MSGA,ISIGN,KPTR(9)+448,1)
<               CALL GBYTEC(MSGA,ISCAL2,KPTR(9)+449,15)
---
>               CALL GBYTE  (MSGA,ISIGN,KPTR(9)+448,1)
>               CALL GBYTE  (MSGA,ISCAL2,KPTR(9)+449,15)
709c742
<           PRINT *,'FI635 NOT PROGRAMMED FOR EDITION NR = ',KPDS(18)
---
> C         PRINT *,'FI635 NOT PROGRAMMED FOR EDITION NR',KPDS(18)
727a761
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
775a810,811
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
792d827
<       SAVE
796c831
<           CALL GBYTEC(MSGA,MGRIB,I,32)
---
>           CALL GBYTE (MSGA,MGRIB,I,32)
809c844
<       CALL GBYTEC(MSGA,ITOTAL,KPTR(8),24)
---
>       CALL GBYTE (MSGA,ITOTAL,KPTR(8),24)
812c847
<       CALL GBYTEC(MSGA,I7777,IPOINT,32)
---
>       CALL GBYTE (MSGA,I7777,IPOINT,32)
820c855
<           CALL GBYTEC(MSGA,KPDS(18),KPTR(8),8)
---
>           CALL GBYTE (MSGA,KPDS(18),KPTR(8),8)
830c865
<       CALL GBYTEC(MSGA,KPTR(3),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KPTR(3),KPTR(8),24)
833c868
<       CALL GBYTEC(MSGA,KPDS(4),LOOK,8)
---
>       CALL GBYTE (MSGA,KPDS(4),LOOK,8)
836c871
<       IF (AND(KPDS(4),128).NE.0) THEN
---
>       IF (IAND(KPDS(4),128).NE.0) THEN
838c873
<           CALL GBYTEC(MSGA,KPTR(4),KPTR(8),24)
---
>           CALL GBYTE (MSGA,KPTR(4),KPTR(8),24)
844c879
<       IF (AND(KPDS(4),64).NE.0) THEN
---
>       IF (IAND(KPDS(4),64).NE.0) THEN
846c881
<           CALL GBYTEC(MSGA,KPTR(5),KPTR(8),24)
---
>           CALL GBYTE (MSGA,KPTR(5),KPTR(8),24)
853c888
<       CALL GBYTEC(MSGA,KPTR(6),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KPTR(6),KPTR(8),24)
859c894
<       CALL GBYTEC(MSGA,K7777,KPTR(8),32)
---
>       CALL GBYTE (MSGA,K7777,KPTR(8),32)
886a922
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
940a977,978
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
957,958d994
<       SAVE
<       KRET=0
962c998
<           CALL GBYTEC(MSGA,KPDS(19),KPTR(8),8)
---
>           CALL GBYTE (MSGA,KPDS(19),KPTR(8),8)
965c1001
<       CALL GBYTEC(MSGA,KPDS(1),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(1),KPTR(8),8)
969c1005
<       CALL GBYTEC(MSGA,KPDS(2),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(2),KPTR(8),8)
973c1009
<       CALL GBYTEC(MSGA,KPDS(3),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(3),KPTR(8),8)
977c1013
< C     CALL GBYTEC(MSGA,KPDS(4),KPTR(8),8)
---
> C     CALL GBYTE (MSGA,KPDS(4),KPTR(8),8)
981c1017
<       CALL GBYTEC(MSGA,KPDS(5),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(5),KPTR(8),8)
985c1021
<       CALL GBYTEC(MSGA,KPDS(6),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(6),KPTR(8),8)
989c1025
<       CALL GBYTEC(MSGA,KPDS(7),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KPDS(7),KPTR(8),16)
993c1029
<       CALL GBYTEC(MSGA,KPDS(8),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(8),KPTR(8),8)
997c1033
<       CALL GBYTEC(MSGA,KPDS(9),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(9),KPTR(8),8)
1001c1037
<       CALL GBYTEC(MSGA,KPDS(10),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(10),KPTR(8),8)
1005c1041
<       CALL GBYTEC(MSGA,KPDS(11),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(11),KPTR(8),8)
1009c1045
<       CALL GBYTEC(MSGA,KPDS(12),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(12),KPTR(8),8)
1013c1049
<       CALL GBYTEC(MSGA,KPDS(13),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(13),KPTR(8),8)
1017c1053
<       CALL GBYTEC(MSGA,KPDS(14),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(14),KPTR(8),8)
1021c1057
<       CALL GBYTEC(MSGA,KPDS(15),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(15),KPTR(8),8)
1025c1061
<       CALL GBYTEC(MSGA,KPDS(16),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(16),KPTR(8),8)
1037c1073
<       CALL GBYTEC(MSGA,KPDS(17),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KPDS(17),KPTR(8),16)
1041c1077
<       CALL GBYTEC(MSGA,KPDS(20),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(20),KPTR(8),8)
1045c1081
<       CALL GBYTEC(MSGA,KPDS(21),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPDS(21),KPTR(8),8)
1049c1085
<           CALL GBYTEC(MSGA,KPDS(23),KPTR(8),8)
---
>           CALL GBYTE (MSGA,KPDS(23),KPTR(8),8)
1054c1090
<               CALL GBYTEC(MSGA,ISIGN,KPTR(8),1)
---
>               CALL GBYTE (MSGA,ISIGN,KPTR(8),1)
1056c1092
<               CALL GBYTEC(MSGA,IDEC,KPTR(8),15)
---
>               CALL GBYTE (MSGA,IDEC,KPTR(8),15)
1059c1095
<                 KPDS(22)  = - IDEC
---
>                   KPDS(22)  = - IDEC
1061c1097
<                 KPDS(22)  =   IDEC
---
>                   KPDS(22)  = IDEC
1066c1102
<                   CALL GBYTEC(MSGA,KPDS(24),KPTR(8)+8,8)
---
>                   CALL GBYTE (MSGA,KPDS(24),KPTR(8)+8,8)
1068c1104
<                   CALL GBYTEC(MSGA,KPDS(25),KPTR(8)+16,8)
---
>                   CALL GBYTE (MSGA,KPDS(25),KPTR(8)+16,8)
1073c1109
<                   CALL GBYTEC(MSGA,KPDS(24),KPTR(8)+8,8)
---
>                   CALL GBYTE (MSGA,KPDS(24),KPTR(8)+8,8)
1075c1111
<                   CALL GBYTEC(MSGA,KPDS(25),KPTR(8)+16,8)
---
>                   CALL GBYTE (MSGA,KPDS(25),KPTR(8)+16,8)
1079,1081d1114
< c		  system dependency!!
< c		  not sure how to remove WNE
< c		  current code seems well system dependent
1087c1120
<                   CALL GBYTESC(MSGA,KPDS(36),KPTR(8),MWDBIT,0,ITER)
---
>                   CALL GBYTES (MSGA,KPDS(36),KPTR(8),MWDBIT,0,ITER)
1093,1094c1126,1127
<       IF (AND(KPDS(4),128).NE.0) THEN
<           IF (AND(KPDS(4),64).NE.0) THEN
---
>       IF (IAND(KPDS(4),128).NE.0) THEN
>           IF (IAND(KPDS(4),64).NE.0) THEN
1096c1129
<                   IF (KPDS(3).GE.21.AND.KPDS(3).LE.26) THEN
---
>                   IF (KPDS(3).GE.21.AND.KPDS(3).LE.26)THEN
1098c1131
<                   ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44) THEN
---
>                   ELSE IF (KPDS(3).GE.37.AND.KPDS(3).LE.44)THEN
1105a1139
>                       ELSE IF (KPDS(3).EQ.8) THEN
1107a1142
>                       ELSE IF (KPDS(3).EQ.53) THEN
1111a1147
>                       ELSE IF (KPDS(3).EQ.196) THEN
1114,1118c1150,1154
<                           PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
<      *                    ' NMC WITHOUT A GRID DESCRIPTION SECTION'
<                           PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
<                           PRINT *,' PRODUCTION MANAGEMENT BRANCH'
<                           PRINT *,' W/NMC42)'
---
> C                         PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
> C    *                    ' NMC WITHOUT A GRID DESCRIPTION SECTION'
> C                         PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
> C                         PRINT *,' PRODUCTION MANAGEMENT BRANCH'
> C                         PRINT *,' W/NMC42)'
1123,1127c1159,1163
<                           PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
<      *                    ' ECMWF WITHOUT A GRID DESCRIPTION SECTION'
<                           PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
<                           PRINT *,' PRODUCTION MANAGEMENT BRANCH'
<                           PRINT *,' W/NMC42)'
---
> C                         PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
> C    *                    ' ECMWF WITHOUT A GRID DESCRIPTION SECTION'
> C                         PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
> C                         PRINT *,' PRODUCTION MANAGEMENT BRANCH'
> C                         PRINT *,' W/NMC42)'
1135,1140c1171,1176
<                           PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
<      *                            ' U.K. MET OFFICE, BRACKNELL',
<      *                            ' WITHOUT A GRID DESCRIPTION SECTION'
<                           PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
<                           PRINT *,' PRODUCTION MANAGEMENT BRANCH'
<                           PRINT *,' W/NMC42)'
---
> C                         PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
> C    *                            ' U.K. MET OFFICE, BRACKNELL',
> C    *                            ' WITHOUT A GRID DESCRIPTION SECTION'
> C                         PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
> C                         PRINT *,' PRODUCTION MANAGEMENT BRANCH'
> C                         PRINT *,' W/NMC42)'
1145,1149c1181,1185
<                           PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
<      *                      ' FNOC WITHOUT A GRID DESCRIPTION SECTION'
<                           PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
<                           PRINT *,' PRODUCTION MANAGEMENT BRANCH'
<                           PRINT *,' W/NMC42)'
---
> C                         PRINT *,' HAVE ENCOUNTERED A NEW GRID FOR',
> C    *                      ' FNOC WITHOUT A GRID DESCRIPTION SECTION'
> C                         PRINT *,' PLEASE NOTIFY AUTOMATION DIVISION'
> C                         PRINT *,' PRODUCTION MANAGEMENT BRANCH'
> C                         PRINT *,' W/NMC42)'
1168,1169c1204,1208
< C   95-03-20  M.BALDWIN   FI633 QUICK AN DIRTY FIX MODIFICATION TO GET
< C                         DATA REP TYPE [KGDS(1)] 201 AND 202 TO WORK. 
---
> C   95-03-20  M.BALDWIN   FI633 MODIFICATION TO GET
> C                         DATA REP TYPES [KGDS(1)] 201 AND 202 TO WORK.
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
> C   98-09-08  BALDWIN     ADD DATA REP TYPE [KGDS(1)] 203
> C                        
1276a1316,1317
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
1293d1333
<       SAVE
1301c1341
<       CALL GBYTEC(MSGA,KGDS(19),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(19),KPTR(8),8)
1305c1345
<       CALL GBYTEC(MSGA,KGDS(20),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(20),KPTR(8),8)
1309c1349
<       CALL GBYTEC(MSGA,KGDS(1),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(1),KPTR(8),8)
1353a1394,1395
> C  ------------------- ARAKAWA STAGGERED, SEMI-STAGGERED, OR FILLED
> C                          ROTATED LAT/LON GRIDS
1357c1399
<       CALL GBYTEC(MSGA,KGDS(2),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(2),KPTR(8),16)
1360c1402
<       CALL GBYTEC(MSGA,KGDS(3),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(3),KPTR(8),16)
1363c1405
<       CALL GBYTEC(MSGA,KGDS(4),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(4),KPTR(8),24)
1365,1366c1407,1408
<       IF (AND(KGDS(4),8388608).NE.0) THEN
<           KGDS(4)  =  AND(KGDS(4),8388607) * (-1)
---
>       IF (IAND(KGDS(4),8388608).NE.0) THEN
>           KGDS(4)  =  IAND(KGDS(4),8388607) * (-1)
1369c1411
<       CALL GBYTEC(MSGA,KGDS(5),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(5),KPTR(8),24)
1371,1372c1413,1414
<       IF (AND(KGDS(5),8388608).NE.0) THEN
<           KGDS(5)  =  - AND(KGDS(5),8388607)
---
>       IF (IAND(KGDS(5),8388608).NE.0) THEN
>           KGDS(5)  =  - IAND(KGDS(5),8388607)
1375c1417
<       CALL GBYTEC(MSGA,KGDS(6),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(6),KPTR(8),8)
1378c1420
<       CALL GBYTEC(MSGA,KGDS(7),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(7),KPTR(8),24)
1380,1381c1422,1423
<       IF (AND(KGDS(7),8388608).NE.0) THEN
<           KGDS(7)  =  - AND(KGDS(7),8388607)
---
>       IF (IAND(KGDS(7),8388608).NE.0) THEN
>           KGDS(7)  =  - IAND(KGDS(7),8388607)
1384c1426
<       CALL GBYTEC(MSGA,KGDS(8),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(8),KPTR(8),24)
1386,1387c1428,1429
<       IF (AND(KGDS(8),8388608).NE.0) THEN
<           KGDS(8)  =  - AND(KGDS(8),8388607)
---
>       IF (IAND(KGDS(8),8388608).NE.0) THEN
>           KGDS(8)  =  - IAND(KGDS(8),8388607)
1390c1432
<       CALL GBYTEC(MSGA,KGDS(9),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(9),KPTR(8),16)
1397c1439
<       CALL GBYTEC(MSGA,KGDS(10),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(10),KPTR(8),16)
1400c1442
<       CALL GBYTEC(MSGA,KGDS(11),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(11),KPTR(8),8)
1404c1446
<       CALL GBYTEC(MSGA,KGDS(12),KPTR(8),32)
---
>       CALL GBYTE (MSGA,KGDS(12),KPTR(8),32)
1413c1455
<       CALL GBYTEC(MSGA,KGDS(2),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(2),KPTR(8),16)
1416c1458
<       CALL GBYTEC(MSGA,KGDS(3),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(3),KPTR(8),16)
1419c1461
<       CALL GBYTEC(MSGA,KGDS(4),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(4),KPTR(8),24)
1421,1422c1463,1464
<       IF (AND(KGDS(4),8388608).NE.0) THEN
<           KGDS(4)  =  - AND(KGDS(4),8388607)
---
>       IF (IAND(KGDS(4),8388608).NE.0) THEN
>           KGDS(4)  =  - IAND(KGDS(4),8388607)
1425c1467
<       CALL GBYTEC(MSGA,KGDS(5),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(5),KPTR(8),24)
1427,1428c1469,1470
<       IF (AND(KGDS(5),8388608).NE.0) THEN
<           KGDS(5)  =   - AND(KGDS(5),8388607)
---
>       IF (IAND(KGDS(5),8388608).NE.0) THEN
>           KGDS(5)  =   - IAND(KGDS(5),8388607)
1431c1473
<       CALL GBYTEC(MSGA,KGDS(6),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(6),KPTR(8),8)
1434c1476
<       CALL GBYTEC(MSGA,KGDS(7),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(7),KPTR(8),24)
1436,1437c1478,1479
<       IF (AND(KGDS(7),8388608).NE.0) THEN
<           KGDS(7)  =  - AND(KGDS(7),8388607)
---
>       IF (IAND(KGDS(7),8388608).NE.0) THEN
>           KGDS(7)  =  - IAND(KGDS(7),8388607)
1440c1482
<       CALL GBYTEC(MSGA,KGDS(8),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(8),KPTR(8),24)
1442,1443c1484,1485
<       IF (AND(KGDS(8),8388608).NE.0) THEN
<           KGDS(8)  =  - AND(KGDS(8),8388607)
---
>       IF (IAND(KGDS(8),8388608).NE.0) THEN
>           KGDS(8)  =  - IAND(KGDS(8),8388607)
1446c1488
<       CALL GBYTEC(MSGA,KGDS(9),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(9),KPTR(8),24)
1448,1449c1490,1491
<       IF (AND(KGDS(9),8388608).NE.0) THEN
<           KGDS(9)  =  - AND(KGDS(9),8388607)
---
>       IF (IAND(KGDS(9),8388608).NE.0) THEN
>           KGDS(9)  =  - IAND(KGDS(9),8388607)
1452c1494
<       CALL GBYTEC(MSGA,KGDS(10),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(10),KPTR(8),8)
1455c1497
<       CALL GBYTEC(MSGA,KGDS(11),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(11),KPTR(8),8)
1459c1501
<       CALL GBYTEC(MSGA,KGDS(12),KPTR(8),32)
---
>       CALL GBYTE (MSGA,KGDS(12),KPTR(8),32)
1470c1512
<       CALL GBYTEC(MSGA,KGDS(2),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(2),KPTR(8),16)
1473c1515
<       CALL GBYTEC(MSGA,KGDS(3),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(3),KPTR(8),16)
1476c1518
<       CALL GBYTEC(MSGA,KGDS(4),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(4),KPTR(8),16)
1479c1521
<       CALL GBYTEC(MSGA,KGDS(5),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(5),KPTR(8),8)
1482c1524
<       CALL GBYTEC(MSGA,KGDS(6),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(6),KPTR(8),8)
1493c1535
<       CALL GBYTEC(MSGA,KGDS(2),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(2),KPTR(8),16)
1496c1538
<       CALL GBYTEC(MSGA,KGDS(3),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(3),KPTR(8),16)
1499c1541
<       CALL GBYTEC(MSGA,KGDS(4),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(4),KPTR(8),24)
1501,1502c1543,1544
<       IF (AND(KGDS(4),8388608).NE.0) THEN
<           KGDS(4)  =  - AND(KGDS(4),8388607)
---
>       IF (IAND(KGDS(4),8388608).NE.0) THEN
>           KGDS(4)  =  - IAND(KGDS(4),8388607)
1505c1547
<       CALL GBYTEC(MSGA,KGDS(5),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(5),KPTR(8),24)
1507,1508c1549,1550
<       IF (AND(KGDS(5),8388608).NE.0) THEN
<           KGDS(5)  =  - AND(KGDS(5),8388607)
---
>       IF (IAND(KGDS(5),8388608).NE.0) THEN
>           KGDS(5)  =  - IAND(KGDS(5),8388607)
1511c1553
<       CALL GBYTEC(MSGA,KGDS(6),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(6),KPTR(8),8)
1514c1556
<       CALL GBYTEC(MSGA,KGDS(7),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(7),KPTR(8),24)
1516,1517c1558,1559
<       IF (AND(KGDS(7),8388608).NE.0) THEN
<           KGDS(7)  =  - AND(KGDS(7),8388607)
---
>       IF (IAND(KGDS(7),8388608).NE.0) THEN
>           KGDS(7)  =  - IAND(KGDS(7),8388607)
1520c1562
<       CALL GBYTEC(MSGA,KGDS(8),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(8),KPTR(8),24)
1522,1523c1564,1565
<       IF (AND(KGDS(8),8388608).NE.0) THEN
<           KGDS(8)  =  - AND(KGDS(8),8388607)
---
>       IF (IAND(KGDS(8),8388608).NE.0) THEN
>           KGDS(8)  =  - IAND(KGDS(8),8388607)
1526c1568
<       CALL GBYTEC(MSGA,KGDS(9),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(9),KPTR(8),24)
1528,1529c1570,1571
<       IF (AND(KGDS(9),8388608).NE.0) THEN
<           KGDS(9)  =  - AND(KGDS(9),8388607)
---
>       IF (IAND(KGDS(9),8388608).NE.0) THEN
>           KGDS(9)  =  - IAND(KGDS(9),8388607)
1532c1574
<       CALL GBYTEC(MSGA,KGDS(10),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(10),KPTR(8),8)
1535c1577
<       CALL GBYTEC(MSGA,KGDS(11),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(11),KPTR(8),8)
1538c1580
<       CALL GBYTEC(MSGA,KGDS(12),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(12),KPTR(8),24)
1540,1541c1582,1583
<       IF (AND(KGDS(12),8388608).NE.0) THEN
<           KGDS(12)  =  - AND(KGDS(12),8388607)
---
>       IF (IAND(KGDS(12),8388608).NE.0) THEN
>           KGDS(12)  =  - IAND(KGDS(12),8388607)
1544c1586
<       CALL GBYTEC(MSGA,KGDS(13),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(13),KPTR(8),24)
1546,1547c1588,1589
<       IF (AND(KGDS(13),8388608).NE.0) THEN
<           KGDS(13)  =  - AND(KGDS(13),8388607)
---
>       IF (IAND(KGDS(13),8388608).NE.0) THEN
>           KGDS(13)  =  - IAND(KGDS(13),8388607)
1559c1601
<       CALL GBYTEC(MSGA,KGDS(2),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(2),KPTR(8),16)
1562c1604
<       CALL GBYTEC(MSGA,KGDS(3),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(3),KPTR(8),16)
1565c1607
<       CALL GBYTEC(MSGA,KGDS(4),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(4),KPTR(8),24)
1567,1568c1609,1610
<       IF (AND(KGDS(4),8388608).NE.0) THEN
<           KGDS(4)  =  - AND(KGDS(4),8388607)
---
>       IF (IAND(KGDS(4),8388608).NE.0) THEN
>           KGDS(4)  =  - IAND(KGDS(4),8388607)
1571c1613
<       CALL GBYTEC(MSGA,KGDS(5),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(5),KPTR(8),24)
1573,1574c1615,1616
<       IF (AND(KGDS(5),8388608).NE.0) THEN
<           KGDS(5)  = - AND(KGDS(5),8388607)
---
>       IF (IAND(KGDS(5),8388608).NE.0) THEN
>           KGDS(5)  = - IAND(KGDS(5),8388607)
1577c1619
<       CALL GBYTEC(MSGA,KGDS(6),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(6),KPTR(8),8)
1580c1622
<       CALL GBYTEC(MSGA,KGDS(7),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(7),KPTR(8),24)
1582,1583c1624,1625
<       IF (AND(KGDS(7),8388608).NE.0) THEN
<           KGDS(7)  = - AND(KGDS(7),8388607)
---
>       IF (IAND(KGDS(7),8388608).NE.0) THEN
>           KGDS(7)  = - IAND(KGDS(7),8388607)
1586c1628
<       CALL GBYTEC(MSGA,KGDS(8),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(8),KPTR(8),24)
1589c1631
<       CALL GBYTEC(MSGA,KGDS(9),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(9),KPTR(8),24)
1592c1634
<       CALL GBYTEC(MSGA,KGDS(10),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(10),KPTR(8),8)
1595c1637
<       CALL GBYTEC(MSGA,KGDS(11),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KGDS(11),KPTR(8),8)
1598c1640
<       CALL GBYTEC(MSGA,KGDS(12),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(12),KPTR(8),24)
1600,1601c1642,1643
<       IF (AND(KGDS(12),8388608).NE.0) THEN
<           KGDS(12)  =  - AND(KGDS(12),8388607)
---
>       IF (IAND(KGDS(12),8388608).NE.0) THEN
>           KGDS(12)  =  - IAND(KGDS(12),8388607)
1604c1646
<       CALL GBYTEC(MSGA,KGDS(13),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(13),KPTR(8),24)
1606,1607c1648,1649
<       IF (AND(KGDS(13),8388608).NE.0) THEN
<           KGDS(13)  =  - AND(KGDS(13),8388607)
---
>       IF (IAND(KGDS(13),8388608).NE.0) THEN
>           KGDS(13)  =  - IAND(KGDS(13),8388607)
1610c1652
<       CALL GBYTEC(MSGA,KGDS(14),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(14),KPTR(8),24)
1612,1613c1654,1655
<       IF (AND(KGDS(14),8388608).NE.0) THEN
<           KGDS(14)  =  - AND(KGDS(14),8388607)
---
>       IF (IAND(KGDS(14),8388608).NE.0) THEN
>           KGDS(14)  =  - IAND(KGDS(14),8388607)
1616c1658
<       CALL GBYTEC(MSGA,KGDS(15),KPTR(8),24)
---
>       CALL GBYTE (MSGA,KGDS(15),KPTR(8),24)
1618,1619c1660,1661
<       IF (AND(KGDS(15),8388608).NE.0) THEN
<           KGDS(15)  =  - AND(KGDS(15),8388607)
---
>       IF (IAND(KGDS(15),8388608).NE.0) THEN
>           KGDS(15)  =  - IAND(KGDS(15),8388607)
1622c1664
<       CALL GBYTEC(MSGA,KGDS(16),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KGDS(16),KPTR(8),16)
1633c1675
<           CALL GBYTESC(MSGA,KGDS(22),KPTR(8),16,0,KGDS(3))
---
>           CALL GBYTES (MSGA,KGDS(22),KPTR(8),16,0,KGDS(3))
1653a1696,1700
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
> C   97-02-12  W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING
> C   97-09-19  IREDELL     VECTORIZED BITMAP DECODER
> C   98-09-02  Gilbert     Corrected error in map size for U.S. Grid 92
> C   98-09-08  BALDWIN    ADD GRIDS 190,192
1705a1753,1754
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
1716c1765
<       LOGICAL       KBMS(*)
---
>       LOGICAL*1     KBMS(*)
1724a1774
>       INTEGER       MASK(8)
1726c1776
<       LOGICAL       GRD21( 1369)
---
>       LOGICAL*1     GRD21( 1369)
1728,1730c1778,1780
<       LOGICAL       GRD23( 1369)
<       LOGICAL       GRD25( 1368)
<       LOGICAL       GRD26( 1368)
---
>       LOGICAL*1     GRD23( 1369)
>       LOGICAL*1     GRD25( 1368)
>       LOGICAL*1     GRD26( 1368)
1734c1784
<       LOGICAL       GRD50( 1188)
---
>       LOGICAL*1     GRD50( 1188)
1736c1786
<       LOGICAL       GRD61( 4186)
---
>       LOGICAL*1     GRD61( 4186)
1738,1739c1788,1789
<       LOGICAL       GRD63( 4186)
< C     LOGICAL       GRD70(16380)/16380*.TRUE./
---
>       LOGICAL*1     GRD63( 4186)
> C     LOGICAL*1     GRD70(16380)/16380*.TRUE./
1741d1790
<       SAVE
1771a1821
>       DATA  MASK  /128,64,32,16,8,4,2,1/
1774c1824
<       IF (AND(KPDS(4),64).EQ.64) THEN
---
>       IF (IAND(KPDS(4),64).EQ.64) THEN
1782c1832
<       CALL GBYTEC(MSGA,KPTR(11),KPTR(8),8)
---
>       CALL GBYTE (MSGA,KPTR(11),KPTR(8),8)
1787c1837
<       CALL GBYTEC(MSGA,KPTR(12),KPTR(8),16)
---
>       CALL GBYTE (MSGA,KPTR(12),KPTR(8),16)
1797,1805c1847
<               DO 2122 I = 1, IBITS
<                   CALL GBYTEC(MSGA,ICHK,KPTR(8),1)
<                   KPTR(8)   = KPTR(8) + 1
<                   IF (ICHK.NE.0) THEN
<                       KBMS(I)   = .TRUE.
<                   ELSE
<                       KBMS(I)   = .FALSE.
<                   END IF
<  2122         CONTINUE
---
>               CALL FI634X(IBITS,KPTR(8),MSGA,KBMS)
1820a1863
>               CALL FI634X(IBITS,KPTR(8),MSGA,KBMS)
1831,1839d1873
<               DO 2324 I = 1, IBITS
<                   CALL GBYTEC(MSGA,ICHK,KPTR(8),1)
<                   KPTR(8)   = KPTR(8) + 1
<                   IF (ICHK.NE.0) THEN
<                       KBMS(I)   = .TRUE.
<                   ELSE
<                       KBMS(I)   = .FALSE.
<                   END IF
<  2324         CONTINUE
1852,1861c1886,1888
<                       DO 52 K = 1, KIN
<                           CALL GBYTEC(MSGA,ICHK,KPTR(8),1)
<                           KPTR(8)   = KPTR(8) + 1
<                           KBITS     = KBITS + 1
<                           IF (ICHK.NE.0) THEN
<                               KBMS(KBITS)  = .TRUE.
<                           ELSE
<                               KBMS(KBITS)  = .FALSE.
<                           END IF
<    52                 CONTINUE
---
>                       CALL FI634X(KIN,KPTR(8),MSGA,KBMS(KBITS+1))
>                       KPTR(8)=KPTR(8)+KIN
>                       KBITS=KBITS+KIN
1871,1880c1898,1900
<                   DO 56 J = 1, KIN
<                       CALL GBYTEC(MSGA,ICHK,KPTR(8),1)
<                       KPTR(8)  = KPTR(8) + 1
<                       KBITS    = KBITS + 1
<                       IF (ICHK.NE.0) THEN
<                           KBMS(KBITS)  = .TRUE.
<                       ELSE
<                           KBMS(KBITS)  = .FALSE.
<                       END IF
<    56             CONTINUE
---
>                   CALL FI634X(KIN,KPTR(8),MSGA,KBMS(KBITS+1))
>                   KPTR(8)=KPTR(8)+KIN
>                   KBITS=KBITS+KIN
1884,1892c1904
<               DO 100 I = 1, IBITS
<                   CALL GBYTEC(MSGA,ICHK,KPTR(8),1)
<                   KPTR(8)  = KPTR(8) + 1
<                   IF (ICHK.NE.0) THEN
<                       KBMS(I) = .TRUE.
<                   ELSE
<                       KBMS(I) = .FALSE.
<                   END IF
<   100         CONTINUE
---
>               CALL FI634X(IBITS,KPTR(8),MSGA,KBMS)
1896c1908
<           PRINT *,'FI634-NO PREDEFINED BIT MAP PROVIDED BY THIS CENTER'
---
> C         PRINT *,'FI634-NO PREDEFINED BIT MAP PROVIDED BY THIS CENTER'
1907c1919
<           PRINT *,'NON STANDARD GRID, CENTER = ',KPDS(1)
---
> C         PRINT *,'NON STANDARD GRID, CENTER = ',KPDS(1)
1922c1934,1935
<           CALL FI637(*820,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 820
1931c1944,1945
<           CALL FI637(*820,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 820
1940c1954,1955
<           CALL FI637(*820,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 820
1949c1964,1965
<           CALL FI637(*820,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 820
1962c1978,1979
<           CALL FI637(*890,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 890
1971c1988,1989
<           CALL FI637(*820,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 820
1980c1998,1999
<           CALL FI637(*820,J,KPDS,KGDS,KRET)
---
>           CALL FI637(J,KPDS,KGDS,KRET)
>           IF(KRET.NE.0) GO TO 820
2015a2035,2038
>               ELSE IF (KPDS(3).EQ.8) THEN
> C                       ----- U.S. GRID 8 - MAP SIZE 5104
>                   J   = 5104
>                   GO TO 800
2035a2059,2062
>               ELSE IF (KPDS(3).EQ.53) THEN
> C                  ----- U.S.  GRID  53    - MAP SIZE 5967
>                   J   = 5967
>                   GO TO 800
2077,2078c2104,2105
< C                       ----- U.S GRID 92     - MAP SIZE 24162
<                   J     = 24162
---
> C                       ----- U.S GRID 92     - MAP SIZE 81213
>                   J     = 81213
2138c2165,2177
<               ELSE IF (AND(KPDS(4),128).EQ.128) THEN
---
>               ELSE IF (KPDS(3).EQ.190) THEN
> C                       ----- U.S GRID 190  - MAP SIZE 12972
>                   J     = 12972
>                   GO TO 800
>               ELSE IF (KPDS(3).EQ.192) THEN
> C                       ----- U.S GRID 192  - MAP SIZE 81395
>                   J     = 81395
>                   GO TO 800
>               ELSE IF (KPDS(3).EQ.196) THEN
> C                 ----- U.S. GRID 196 - MAP SIZE 45903
>                   J     = 45903
>                   GO TO 800
>               ELSE IF (IAND(KPDS(4),128).EQ.128) THEN
2188c2227
<               ELSE IF (AND(KPDS(4),128).EQ.128) THEN
---
>               ELSE IF (IAND(KPDS(4),128).EQ.128) THEN
2199,2201c2238,2240
<           IF (AND(KPDS(4),128).EQ.128) THEN
<               PRINT *,'JMA MAP IS NOT PREDEFINED, THE GDS WILL'
<               PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3)
---
>           IF (IAND(KPDS(4),128).EQ.128) THEN
> C             PRINT *,'JMA MAP IS NOT PREDEFINED, THE GDS WILL'
> C             PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3)
2209,2211c2248,2250
<           IF (AND(KPDS(4),128).EQ.128) THEN
<               PRINT *,'CANADIAN MAP IS NOT PREDEFINED, THE GDS WILL'
<               PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3)
---
>           IF (IAND(KPDS(4),128).EQ.128) THEN
> C             PRINT *,'CANADIAN MAP IS NOT PREDEFINED, THE GDS WILL'
> C             PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3)
2237,2239c2276,2278
<           IF (AND(KPDS(4),128).EQ.128) THEN
<               PRINT *,'FNOC MAP IS NOT PREDEFINED, THE GDS WILL'
<               PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3)
---
>           IF (IAND(KPDS(4),128).EQ.128) THEN
> C             PRINT *,'FNOC MAP IS NOT PREDEFINED, THE GDS WILL'
> C             PRINT *,'BE USED TO UNPACK THE DATA, MAP = ',KPDS(3)
2247c2286
<           IF (AND(KPDS(4),128).EQ.128) THEN
---
>           IF (IAND(KPDS(4),128).EQ.128) THEN
2262c2301,2303
<               CALL FI637(*810,J,KPDS,KGDS,KRET)
---
>               CALL FI637(J,KPDS,KGDS,KRET)
>               IF(KRET.NE.0) GO TO 810
>               KPTR(10)  = J  ! Reset For Modified J
2270c2311,2312
<               CALL FI637(*810,J,KPDS,KGDS,KRET)
---
>               CALL FI637(J,KPDS,KGDS,KRET)
>               IF(KRET.NE.0) GO TO 810
2275c2317
<           ELSE IF (AND(KPDS(4),128).EQ.128) THEN
---
>           ELSE IF (IAND(KPDS(4),128).EQ.128) THEN
2282,2285c2324,2327
<           PRINT *,'CENTER ',KPDS(1),' IS NOT DEFINED'
<           IF (AND(KPDS(4),128).EQ.128) THEN
<               PRINT *,'GDS WILL BE USED TO UNPACK THE DATA',
<      *                        ' MAP = ',KPDS(3)
---
> C         PRINT *,'CENTER ',KPDS(1),' IS NOT DEFINED'
>           IF (IAND(KPDS(4),128).EQ.128) THEN
> C             PRINT *,'GDS WILL BE USED TO UNPACK THE DATA',
> C    *                        ' MAP = ',KPDS(3)
2296c2338,2339
<       CALL FI637 (*801,J,KPDS,KGDS,KRET)
---
>       CALL FI637 (J,KPDS,KGDS,KRET)
>       IF(KRET.NE.0) GO TO 801
2311c2354
<       PRINT *,'ECMWF PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE'
---
> C     PRINT *,'ECMWF PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE'
2315c2358
<       PRINT *,'U.K. MET PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE'
---
> C     PRINT *,'U.K. MET PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE'
2319c2362
<       PRINT *,'PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE'
---
> C     PRINT *,'PREDEFINED MAP SIZE DOES NOT MATCH, I WILL USE'
2321c2364
<       PRINT *,'THE GDS TO UNPACK THE DATA, MAP TYPE = ',KPDS(3)
---
> C     PRINT *,'THE GDS TO UNPACK THE DATA, MAP TYPE = ',KPDS(3)
2334a2378,2414
> C-----------------------------------------------------------------------
>       SUBROUTINE FI634X(NPTS,NSKP,MSGA,KBMS)
> C$$$  SUBPROGRAM DOCUMENTATION  BLOCK
> C                .      .    .                                       .
> C SUBPROGRAM:    FI634X      EXTRACT BIT MAP
> C   PRGMMR: IREDELL          ORG: W/NP23     DATE: 91-09-19
> C
> C ABSTRACT: EXTRACT THE PACKED BITMAP INTO A LOGICAL ARRAY.
> C
> C PROGRAM HISTORY LOG:
> C   97-09-19  IREDELL     VECTORIZED BITMAP DECODER
> C
> C USAGE:    CALL FI634X(NPTS,NSKP,MSGA,KBMS)
> C   INPUT ARGUMENT LIST:
> C     NPTS       - INTEGER NUMBER OF POINTS IN THE BITMAP FIELD
> C     NSKP       - INTEGER NUMBER OF BITS TO SKIP IN GRIB MESSAGE
> C     MSGA       - CHARACTER*1 GRIB MESSAGE
> C
> C   OUTPUT ARGUMENT LIST:
> C     KBMS       - LOGICAL*1 BITMAP
> C
> C REMARKS:
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
> C ATTRIBUTES:
> C   LANGUAGE: FORTRAN 77
> C   MACHINE:  CRAY
> C
> C$$$
>       CHARACTER*1   MSGA(*)
>       LOGICAL*1     KBMS(NPTS)
>       INTEGER       ICHK(NPTS)
> C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
>       CALL GBYTES(MSGA,ICHK,NSKP,1,0,NPTS)
>       KBMS=ICHK.NE.0
> C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
>       END
2350a2431,2432
> C   95-10-31  IREDELL    REMOVED SAVES AND PRINTS
> C   98-08-31  IREDELL    ELIMINATED NEED FOR MXSIZE
2371,2375d2452
< C         (16)   - RESERVED
< C         (17)   - RESERVED
< C         (18)   - RESERVED
< C         (19)   - RESERVED
< C         (20)   - RESERVED
2408,2409c2485,2486
< C     KPTR       - 20 WORD ARRAY CONTAINING STORAGE FOR FOLLOWING
< C                  PARAMETERS. SEE INPUT LIST
---
> C     KPTR       - ARRAY CONTAINING STORAGE FOR FOLLOWING PARAMETERS
> C                  SEE INPUT LIST
2417a2495,2496
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
2423,2431d2501
< C  *************************************************************
< C       ON A PC THIS CAN BE CHANGED TO A SMALLER SIZE TO BETTER FIT
< C       THE DOS MEMORY LIMIT OF 640K BYTES.  YOU COULD DO THIS
< C       FOR MICROSOFT 5.0.  A PC 32 BIT FORTRAN COMPILER
< C       WOULD NOT NEED THIS CHANGE.  IF NONE OF YOUR GRIB RECORDS
< C       IS LARGER THAN 20000, SET MXSIZE TO 20000.
< C  *************************************************************
< C
<       PARAMETER     (MXSIZE=260000)
2433a2504,2505
>       CHARACTER*1   KK(8)
>       CHARACTER*1   CKREF(8)
2435c2507
<       LOGICAL       KBMS(*)
---
>       LOGICAL*1     KBMS(*)
2442c2514,2516
<       INTEGER       KSAVE(MXSIZE)
---
>       INTEGER       KREF
>       INTEGER       KKK
>       INTEGER,ALLOCATABLE::  KSAVE(:)
2449a2524,2527
>       EQUIVALENCE   (CKREF(1),KREF,REFNCE)
>       EQUIVALENCE   (KK(1),KKK,REALKK)
> C
> C
2453d2530
<       SAVE
2460c2537
<       CALL GBYTEC(MSGA,KPTR(14),KPTR(8),4)
---
>       CALL GBYTE(MSGA,KPTR(14),KPTR(8),4)
2463c2540
<       CALL GBYTEC(MSGA,KPTR(15),KPTR(8),4)
---
>       CALL GBYTE(MSGA,KPTR(15),KPTR(8),4)
2470c2547
<       CALL GBYTEC(MSGA,KSIGN,KPTR(8),1)
---
>       CALL GBYTE (MSGA,KSIGN,KPTR(8),1)
2473c2550
<       CALL GBYTEC(MSGA,KSCALE,KPTR(8),15)
---
>       CALL GBYTE (MSGA,KSCALE,KPTR(8),15)
2479d2555
< 
2482,2485c2558
<       
<       call gbytec(MSGA,JSGN,KPTR(8),1)
<       call gbytec(MSGA,JEXP,KPTR(8)+1,7)
<       call gbytec(MSGA,IFR,KPTR(8)+8,24)
---
>       CALL GBYTE (MSGA,KREF,KPTR(8),32)
2487,2489c2560,2578
< 
< c     PRINT *,109,JSGN,JEXP,IFR
< c 109 FORMAT (' JSGN,JEXP,IFR = ',3(1X,Z8))
---
> C
> C     THE NEXT CODE WILL CONVERT THE IBM370 FLOATING POINT
> C     TO THE FLOATING POINT USED ON YOUR COMPUTER.
> C
> C     1ST TEST TO SEE IN ON 32 OR 64 BIT WORD MACHINE
> C     LW = 4 OR 8;  IF 8 MAY BE A CRAY
> C
>       CALL W3FI01(LW)
>       IF (LW.EQ.4) THEN
>         CALL GBYTE (CKREF,JSGN,0,1)
>         CALL GBYTE (CKREF,JEXP,1,7)
>         CALL GBYTE (CKREF,IFR,8,24)
>       ELSE
>         CALL GBYTE (CKREF,JSGN,32,1)
>         CALL GBYTE (CKREF,JEXP,33,7)
>         CALL GBYTE (CKREF,IFR,40,24)
>       ENDIF
> C     PRINT *,109,JSGN,JEXP,IFR
> C 109 FORMAT (' JSGN,JEXP,IFR = ',3(1X,Z8))
2491a2581,2582
>       ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN
>           REFNCE  = 0.0
2496,2497c2587
< C     PRINT *,'SCALE ',SCALE,' REF VAL ',REFNCE
< 
---
> C     PRINT *,'SCALE ',SCALE,' REF VAL ',KREF,REFNCE
2500c2590
<       CALL GBYTEC(MSGA,KBITS,KPTR(8),8)
---
>       CALL GBYTE (MSGA,KBITS,KPTR(8),8)
2509,2510c2599,2600
< C     PRINT *,'BASIC FLAGS =',KPTR(14) ,AND(KPTR(14),1)
<       IF (AND(KPTR(14),1).EQ.0) THEN
---
> C     PRINT *,'BASIC FLAGS =',KPTR(14) ,IAND(KPTR(14),1)
>       IF (IAND(KPTR(14),1).EQ.0) THEN
2514c2604
<           CALL GBYTEC(MSGA,KOCTET,KPTR(8),16)
---
>           CALL GBYTE (MSGA,KOCTET,KPTR(8),16)
2518c2608
<           CALL GBYTEC(MSGA,KXFLAG,KPTR(8),8)
---
>           CALL GBYTE (MSGA,KXFLAG,KPTR(8),8)
2521c2611
<           IF (AND(KXFLAG,16).EQ.0) THEN
---
>           IF (IAND(KXFLAG,16).EQ.0) THEN
2528c2618
<           IF (AND (KXFLAG,32).EQ.0) THEN
---
>           IF (IAND (KXFLAG,32).EQ.0) THEN
2535c2625
<           IF (AND (KXFLAG,64).EQ.0) THEN
---
>           IF (IAND (KXFLAG,64).EQ.0) THEN
2544c2634
<           CALL GBYTEC(MSGA,NR,KPTR(8),16)
---
>           CALL GBYTE (MSGA,NR,KPTR(8),16)
2548c2638
<           CALL GBYTEC(MSGA,NC,KPTR(8),16)
---
>           CALL GBYTE (MSGA,NC,KPTR(8),16)
2552c2642
<           CALL GBYTEC(MSGA,NRV,KPTR(8),8)
---
>           CALL GBYTE (MSGA,NRV,KPTR(8),8)
2556c2646
<           CALL GBYTEC(MSGA,NC1,KPTR(8),8)
---
>           CALL GBYTE (MSGA,NC1,KPTR(8),8)
2560c2650
<           CALL GBYTEC(MSGA,NCV,KPTR(8),8)
---
>           CALL GBYTE (MSGA,NCV,KPTR(8),8)
2564c2654
<           CALL GBYTEC(MSGA,NC2,KPTR(8),8)
---
>           CALL GBYTE (MSGA,NC2,KPTR(8),8)
2568c2658
<           CALL GBYTEC(MSGA,KPHYS1,KPTR(8),8)
---
>           CALL GBYTE (MSGA,KPHYS1,KPTR(8),8)
2572c2662
<           CALL GBYTEC(MSGA,KPHYS2,KPTR(8),8)
---
>           CALL GBYTE (MSGA,KPHYS2,KPTR(8),8)
2581c2671
<           KENTRY  = KPTR(10)
---
>           KENTRY = KPTR(10)
2583,2586c2673,2676
<             DATA(I) = 0.0
<             IF (KBMS(I)) THEN
<               DATA(I) = REFN10
<             END IF
---
>               DATA(I) = 0.0
>               IF (KBMS(I)) THEN
>                    DATA(I) = REFN10
>               END IF
2602,2607c2692,2694
<       KENTRY  = NRBITS / KBITS
< C                             MAX SIZE CHECK
<       IF (KENTRY.GT.MXSIZE) THEN
<           KRET   = 3
<           RETURN
<       END IF
---
>       KENTRY = NRBITS / KBITS
> C                             ALLOCATE KSAVE
>       ALLOCATE(KSAVE(KENTRY))
2609c2696
< C     IF (AND(KPTR(14),2).EQ.0) THEN
---
> C     IF (IAND(KPTR(14),2).EQ.0) THEN
2615c2702
<       IF (AND(KPTR(14),8).EQ.0) THEN
---
>       IF (IAND(KPTR(14),8).EQ.0) THEN
2617c2704
<          IF (AND(KPTR(14),4).EQ.0) THEN
---
>          IF (IAND(KPTR(14),4).EQ.0) THEN
2619c2706
<              IF (AND(KPTR(14),1).EQ.0) THEN
---
>              IF (IAND(KPTR(14),1).EQ.0) THEN
2622,2623c2709,2710
<              ELSE IF (AND(KPTR(14),1).NE.0) THEN
<                  PRINT *,'        WITH ADDITIONAL FLAGS',KXFLAG
---
>              ELSE IF (IAND(KPTR(14),1).NE.0) THEN
> C                PRINT *,'        WITH ADDITIONAL FLAGS',KXFLAG
2625c2712
<                      PRINT *,'            SINGLE DATUM EACH GRID PT'
---
> C                    PRINT *,'            SINGLE DATUM EACH GRID PT'
2627c2714
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2629,2630c2716,2717
<                              PRINT *,'            SECOND ORDER',
<      *                          ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                          ' VALUES CONSTANT WIDTH'
2632,2633c2719,2720
<                              PRINT *,'            SECOND ORDER',
<      *                            ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                            ' VALUES DIFFERENT WIDTHS'
2636c2723
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2638,2639c2725,2726
<                               PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                             PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2641,2642c2728,2729
<                              PRINT *,'            SECOND ORDER',
<      *                             ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                             ' VALUES DIFFERENT WIDTHS'
2646c2733
<                      PRINT *,'            MATRIX OF VALS EACH PT'
---
> C                    PRINT *,'            MATRIX OF VALS EACH PT'
2648c2735
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2650,2651c2737,2738
<                              PRINT *,'            SECOND ORDER',
<      *                          ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                          ' VALUES CONSTANT WIDTH'
2653,2654c2740,2741
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2657c2744
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2659,2660c2746,2747
<                              PRINT *,'            SECOND ORDER',
<      *                             ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                             ' VALUES CONSTANT WIDTH'
2662,2663c2749,2750
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2668,2673c2755,2760
<          ELSE IF (AND(KPTR(14),4).NE.0) THEN
<              PRINT *,'    WITH COMPLEX/SECOND ORDER PACKING'
<              IF (AND(KPTR(14),1).EQ.0) THEN
<                      PRINT *,'        WITH NO ADDITIONAL FLAGS'
<              ELSE IF (AND(KPTR(14),1).NE.0) THEN
<                  PRINT *,'        WITH ADDITIONAL FLAGS'
---
>          ELSE IF (IAND(KPTR(14),4).NE.0) THEN
> C            PRINT *,'    WITH COMPLEX/SECOND ORDER PACKING'
>              IF (IAND(KPTR(14),1).EQ.0) THEN
> C                    PRINT *,'        WITH NO ADDITIONAL FLAGS'
>              ELSE IF (IAND(KPTR(14),1).NE.0) THEN
> C                PRINT *,'        WITH ADDITIONAL FLAGS'
2675c2762
<                      PRINT *,'            SINGLE DATUM AT EACH PT'
---
> C                    PRINT *,'            SINGLE DATUM AT EACH PT'
2677c2764
<                              PRINT *,'            NO SEC BIT MAP'
---
> C                            PRINT *,'            NO SEC BIT MAP'
2679,2680c2766,2767
<                              PRINT *,'            SECOND ORDER',
<      *                             ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                             ' VALUES CONSTANT WIDTH'
2682,2683c2769,2770
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2690c2777
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2692,2693c2779,2780
<                                  PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                                PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2695,2696c2782,2783
<                                  PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                                PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2703c2790
<                      PRINT *,'            MATRIX OF VALS EACH PT'
---
> C                    PRINT *,'            MATRIX OF VALS EACH PT'
2705c2792
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2707,2708c2794,2795
<                                PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                              PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2710,2711c2797,2798
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2714c2801
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2716,2717c2803,2804
<                                PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                              PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2719,2720c2806,2807
<                                  PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                                PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2726,2731c2813,2818
<       ELSE IF (AND(KPTR(14),8).NE.0) THEN
<          PRINT *,'PROCESSING SPHERICAL HARMONIC COEFFICIENTS'
<          IF (AND(KPTR(14),4).EQ.0) THEN
<              PRINT *,'    WITH SIMPLE PACKING'
<              IF (AND(KPTR(14),1).EQ.0) THEN
<                  PRINT *,'        WITH NO ADDITIONAL FLAGS'
---
>       ELSE IF (IAND(KPTR(14),8).NE.0) THEN
> C        PRINT *,'PROCESSING SPHERICAL HARMONIC COEFFICIENTS'
>          IF (IAND(KPTR(14),4).EQ.0) THEN
> C            PRINT *,'    WITH SIMPLE PACKING'
>              IF (IAND(KPTR(14),1).EQ.0) THEN
> C                PRINT *,'        WITH NO ADDITIONAL FLAGS'
2733,2734c2820,2821
<              ELSE IF (AND(KPTR(14),1).NE.0) THEN
<                  PRINT *,'        WITH ADDITIONAL FLAGS'
---
>              ELSE IF (IAND(KPTR(14),1).NE.0) THEN
> C                PRINT *,'        WITH ADDITIONAL FLAGS'
2736c2823
<                      PRINT *,'            SINGLE DATUM EACH GRID PT'
---
> C                    PRINT *,'            SINGLE DATUM EACH GRID PT'
2738c2825
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2740,2741c2827,2828
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2743,2744c2830,2831
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2747c2834
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2749,2750c2836,2837
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2752,2753c2839,2840
<                              PRINT *,'            SECOND ORDER',
<      *                            ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                            ' VALUES DIFFERENT WIDTHS'
2757c2844
<                      PRINT *,'            MATRIX OF VALS EACH PT'
---
> C                    PRINT *,'            MATRIX OF VALS EACH PT'
2759c2846
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2761,2762c2848,2849
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2764,2765c2851,2852
<                              PRINT *,'            SECOND ORDER',
<      *                             ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                             ' VALUES DIFFERENT WIDTHS'
2768c2855
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2770,2771c2857,2858
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2773,2774c2860,2861
<                              PRINT *,'            SECOND ORDER',
<      *                             ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                             ' VALUES DIFFERENT WIDTHS'
2779c2866
<          ELSE IF (AND(KPTR(14),4).NE.0) THEN
---
>          ELSE IF (IAND(KPTR(14),4).NE.0) THEN
2781,2785c2868,2872
<              PRINT *,'    WITH COMPLEX/SECOND ORDER PACKING'
<              IF (AND(KPTR(14),1).EQ.0) THEN
<                  PRINT *,'        WITH NO ADDITIONAL FLAGS'
<              ELSE IF (AND(KPTR(14),1).NE.0) THEN
<                  PRINT *,'        WITH ADDITIONAL FLAGS'
---
> C            PRINT *,'    WITH COMPLEX/SECOND ORDER PACKING'
>              IF (IAND(KPTR(14),1).EQ.0) THEN
> C                PRINT *,'        WITH NO ADDITIONAL FLAGS'
>              ELSE IF (IAND(KPTR(14),1).NE.0) THEN
> C                PRINT *,'        WITH ADDITIONAL FLAGS'
2787c2874
<                      PRINT *,'            SINGLE DATUM EACH GRID PT'
---
> C                    PRINT *,'            SINGLE DATUM EACH GRID PT'
2789c2876
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2791,2792c2878,2879
<                              PRINT *,'            SECOND ORDER',
<      *                             ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                             ' VALUES CONSTANT WIDTH'
2794,2795c2881,2882
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2798c2885
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2800,2801c2887,2888
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2803,2804c2890,2891
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2808c2895
<                      PRINT *,'            MATRIX OF VALS EACH PT'
---
> C                    PRINT *,'            MATRIX OF VALS EACH PT'
2810c2897
<                          PRINT *,'            NO SEC BIT MAP'
---
> C                        PRINT *,'            NO SEC BIT MAP'
2812,2813c2899,2900
<                              PRINT *,'            SECOND ORDER',
<      *                            ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                            ' VALUES CONSTANT WIDTH'
2815,2816c2902,2903
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2819c2906
<                          PRINT *,'            SEC BIT MAP'
---
> C                        PRINT *,'            SEC BIT MAP'
2821,2822c2908,2909
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES CONSTANT WIDTH'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES CONSTANT WIDTH'
2824,2825c2911,2912
<                              PRINT *,'            SECOND ORDER',
<      *                              ' VALUES DIFFERENT WIDTHS'
---
> C                            PRINT *,'            SECOND ORDER',
> C    *                              ' VALUES DIFFERENT WIDTHS'
2832c2919,2920
<       PRINT *,' NOT PROCESSED - NOT PROCESSED - NOT PROCESSED'
---
>       IF(ALLOCATED(KSAVE)) DEALLOCATE(KSAVE)
> C     PRINT *,' NOT PROCESSED - NOT PROCESSED - NOT PROCESSED'
2851c2939
<           CALL GBYTESC(MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
---
>           CALL GBYTES (MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
2856,2861c2944,2949
<             IF (KBMS(I)) THEN
<               DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10
<               II      = II + 1
<             ELSE
<               DATA(I)   = 0.0
<             END IF
---
>               IF (KBMS(I)) THEN
>                   DATA(I)   = (REFNCE+FLOAT(KSAVE(II))*SCALE)*SCAL10
>                   II        = II + 1
>               ELSE
>                   DATA(I)   = 0.0
>               END IF
2864c2952
<             DATA(I)   = DATA(1)
---
>               DATA(I)   = DATA(1)
2868c2956
<           CALL GBYTESC(MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
---
>           CALL GBYTES (MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
2872,2877c2960,2965
<             IF (KBMS(I)) THEN
<               DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10
<               II  = II + 1
<             ELSE
<               DATA(I) = 0.0
<             END IF
---
>               IF (KBMS(I)) THEN
>                   DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10
>                   II  = II + 1
>               ELSE
>                   DATA(I) = 0.0
>               END IF
2880c2968
<             KADD    = 71
---
>               KADD    = 71
2882c2970
<             KADD    = 90
---
>               KADD    = 90
2884c2972
<             KADD    = 36
---
>               KADD    = 36
2891c2979
<           CALL GBYTESC(MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
---
>           CALL GBYTES (MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
2895,2900c2983,2988
<             IF (KBMS(I)) THEN
<               DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10
<               II  = II + 1
<             ELSE
<               DATA(I) = 0.0
<             END IF
---
>               IF (KBMS(I)) THEN
>                   DATA(I) = (REFNCE + FLOAT(KSAVE(II)) * SCALE) * SCAL10
>                   II  = II + 1
>               ELSE
>                   DATA(I) = 0.0
>               END IF
2909,2912c2997
< 
<       call gbytec(MSGA,JSGN,KPTR(8),1)
<       call gbytec(MSGA,JEXP,KPTR(8)+1,7)
<       call gbytec(MSGA,IFR,KPTR(8)+8,24)
---
>       CALL GBYTE (MSGA,KKK,KPTR(8),32)
2914d2998
< 
2918a3003,3016
> C     1ST TEST TO SEE IN ON 32 OR 64 BIT WORD MACHINE
> C     LW = 4 OR 8;  IF 8 MAY BE A CRAY
> C
>       CALL W3FI01(LW)
>       IF (LW.EQ.4) THEN
>         CALL GBYTE (KK,JSGN,0,1)
>         CALL GBYTE (KK,JEXP,1,7)
>         CALL GBYTE (KK,IFR,8,24)
>       ELSE
>         CALL GBYTE (KK,JSGN,32,1)
>         CALL GBYTE (KK,JEXP,33,7)
>         CALL GBYTE (KK,IFR,40,24)
>       ENDIF
> C
2920a3019,3020
>       ELSE IF (JEXP.EQ.0.AND.IFR.EQ.0) THEN
>           REALKK  = 0.0
2926c3026
<       CALL GBYTESC(MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
---
>       CALL GBYTES (MSGA,KSAVE,KPTR(8),KBITS,0,KNR)
2931a3032
>       IF(ALLOCATED(KSAVE)) DEALLOCATE(KSAVE)
2948,2949c3049,3051
< C   95-04-26  R.E.JONES   FI636 CORECTION FOR 2ND ORDER COMPLEX 
< C                         UNPACKING.  
---
> C   95-04-26  R.E.JONES   FI636 CORECTION FOR 2ND ORDER COMPLEX
> C                         UNPACKING.
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
2986c3088
< C REMARKS:
---
> C REMARKS: SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
2993a3096
>       REAL         REFN
2998c3101
<       INTEGER      BMAP2(12500)
---
>       INTEGER      JREF,BMAP2(12500)
3003c3106
<       LOGICAL      KBMS(*)
---
>       LOGICAL*1    KBMS(*)
3006a3110
>       EQUIVALENCE  (JREF,REFN)
3008,3009d3111
<       SAVE
< 
3024,3025c3126,3127
<       CALL GBYTEC(MSGA,ISIGN,JPTR+32,1)
<       CALL GBYTEC(MSGA,KBDS(11),JPTR+33,15)
---
>       CALL GBYTE (MSGA,ISIGN,JPTR+32,1)
>       CALL GBYTE (MSGA,KBDS(11),JPTR+33,15)
3029a3132,3134
> C                  EXTRACT REFERENCE VALUE
>       CALL GBYTE(MSGA,JREF,JPTR+48,32)
> C     PRINT *,'DECODED REFERENCE VALUE =',REFN,REFNCE
3031c3136
<       CALL GBYTEC(MSGA,KBDS(13),JPTR+80,8)
---
>       CALL GBYTE(MSGA,KBDS(13),JPTR+80,8)
3035c3140
<       CALL GBYTEC(MSGA,KBDS(1),JPTR,16)
---
>       CALL GBYTE (MSGA,KBDS(1),JPTR,16)
3039c3144
<       CALL GBYTEC(MSGA,KFLAG,JPTR,8)
---
>       CALL GBYTE (MSGA,KFLAG,JPTR,8)
3041,3042c3146,3147
<       IF (AND(KFLAG,32).NE.0) THEN
<         KBDS(14) = 1
---
>       IF (IAND(KFLAG,32).NE.0) THEN
>         KBDS(14)  = 1
3044c3149
<         KBDS(14) = 0
---
>         KBDS(14)  = 0
3046,3047c3151,3152
<       IF (AND(KFLAG,16).NE.0) THEN
<         KBDS(16) = 1
---
>       IF (IAND(KFLAG,16).NE.0) THEN
>         KBDS(16)  = 1
3049c3154
<         KBDS(16) = 0
---
>         KBDS(16)  = 0
3051,3052c3156,3157
<       IF (AND(KFLAG,64).NE.0) THEN
<         KBDS(17) = 1
---
>       IF (IAND(KFLAG,64).NE.0) THEN
>         KBDS(17)  = 1
3054c3159
<         KBDS(17) = 0
---
>         KBDS(17)  = 0
3058c3163
<       CALL GBYTEC(MSGA,KBDS(2),JPTR,16)
---
>       CALL GBYTE (MSGA,KBDS(2),JPTR,16)
3062c3167
<       CALL GBYTEC(MSGA,KBDS(3),JPTR,16)
---
>       CALL GBYTE (MSGA,KBDS(3),JPTR,16)
3066c3171
<       CALL GBYTEC(MSGA,KBDS(4),JPTR,16)
---
>       CALL GBYTE (MSGA,KBDS(4),JPTR,16)
3113c3218
<                   PRINT *,'CANNOT BE USED HERE'
---
> C                 PRINT *,'CANNOT BE USED HERE'
3121c3226
<                       CALL GBYTEC(MSGA,NUMBER,LP,16)
---
>                       CALL GBYTE (MSGA,NUMBER,LP,16)
3136c3241
<               IF (AND(KGDS(11),32).EQ.0) THEN
---
>               IF (IAND(KGDS(11),32).EQ.0) THEN
3176c3281
<                   CALL GBYTEC(MSGA,KBIT,KBDS(6),1)
---
>                   CALL GBYTE (MSGA,KBIT,KBDS(6),1)
3185c3290
<                   CALL GBYTEC(MSGA,IFOVAL,KBDS(7),KBDS(13))
---
>                   CALL GBYTE (MSGA,IFOVAL,KBDS(7),KBDS(13))
3189c3294
<                   CALL GBYTEC(MSGA,KBDS(15),KBDS(5),8)
---
>                   CALL GBYTE (MSGA,KBDS(15),KBDS(5),8)
3203c3308
<                   CALL GBYTEC(MSGA,ISOVAL,KBDS(8),KBDS(15))
---
>                   CALL GBYTE (MSGA,ISOVAL,KBDS(8),KBDS(15))
3220c3325
<       SUBROUTINE FI637(*,J,KPDS,KGDS,KRET)
---
>       SUBROUTINE FI637(J,KPDS,KGDS,KRET)
3230a3336,3338
> C   95-10-31  IREDELL     REMOVED SAVES AND PRINTS
> C   97-02-12  W BOSTELMAN CORRECTS ECMWF US GRID 2 PROCESSING
> C   98-06-17  IREDELL     REMOVED ALTERNATE RETURN
3232c3340
< C USAGE:    CALL FI637(*,J,KPDS,KGDS,KRET)
---
> C USAGE:    CALL FI637(J,KPDS,KGDS,KRET)
3238a3347
> C     J        - SIZE FOR INDICATED GRID MODIFIED FOR ECMWF-US 2
3239a3349
> C                (A MISMATCH WAS DETECTED IF KRET IS NOT ZERO)
3244a3355,3356
> C   SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT.
> C
3255,3256d3366
<       SAVE
< 	KRET=0
3260c3370,3371
<       IF (AND(KPDS(4),128).EQ.0) RETURN
---
>       KRET=0
>       IF (IAND(KPDS(4),128).EQ.0) RETURN
3266a3378
>       KRET=1
3273c3385
<                RETURN 1
---
>                RETURN
3277c3389
<               RETURN 1
---
>               RETURN
3281c3393
<               RETURN 1
---
>               RETURN
3285c3397
<               RETURN 1
---
>               RETURN
3294c3406,3411
<                   RETURN 1
---
>                 IF (KPDS(3) .NE. 2) THEN 
>                   RETURN
>                 ELSEIF (I .NE. 10512) THEN ! Test for US Grid 2
>                   RETURN
>                 END IF
>                 J  = I   ! Set to US Grid 2, 2.5 Global
3298c3415
<               RETURN 1
---
>               RETURN
3307c3424
<                   RETURN 1
---
>                   RETURN
3311c3428
<               RETURN 1
---
>               RETURN
3317,3318c3434,3435
<           PRINT *,' NO CURRENT LISTING OF CANADIAN GRIDS'
<           RETURN 1
---
> C         PRINT *,' NO CURRENT LISTING OF CANADIAN GRIDS'
>           RETURN
3323,3324c3440,3441
<           PRINT *,' NO CURRENT LISTING OF JMA GRIDS'
<           RETURN 1
---
> C         PRINT *,' NO CURRENT LISTING OF JMA GRIDS'
>           RETURN
3331c3448
<                   RETURN 1
---
>                   RETURN
3335c3452
<                   RETURN 1
---
>                   RETURN
3339c3456
<                   RETURN 1
---
>                   RETURN
3343c3460
<               RETURN 1
---
>               RETURN
3352c3469
<                   RETURN 1
---
>                   RETURN
3356c3473,3477
<                   RETURN 1
---
>                   RETURN
>               END IF
>           ELSE IF (KPDS(3).EQ.8) THEN
>               IF (I.NE.J) THEN
>                   RETURN
3360c3481
<                   RETURN 1
---
>                   RETURN
3364c3485
<                   RETURN 1
---
>                   RETURN
3368c3489,3493
<                   RETURN 1
---
>                   RETURN
>               END IF
>           ELSE IF (KPDS(3).EQ.53) THEN
>               IF (I.NE.J) THEN
>                   RETURN
3372c3497
<                   RETURN 1
---
>                   RETURN
3376c3501
<                   RETURN 1
---
>                   RETURN
3380c3505
<                   RETURN 1
---
>                   RETURN
3384c3509
<                   RETURN 1
---
>                   RETURN
3388c3513
<                   RETURN 1
---
>                   RETURN
3392c3517
<                   RETURN 1
---
>                   RETURN
3396c3521
<                   RETURN 1
---
>                   RETURN
3399a3525,3528
>                   RETURN
>               END IF
>           ELSE IF (KPDS(3).EQ.190.OR.KPDS(3).EQ.192) THEN
>               IF (I.NE.J) THEN
3401a3531,3534
>           ELSE IF (KPDS(3).EQ.196) THEN
>               IF (I.NE.J) THEN
>                   RETURN
>               END IF
3404c3537
<                   RETURN 1
---
>                   RETURN
3408c3541
<               RETURN 1
---
>               RETURN
3412c3545
<           RETURN 1
---
>           RETURN
