NCEPLIBS-w3emc
2.11.0
iw3pds.f
Go to the documentation of this file.
1
C> @file
2
C> @brief Test two pds (grib product definition section) to see
3
C> if all equal; otherwise .false.
4
C> @author Ralph Jones @date 1988-02-22
5
C> FUNCTION: IW3PDS TEST FOR MATCH OF TWO PDS
6
C> AUTHOR: JONES, R.E. ORG: W342 DATE: 88-02-22
7
C>
8
C> Test two pds (grib product definition section) to see
9
C> if all equal; otherwise .false. if key = 1, all 24 characters
10
C> are tested, if key = 0 , the date (characters 13-17) are not
11
C> tested. If key = 2, 11 of 1st 12 bytes are tested. Byte 4 is
12
C> is not tested, so table version number can change and your
13
C> program will still work. If key=3, test bytes 1-3, 7-12.
14
C>
15
C> Program history log:
16
C> - Ralph Jones 1988-02-22
17
C> - Ralph Jones 1989-08-29 Add entry iw3pds, an alias name.
18
C> - Ralph Jones 1989-08-29 Change to cray cft77 fortran, make iw3pds
19
C> the function name, iw3pdb the alias.
20
C> - Ralph Jones 1994-02-10 Add key=2, test only 11 of 1st 12 bytes.
21
C> Byte 4 (table version no.) is not tested.
22
C> - Ralph Jones 1994-07-07 Add key=3, test bytes 1-3, 7-12.
23
C>
24
C> USAGE: II = IW3PDS(L1,L2,KEY)
25
C> II = IW3PDB(L1,L2,KEY) ALIAS
26
C>
27
C> @param[in] L1 character array to match with l2,
28
C> l1 can also be a 3 word integer array.
29
C> @param[in] L2 character array to match with l1,
30
C> l2 can also be a 3 word integer array.
31
C> @param[in] KEY 0, DO NOT INCLUDE THE DATE (BYTES 13-17) IN MATCH.
32
C> - 1, match 24 bytes of pds
33
C> - 2, match bytes 1-3, 5-12 of pds
34
C> - 3, match bytes 1-3, 7-12 of pds
35
C> @param[out] IW3PDB logical .true. if l1 and l2 match on all char.,
36
C> logical .false. if not match on any char.
37
C>
38
C> @note Alias added because of name change in grib write up.
39
C> Name of pdb (product definition block) was changd to pds
40
C> (product definition section).
41
C>
42
LOGICAL
FUNCTION
iw3pds(L1, L2, KEY)
43
C
44
CHARACTER*1
L1(24)
45
CHARACTER*1
L2(24)
46
C
47
LOGICAL
IW3PDB
48
C
49
SAVE
50
C
51
iw3pds = .true.
52
C
53
IF
(key.EQ.1)
THEN
54
DO
10 i = 1,3
55
IF
(l1(i).NE.l2(i))
GO TO
70
56
10
CONTINUE
57
C
58
DO
20 i = 5,24
59
IF
(l1(i).NE.l2(i))
GO TO
70
60
20
CONTINUE
61
C
62
ELSE
63
C
64
DO
30 i = 1,3
65
IF
(l1(i).NE.l2(i))
GO TO
70
66
30
CONTINUE
67
C
68
C DO NOT TEST BYTE 4, 5, 6 PDS VER. NO., COUNTRY
69
C MODEL NUMBER. U.S., U.K., FNOC WAFS DATA WILL
70
C WORK.
71
C
72
IF
(key.EQ.3)
THEN
73
DO
i = 7,12
74
IF
(l1(i).NE.l2(i))
GO TO
70
75
END DO
76
GO TO
60
77
END IF
78
C
79
C DO NOT TEST PDS VERSION NUMBER, IT MAY BE 1 O 2
80
C
81
DO
40 i = 5,12
82
IF
(l1(i).NE.l2(i))
GO TO
70
83
40
CONTINUE
84
IF
(key.EQ.2)
GO TO
60
85
C
86
DO
50 i = 18,24
87
IF
(l1(i).NE.l2(i))
GO TO
70
88
50
CONTINUE
89
ENDIF
90
C
91
60
CONTINUE
92
RETURN
93
C
94
70
CONTINUE
95
iw3pds = .false.
96
RETURN
97
C
98
entry iw3pdb(l1, l2, key)
99
C
100
iw3pdb = .true.
101
C
102
IF
(key.EQ.1)
THEN
103
DO
80 i = 1,3
104
IF
(l1(i).NE.l2(i))
GO TO
140
105
80
CONTINUE
106
C
107
DO
90 i = 5,24
108
IF
(l1(i).NE.l2(i))
GO TO
140
109
90
CONTINUE
110
C
111
ELSE
112
C
113
DO
100 i = 1,3
114
IF
(l1(i).NE.l2(i))
GO TO
140
115
100
CONTINUE
116
C
117
C DO NOT TEST BYTE 4, 5, 6 PDS VER. NO., COUNTRY
118
C MODEL NUMBER. U.S., U.K., FNOC WAFS DATA WILL
119
C WORK.
120
C
121
IF
(key.EQ.3)
THEN
122
DO
i = 7,12
123
IF
(l1(i).NE.l2(i))
GO TO
140
124
END DO
125
GO TO
130
126
END IF
127
C
128
C DO NOT TEST PDS VERSION NUMBER, IT MAY BE 1 O 2
129
C
130
DO
110 i = 5,12
131
IF
(l1(i).NE.l2(i))
GO TO
140
132
110
CONTINUE
133
IF
(key.EQ.2)
GO TO
130
134
C
135
DO
120 i = 18,24
136
IF
(l1(i).NE.l2(i))
GO TO
140
137
120
CONTINUE
138
ENDIF
139
C
140
130
CONTINUE
141
RETURN
142
C
143
140
CONTINUE
144
iw3pdb = .false.
145
RETURN
146
END
src
iw3pds.f
Generated by
1.9.1
1.9.1 1.9.1