SUBROUTINE BCMAP_LAMP(KDATA,ND1,NUMPRJ,NSTA,ID)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . . .
C SUBPROGRAM: BCMAP MAPS MOS CATEGORIES TO BUFR CATEGORIES
C PRGMMR: WEISS ORG: W/OSD211 DATE: 01-03-21
C
C ABSTRACT: MAPS (TRANSLATES) MOS CATEGORICAL FORECAST VALUES TO THE
C CORRESPONDING BUFR CODE TABLE VALUES.
C
C PROGRAM HISTORY LOG:
C 93-12-03 GILBERT
C 01-01-31 WEISS REVISED FOR MODIFIED BUFRMOS
C 01-03-14 WEISS UPDATED IDS FOR THE AVN SHORT RANGE MESSAGE
C 01-03-21 WEISS UPDATED IDS AND TRANSLATIONS FOR THE MRF
C MEDIUM RANGE MESSAGE
C 02-01-02 RLC ADDED MAPPING FOR AVN OBVIS CATEGORICAL FCSTS
C CORRECTED AVN QPF CATEGORICAL IDS
C 03-07-30 RLC CHANGED MRF FORECAST IDS FROM MODEL NUMBER
C 9 TO 8 FOR GFS TRANSITION
C 04-09-03 MALONEY CHANGED AVN REFERENCES TO GFS; ADDED LOOPS
C TO HANDLE NEW CEILING AND VISIBILITY CATS;
C ADDED PROCESSING FOR NEW GFS/ETA SNOWFALL;
C ADDED IDS TO ALLOW ETA MOS PROCESSING.
C 05-08-04 MALONEY MADE CHANGES TO NEW VISIBILITY MAPPING
C 05-12-15 WEISS CONVERTED TO BUFRLAMP AND RENAMED BCMAP_LAMP
C 06-05-09 WEISS TOOK OUT ELSEIF STATEMENT WHEN LAMP CATEGORICAL
C PRODUCTS ARE GREATER THAN 2 SET TO 3.
C 06-05-10 WIEDENFELD CLEANUP UP CODE.
C 06-05-10 WIEDENFELD CHANGED 208643005 TO 208666005 FOR DIFFERENT
C LAMP AND MOS PCHAR ID'S
C 11-11-12 WEISS CHANGED 208351005 TO 208381005: TOTAL SKY COVER
C TO OPAQUE SKY COVER
C 14-03-27 HUANG COMMENTED OUT PROCESS FOR TSTM CAT (207501005)
C BECAUSE IN THE NEW SYSTEM THIS WAS ALREADY PACKED
C AS 0 AND 1 INSTEAD OF 1 AND 2.
C 17-04-05 SCHNAPP ADDED IDS 208071035 AND 208131035 FOR MELD CIG AND
C VIS
C 20-03-19 HUANG CHANGED 208381005 TO 208381035: MELD SKY COVER
C 20-07-19 HUANG CHANGED 208056005 TO 208056035 FOR MELD CCIG AND
C 208156005 TO 208156035 FOR MELD CVIS
C
C USAGE:
C MARCH 2001 WEISS IBM SP
C
C PURPOSE
C MAPS (TRANSLATES) MOS CATEGORICAL FORECAST VALUES TO THE
C CORRESPONDING BUFR CODE TABLE VALUES.
C
C DATA SET USE
C NONE
C
C VARIABLES
C KDATA(N,L) = HOLDS DATA FOR A FORECAST ELEMENT FOR EACH
C STATION AND EACH PROJECTION. 1ST DIMENSION IS
C # OF STATIONS, AND 2ND DIMENSION IS NUMBER OF
C PROJECTIONS. CONTAINS MISSING "9999" FOR
C PROJECTION FOR WHICH FORECASTS ARE NOT VALID.
C N=1,ND1, L=1,NUMPRJ (INPUT/OUTPUT).
C ND1 = MAXIMUM NUMBER OF STATIONS (INPUT).
C NUMPRJ = NUMBER OF PROJECTIONS IN MESSAGE (INPUT).
C NSTA = NUMBER OF STATIONS (INPUT).
C ID(4) = MOS FORECAST IDENTIFIER (INPUT).
C
C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE: IBM SP
C
C$$$
IMPLICIT NONE
C
INTEGER KDATA(ND1,NUMPRJ),ND1,NUMPRJ,NSTA,ID(4)
INTEGER I,J
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
CCC MAP CATEGORICAL VALUES CLOUD AMT
C GFS/ETA: SHORT RANGE *NEW*
IF(ID(1).EQ.208381035) THEN
DO 190 I=1,NSTA
DO 180 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=0
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=13
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=11
ELSEIF (KDATA(I,J).EQ.4) THEN
KDATA(I,J)=12
ELSEIF (KDATA(I,J).EQ.5) THEN
KDATA(I,J)=8
ENDIF
180 CONTINUE
190 CONTINUE
C
CCC MAP CATEGORICAL CONDITIONAL POP
C GFS/ETA: SHORT RANGE *NEW*
ELSEIF (ID(1).EQ.208666005) THEN
DO 195 I=1,NSTA
DO 185 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=3
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=1
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=2
ENDIF
185 CONTINUE
195 CONTINUE
C
CCC MAP CATEGORICAL VALUES POPO
CCC MAP CATEGORICAL VALUES THUNDERSTORMS
C GFS/ETA: SHORT RANGE *NEW*
C
C CH - ON MAR. 27, 2014, COMMENTED OUT
C PROCESS FOR 207501005 BECAUSE IN THE
C NEW CNV/LTG SYSTEM TSTM CAT WAS ALREADY
C PACKED AS 0 AND 1.
C
C ELSEIF ((ID(1).EQ.208621005).OR.
C 1 (ID(1).EQ.207501005)) THEN
C
ELSEIF (ID(1).EQ.208621005) THEN
DO 210 I=1,NSTA
DO 200 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=0
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=1
ENDIF
200 CONTINUE
210 CONTINUE
C
C
CCC MAP CATEGORICAL VALUES OBSTRUCTION TO VISION
C GFS: SHORT RANGE
ELSEIF (ID(1).EQ.208291005) THEN
DO 230 I=1,NSTA
DO 220 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=4
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=2
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=5
ELSEIF (KDATA(I,J).EQ.4) THEN
KDATA(I,J)=3
ELSEIF (KDATA(I,J).EQ.5) THEN
KDATA(I,J)=1
ENDIF
220 CONTINUE
230 CONTINUE
C
CCC MAP CATEGORICAL CEILING HGT
C GFS/ETA (NEW!)
ELSEIF (ID(1).EQ.208071005.OR.ID(1).EQ.208071035) THEN
DO 235 I=1,NSTA
DO 225 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=1
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=2
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=3
ELSEIF (KDATA(I,J).EQ.4) THEN
KDATA(I,J)=8
ELSEIF (KDATA(I,J).EQ.5) THEN
KDATA(I,J)=9
ELSEIF (KDATA(I,J).EQ.6) THEN
KDATA(I,J)=5
ELSEIF (KDATA(I,J).EQ.7) THEN
KDATA(I,J)=6
ELSEIF (KDATA(I,J).EQ.8) THEN
KDATA(I,J)=7
ENDIF
225 CONTINUE
235 CONTINUE
C
CCC MAP CATEGORICAL CONDITIONAL CEILING HGT
C GFS/ETA (NEW!)
ELSEIF (ID(1).EQ.208056035) THEN
DO 238 I=1,NSTA
DO 228 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=1
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=2
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=3
ELSEIF (KDATA(I,J).EQ.4) THEN
KDATA(I,J)=8
ELSEIF (KDATA(I,J).EQ.5) THEN
KDATA(I,J)=9
ELSEIF (KDATA(I,J).EQ.6) THEN
KDATA(I,J)=5
ELSEIF (KDATA(I,J).EQ.7) THEN
KDATA(I,J)=6
ELSEIF (KDATA(I,J).EQ.8) THEN
KDATA(I,J)=7
ENDIF
228 CONTINUE
238 CONTINUE
C
CCC MAP CATEGORICAL VISIBILITY
C GFS/ETA (NEW!)
ELSEIF (ID(1).EQ.208131005.OR.ID(1).EQ.208131035) THEN
DO 250 I=1,NSTA
DO 240 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=8
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=9
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=10
ELSEIF (KDATA(I,J).EQ.4) THEN
KDATA(I,J)=11
ELSEIF (KDATA(I,J).EQ.5) THEN
KDATA(I,J)=5
ELSEIF (KDATA(I,J).EQ.6) THEN
KDATA(I,J)=6
ELSEIF (KDATA(I,J).EQ.7) THEN
KDATA(I,J)=7
ENDIF
240 CONTINUE
250 CONTINUE
C
CCC MAP CATEGORICAL CONDITIONAL VISIBILITY
C GFS/ETA (NEW!)
ELSEIF (ID(1).EQ.208156035) THEN
DO 270 I=1,NSTA
DO 260 J=1,NUMPRJ
IF (KDATA(I,J).EQ.1) THEN
KDATA(I,J)=8
ELSEIF (KDATA(I,J).EQ.2) THEN
KDATA(I,J)=9
ELSEIF (KDATA(I,J).EQ.3) THEN
KDATA(I,J)=10
ELSEIF (KDATA(I,J).EQ.4) THEN
KDATA(I,J)=11
ELSEIF (KDATA(I,J).EQ.5) THEN
KDATA(I,J)=5
ELSEIF (KDATA(I,J).EQ.6) THEN
KDATA(I,J)=6
ELSEIF (KDATA(I,J).EQ.7) THEN
KDATA(I,J)=7
ENDIF
260 CONTINUE
270 CONTINUE
ENDIF
C
RETURN
END