1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
INTEGER FUNCTION MKBITMP(KWE,KNS,ZSEC4,ZMISS)
C
C---->
C**** MKBITMP
C
C Purpose
C -------
C
C Remove points using a bitmap.
C
C
C Interface
C ---------
C
C CALL MKBITMP(KWE,KNS,ZSEC4,ZMISS)
C
C Input
C -----
C
C KWE - Number of points west-east in input field.
C KNS - Number of points north-south in input field.
C ZSEC4 - GRIBEX section 4 values in the field.
C ZMISS - Value to be used as the missing data value..
C
C
C Output
C ------
C
C ZSEC4 - GRIBEX section 4 values with the points marked as
C 'missing' by the bitmap replaced by missing data values.
C
C Function returns 0 if all OK.
C
C
C Method
C ------
C
C The field and bitmap are rectangular.
C Use NOBITMP, the name of a file describing the bitmap.
C
C
C Externals
C ---------
C
C INTLOG - Log error message.
C INTLOGR - Log error message.
C MAKEMAP - Build a bitmap from definition in a file.
C GMAPBIT - Get the bit value from a given position in a bitmap.
C JFREE - Frees dynamically allocated memory.
C
C
C Author
C ------
C
C J.D.Chambers ECMWF April 2000.
C
C----<
C
IMPLICIT NONE
C
C Subroutine arguments
C
INTEGER KWE,KNS
REAL ZSEC4(*), ZMISS
C
C Parameters
C
INTEGER JPROUTINE
PARAMETER ( JPROUTINE = 44000 )
C
C Local variables
C
INTEGER IRET,BITMAP,NROWS,NCOLS,NVALUE,NEXT,IROW,ICOL,NINDEX
INTEGER OLDROWS, OLDCOLS, LOOP
CHARACTER*256 OLDFILE
DATA OLDFILE/' '/, BITMAP/-1/
SAVE BITMAP,OLDROWS,OLDCOLS,OLDFILE
C
C Externals
C
INTEGER MAKEMAP, GMAPBIT, JINDEX
EXTERNAL MAKEMAP, GMAPBIT, JINDEX
C
#include "parim.h"
#include "jparams.h"
#include "nofld.common"
C
C -----------------------------------------------------------------|
C* Section 1. Initialise
C -----------------------------------------------------------------|
C
100 CONTINUE
C
MKBITMP = 0
C
C Only build bitmap if filename has changed since last time through
C
NINDEX = JINDEX(NOBITMP)
IF( NINDEX.LT.1 ) THEN
CALL INTLOG(JP_WARN,'MKBITMP: No bitmap name given',JPQUIET)
CALL INTLOG(JP_WARN,'MKBITMP: BITMAP NOT APPLIED',JPQUIET)
MKBITMP = JPROUTINE + 1
GOTO 900
ENDIF
C
IF( OLDFILE(1:NINDEX).NE.NOBITMP(1:NINDEX) ) THEN
OLDFILE(1:NINDEX) = NOBITMP(1:NINDEX)
IF( NDBG.NE.0 )
X CALL INTLOG(JP_DEBUG,
X 'MKBITMP: New BITMAP: '//OLDFILE(1:NINDEX),JPQUIET)
C
IF( BITMAP.NE.-1 ) CALL JFREE(BITMAP)
C
IRET = MAKEMAP(NOBITMP,NROWS,NCOLS,BITMAP)
IF( IRET.NE.0 ) THEN
CALL INTLOG(JP_WARN,'MKBITMP: Failed to make bitmap',IRET)
CALL INTLOG(JP_WARN,'MKBITMP: BITMAP NOT APPLIED',JPQUIET)
DO LOOP = 1, 256
OLDFILE(LOOP:LOOP) = ' '
ENDDO
MKBITMP = JPROUTINE + 2
GOTO 900
ENDIF
OLDROWS = NROWS
OLDCOLS = NCOLS
ELSE
NROWS = OLDROWS
NCOLS = OLDCOLS
ENDIF
C
IF( (NROWS.NE.KNS).OR.(NCOLS.NE.KWE) ) THEN
CALL INTLOG(JP_WARN,'MKBITMP: Bitmap invalid for area',JPQUIET)
CALL INTLOG(JP_WARN,'MKBITMP: No. of subarea rows = ',KNS)
CALL INTLOG(JP_WARN,'MKBITMP: No. of subarea columns = ',KWE)
CALL INTLOG(JP_WARN,'MKBITMP: No. of bitmap rows = ',NROWS)
CALL INTLOG(JP_WARN,'MKBITMP: No. of bitmap columns = ',NCOLS)
CALL INTLOG(JP_WARN,'MKBITMP: BITMAP NOT APPLIED',JPQUIET)
MKBITMP = JPROUTINE + 3
GOTO 900
ENDIF
C
C -----------------------------------------------------------------|
C* Section 2. Use bitmap to force missing values
C -----------------------------------------------------------------|
C
200 CONTINUE
C
IF( NDBG.NE.0 )
X CALL INTLOG(JP_DEBUG,'MKBITMP: BITMAP applied',JPQUIET)
C
NEXT = 0
DO IROW = 1, KNS
DO ICOL = 1, KWE
NEXT = NEXT + 1
NVALUE = GMAPBIT(BITMAP,NCOLS,IROW,ICOL)
IF( NVALUE.EQ.0 ) ZSEC4(NEXT) = ZMISS
ENDDO
ENDDO
C
C -----------------------------------------------------------------|
C* Section 9. Closedown.
C -----------------------------------------------------------------|
C
900 CONTINUE
C
RETURN
END
|
