LOGICAL FUNCTION IW3PDS(L1, L2, KEY)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C FUNCTION: IW3PDS TEST FOR MATCH OF TWO PDS
C AUTHOR: JONES, R.E. ORG: W342 DATE: 88-02-22
C
C ABSTACT: TEST TWO PDS (GRIB PRODUCT DEFINITION SECTION) TO SEE
C IF ALL EQUAL; OTHERWISE .FALSE. IF KEY = 1, ALL 24 CHARACTERS
C ARE TESTED, IF KEY = 0 , THE DATE (CHARACTERS 13-17) ARE NOT
C TESTED. IF KEY = 2, 11 OF 1ST 12 BYTES ARE TESTED. BYTE 4 IS
C IS NOT TESTED, SO TABLE VERSION NUMBER CAN CHANGE AND YOUR
C PROGRAM WILL STILL WORK. IF KEY=3, TEST BYTES 1-3, 7-12.
C
C PROGRAM HISTORY LOG:
C 88-02-22 R.E.JONES
C 89-08-29 R.E.JONES ADD ENTRY IW3PDS, AN ALIAS NAME.
C 89-08-29 R.E.JONES CHANGE TO CRAY CFT77 FORTRAN, MAKE IW3PDS
C THE FUNCTION NAME, IW3PDB THE ALIAS.
C 94-02-10 R.E.JONES ADD KEY=2, TEST ONLY 11 OF 1ST 12 BYTES.
C BYTE 4 (TABLE VERSION NO.) IS NOT TESTED
C 94-07-07 R.E.JONES ADD KEY=3, TEST BYTES 1-3, 7-12.
C
C USAGE: II = IW3PDS(L1,L2,KEY)
C II = IW3PDB(L1,L2,KEY) ALIAS
C
C INPUT VARIABLES:
C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES
C ------ --------- -----------------------------------------------
C L1 ARG LIST CHARACTER ARRAY TO MATCH WITH L2,
C L1 CAN ALSO BE A 3 WORD INTEGER ARRAY
C L2 ARG LIST CHARACTER ARRAY TO MATCH WITH L1,
C L2 CAN ALSO BE A 3 WORD INTEGER ARRAY
C KEY ARG LIST 0, DO NOT INCLUDE THE DATE (BYTES 13-17) IN
C MATCH.
C 1, MATCH 24 BYTES OF PDS
C 2, MATCH BYTES 1-3, 5-12 OF PDS
C 3, MATCH BYTES 1-3, 7-12 OF PDS
C
C OUTPUT VARIABLES:
C NAMES INTERFACE DESCRIPTION OF VARIABLES AND TYPES
C ------ --------- -----------------------------------------------
C IW3PDB FUNCTION LOGICAL .TRUE. IF L1 AND L2 MATCH ON ALL CHAR.,
C LOGICAL .FALSE. IF NOT MATCH ON ANY CHAR.
C
C EXAMPLE: SEARCH IDTBL FOR MATCH WITH GIVEN (PDS), USE RBA IN 7TH
C ID WORD TO READ RECORD BY RBA.
C
C INTEGER IDTBL(1794), IPDS(6), RBA
C LOGICAL IW3PDS
C
C KEY = 0
C DO 400 I = 9,1793,7
C IF (IDTBL(I).EQ.0) GO TO 500
C IF (IW3PDS(IPDS,IDTBL(I),KEY)) THEN
C RBA = IDTBL(I+6)
C GO TO 600
C END IF
C 400 CONTINUE
C
C 500 CONTINUE
C GO TO XXXX ... ERROR EXIT , CAN NOT FIND RECORD
C
C 600 .. READ RECORD WITH RBA
C
C REMARK: ALIAS ADDED BECAUSE OF NAME CHANGE IN GRIB WRITE UP.
C NAME OF PDB (PRODUCT DEFINITION BLOCK) WAS CHANGD TO PDS
C (PRODUCT DEFINITION SECTION).
C
C ATTRIBUTES:
C LANGUAGE: CRAY CFT77 FORTRAN
C MACHINE: CRAY C916-128, CRAY Y-MP8/864, CRAY Y-MP EL2/256
C
C$$$
C
CHARACTER*1 L1(24)
CHARACTER*1 L2(24)
C
LOGICAL IW3PDB
C
SAVE
C
IW3PDS = .TRUE.
C
IF (KEY.EQ.1) THEN
DO 10 I = 1,3
IF (L1(I).NE.L2(I)) GO TO 70
10 CONTINUE
C
DO 20 I = 5,24
IF (L1(I).NE.L2(I)) GO TO 70
20 CONTINUE
C
ELSE
C
DO 30 I = 1,3
IF (L1(I).NE.L2(I)) GO TO 70
30 CONTINUE
C
C DO NOT TEST BYTE 4, 5, 6 PDS VER. NO., COUNTRY
C MODEL NUMBER. U.S., U.K., FNOC WAFS DATA WILL
C WORK.
C
IF (KEY.EQ.3) THEN
DO I = 7,12
IF (L1(I).NE.L2(I)) GO TO 70
END DO
GO TO 60
END IF
C
C DO NOT TEST PDS VERSION NUMBER, IT MAY BE 1 O 2
C
DO 40 I = 5,12
IF (L1(I).NE.L2(I)) GO TO 70
40 CONTINUE
IF (KEY.EQ.2) GO TO 60
C
DO 50 I = 18,24
IF (L1(I).NE.L2(I)) GO TO 70
50 CONTINUE
ENDIF
C
60 CONTINUE
RETURN
C
70 CONTINUE
IW3PDS = .FALSE.
RETURN
C
ENTRY IW3PDB (L1, L2, KEY)
C
IW3PDB = .TRUE.
C
IF (KEY.EQ.1) THEN
DO 80 I = 1,3
IF (L1(I).NE.L2(I)) GO TO 140
80 CONTINUE
C
DO 90 I = 5,24
IF (L1(I).NE.L2(I)) GO TO 140
90 CONTINUE
C
ELSE
C
DO 100 I = 1,3
IF (L1(I).NE.L2(I)) GO TO 140
100 CONTINUE
C
C DO NOT TEST BYTE 4, 5, 6 PDS VER. NO., COUNTRY
C MODEL NUMBER. U.S., U.K., FNOC WAFS DATA WILL
C WORK.
C
IF (KEY.EQ.3) THEN
DO I = 7,12
IF (L1(I).NE.L2(I)) GO TO 140
END DO
GO TO 130
END IF
C
C DO NOT TEST PDS VERSION NUMBER, IT MAY BE 1 O 2
C
DO 110 I = 5,12
IF (L1(I).NE.L2(I)) GO TO 140
110 CONTINUE
IF (KEY.EQ.2) GO TO 130
C
DO 120 I = 18,24
IF (L1(I).NE.L2(I)) GO TO 140
120 CONTINUE
ENDIF
C
130 CONTINUE
RETURN
C
140 CONTINUE
IW3PDB = .FALSE.
RETURN
END