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