110 lines
3.1 KiB
Fortran
110 lines
3.1 KiB
Fortran
SUBROUTINE W3FI73 (IBFLAG,IBMAP,IBLEN,BMS,LENBMS,IER)
|
|
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
|
|
C . . . .
|
|
C SUBPROGRAM: W3FI73 CONSTRUCT GRIB BIT MAP SECTION (BMS)
|
|
C PRGMMR: FARLEY ORG: NMC421 DATE:92-11-16
|
|
C
|
|
C ABSTRACT: THIS SUBROUTINE CONSTRUCTS A GRIB BIT MAP SECTION.
|
|
C
|
|
C PROGRAM HISTORY LOG:
|
|
C 92-07-01 M. FARLEY ORIGINAL AUTHOR
|
|
C 94-02-14 CAVANAUGH RECODED
|
|
C 98-06-30 EBISUZAKI LINUX PORT
|
|
C
|
|
C USAGE: CALL W3FI73 (IBFLAG, IBMAP, IBLEN, BMS, LENBMS, IER)
|
|
C INPUT ARGUMENT LIST:
|
|
C IBFLAG - 0, IF BIT MAP SUPPLIED BY USER
|
|
C - #, NUMBER OF PREDEFINED CENTER BIT MAP
|
|
C IBMAP - INTEGER ARRAY CONTAINING USER BIT MAP
|
|
C IBLEN - LENGTH OF BIT MAP
|
|
C
|
|
C OUTPUT ARGUMENT LIST:
|
|
C BMS - COMPLETED GRIB BIT MAP SECTION
|
|
C LENBMS - LENGTH OF BIT MAP SECTION
|
|
C IER - 0 NORMAL EXIT, 8 = IBMAP VALUES ARE ALL ZERO
|
|
C
|
|
C SUBPROGRAMS CALLED:
|
|
C LIBRARY:
|
|
C W3LIB - SBYTE
|
|
C
|
|
C ATTRIBUTES:
|
|
C LANGUAGE: IBM370 VS FORTRAN 77, CRAY CFT77 FORTRAN
|
|
C MACHINE: HDS, CRAY C916/256, CRAY J916/2048
|
|
C
|
|
C$$$
|
|
C
|
|
INTEGER IBMAP(*)
|
|
INTEGER LENBMS
|
|
INTEGER IBLEN
|
|
INTEGER IBFLAG
|
|
C
|
|
CHARACTER*1 BMS(*)
|
|
C
|
|
C ================================= RCS keyword statements ==========
|
|
CHARACTER*68 RCSKW1,RCSKW2
|
|
DATA RCSKW1,RCSKW2 / '
|
|
.$Source: /fs/hseb/ob72/wfo_rfc/precip_proc/source/gribit/src/RCS/w3fi73.f,v $
|
|
. $', '
|
|
.$Id: w3fi73.f,v 1.1 2006/05/03 13:44:00 gsood Exp $
|
|
. $' /
|
|
C ===================================================================
|
|
C
|
|
C
|
|
IER = 0
|
|
C
|
|
IZ = 0
|
|
DO 20 I = 1, IBLEN
|
|
IF (IBMAP(I).EQ.0) IZ = IZ + 1
|
|
20 CONTINUE
|
|
IF (IZ.EQ.IBLEN) THEN
|
|
C
|
|
C AT THIS POINT ALL BIT MAP POSITIONS ARE ZERO
|
|
C
|
|
IER = 8
|
|
RETURN
|
|
END IF
|
|
C
|
|
C BIT MAP IS A COMBINATION OF ONES AND ZEROS
|
|
C OR BIT MAP ALL ONES
|
|
C
|
|
C CONSTRUCT BIT MAP FIELD OF BIT MAP SECTION
|
|
C
|
|
CALL SBYTESC(BMS,IBMAP,48,1,0,IBLEN)
|
|
C
|
|
IF (MOD(IBLEN,16).NE.0) THEN
|
|
NLEFT = 16 - MOD(IBLEN,16)
|
|
ELSE
|
|
NLEFT = 0
|
|
END IF
|
|
C
|
|
NUM = 6 + (IBLEN+NLEFT) / 8
|
|
C
|
|
C CONSTRUCT BMS FROM COLLECTED DATA
|
|
C
|
|
C SIZE INTO FIRST THREE BYTES
|
|
C
|
|
CALL SBYTEC(BMS,NUM,0,24)
|
|
C NUMBER OF FILL BITS INTO BYTE 4
|
|
CALL SBYTEC(BMS,NLEFT,24,8)
|
|
C OCTET 5-6 TO CONTAIN INFO FROM IBFLAG
|
|
CALL SBYTEC(BMS,IBFLAG,32,16)
|
|
C
|
|
C BIT MAP MAY BE ALL ONES OR A COMBINATION
|
|
C OF ONES AND ZEROS
|
|
C
|
|
C ACTUAL BITS OF BIT MAP PLACED ALL READY
|
|
C
|
|
C INSTALL FILL POSITIONS IF NEEDED
|
|
IF (NLEFT.NE.0) THEN
|
|
NLEFT = 16 - NLEFT
|
|
C ZERO FILL POSITIONS
|
|
CALL SBYTEC(BMS,0,IBLEN+48,NLEFT)
|
|
END IF
|
|
C
|
|
C STORE NUM IN LENBMS (LENGTH OF BMS SECTION)
|
|
C
|
|
LENBMS = NUM
|
|
C PRINT *,'W3FI73 - BMS LEN =',NUM,LENBMS
|
|
C
|
|
RETURN
|
|
END
|