C$$$ MAIN PROGRAM DOCUMENTATION BLOCK
C . . . .
C MAIN PROGRAM: MDL_BUFRLAMP2
C PRGMMR: ERICKSON ORG: OST22 DATE: 2002-01-11
C
C ABSTRACT: THIS PROGRAM GENERATES AND POSTS A BUFR MESSAGE
C CONTAINING MDL MOS FORECASTS FOR SPECIFIED STATIONS.
C THIS BUFR MESSAGE TREATS EACH PROJECTION OF EACH STATION
C AS A SUBSET, AND THE DATA ARE STORED IN COMPRESSED
C FORMAT. WMO'S BUFR EDITION 2 IS CURRENTLY BEING USED.
C
C PROGRAM HISTORY LOG:
C 93-12-03 GILBERT
C 96-02-20 GILBERT - CONVERTED TO CRAY
C 96-04-15 GILBERT - ADDED SUBROUTINE LATLON FOR PROCESSING
C OF STATION LATITUDES AND LONGITUDES.
C 96-08-23 GILBERT - FIXED PROBLEM WITH THE WMO HEADER GENERATED
C IN SUBROUTINE BUFRGN.
C 98-07-07 SHIREY - CHANGED GTDATE TO GETDATE (2X) FOR Y2K.
C 98-07-23 ERICKSON - CHANGED SUBRT BUFRGN FOR Y2K
C 00-03-07 ALLEN - CONVERTED TO RUN ON THE IBM SP. CHANGES WERE
C MADE TO BUFRGN TO WRITE THE OUTPUT FILE AS A
C DIRECT ACCESS FILE.
C 01-03 SHIREY - REVAMPED BUFR CODE FOR MOS-2000 SOFTWARE
C CHANGED SEVERAL DIMENSIONS IN ORDER TO HANDLE
C LARGER MESSAGES. CHANGED READER TO READ_MOSDA.
C THE CODE NOW USES 32 BIT ROUTINES. SEVERAL
C TDLLIB ROUTINES WERE REPLACED WITH MOS2000
C ROUTINES. ALSO, SEVERAL PROCESSING ROUTINES
C WERE DELETED SINCE THIS PROCESSING IN NOW DONE
C IN U910
C 02-01-02 COSGROVE - INCREASED MAXSTA TO ACCOMMODATE 1432 SITES.
C MODIFIED BCMAP TO CORRECTLY CHANGE CATEGORICAL
C FORECASTS FOR AVN VISOBV.
C 02-01-02 ERICKSON - MODIFIED LATLON ROUTINE TO HANDLE SCALED VALUES
C OF 9997 AND 9999 CORRECTLY.
C 03-04-16 COSGROVE - INCREASED MAXSTA TO ACCOMMODATE THE NEW MARINE
C SITES AND THE NEW MOS SITES WE ARE ADDING IN THE
C FALL
C 04-11-18 COSGROVE - ADDED ARRAY INDEX TO CALL TO BUFOPT BECAUSE IT WAS
C GETTING CLOBBERED ON BLUE BECAUSE IT WAS A LOCAL
C ARRAY.
C 05-07-22 MALONEY - INCREASED MAXPRJ TO 70 TO HANDLE NEW MEX BUFR
C 05-12-07 WEISS - CHANGED NAME TO BUFRLAMP_02.F AND WILL USE THE
C LATEST SETTINGS FOR THE TIME BEING.
C 11-10-12 WEISS - CHANGED MAXSTA FROM 3500 TO 5000 TO BE ABLE TO
C READ THE INPUT LAMP FORECAST FILE.
C 12-11-06 GHIRARDELLI - REMOVED TESTING write(6,*) STATEMENTS
C 17-05-03 GUARRIELLO - INCREASED MAXSTA TO 6000
C 18-09-27 SINDIC-RANCIC - INCREASED PROJECTIONS TO 38, CHANGED LTEMP
C CFMT DIMENSIONS FROM 18 TO 20 TO ALLOW 38
C PROJECTIONS TO BE READ FROM 2 LINES.
C
C USAGE:
C
C PROGRAM BUFRMOS
C
C JULY 1992 GILBERT TDL NAS9000
C
C PURPOSE
C THIS PROGRAM GENERATES AND POSTS A BUFR MESSAGE
C CONTAINING TDL MOS FORECASTS FOR SPECIFIED STATIONS.
C THIS BUFR MESSAGE TREATS EACH PROJECTION OF EACH STATION
C AS A SUBSET, AND THE DATA ARE STORED IN COMPRESSED
C FORMAT. WMO'S BUFR EDITION 2 IS CURRENTLY BEING USED.
C
C DATA SET USE
C FT05F001 - DATA CONTROL RECORDS (INPUT)
C FT06F001 - PRINT FILE. (OUTPUT)
C FT25F001 - STATION LIST & WMO HEADERS (INPUT)
C FT27F001 - STATION LIST (INPUT)
C FT60F001 - TRANSMISSION FILE (OUTPUT)
C FT10F001 - NMC DATE FILE (INPUT)
C MOSMATXX - MOSMAT FILE (XX = 00 OR 12) (INPUT)
C
C VARIABLES
C MAXSTA = MAXIMUM NUMBER OF STATIONS IN STATION DICTIONARY
C -(MUST ACTUALLY BE # OF STAS X 2 FOR READ_MOSDA)
C MAXPRJ = MAXIMUM NUMBER OF PROJECTIONS
C MAXDSC = MAXIMUM NUMBER OF DESCRIPTORS
C MAXMES = MAXIMUM NUMBER OF BYTES IN A BUFR MESSAGE
C MAXBUL = MAXIMUM NUMBER OF WMO HEADERS
C CSTA() = LIST OF STATION CALL LETTERS
C WMO() = LIST OF WMO HEADERS
C NWMO(I) = NUMBER OF STATIONS FOR HEADER WMO(I)
C LPROJ() = LIST OF PROJECTIONS FOR WHICH FORECASTS ARE
C ENCODED
C KDATA(,) = HOLDS DATA FOR A FORECAST ELEMENT FOR EACH
C STATION AND EACH PROJECTION. 1ST DIMENSION IS
C # OF STATIONS, AND 2ND DIMENSION IS NUMBER OF
C PROJECTIONS. CONTAINS MISSING "9999" FOR
C PROJECTION FOR WHICH FORECASTS ARE NOT VALID.
C MBUF(,) = HOLDS FORECASTS AFTER THEY ARE PACKED INTO BUFR
C FORMAT. 1ST DIMENSION IS # OF BYTES IN BUFR
C MESSAGE, AND 2ND DIMENSION IS # OF BULLETINS
C (WMO HEADERS).
C IVPRJ() = CONTAINS VALID PROJECTIONS FOR THE CURRENT
C FORECAST ELEMENT.
C NBPB() = # OF BITS IN EACH BULLETIN.
C NBUL = NUMBER OF BUFR BULLETINS (WMO HEADERS)
C IYR = CURRENT YEAR (4 DIGITS)
C IMO = CURRENT MONTH
C IDA = CURRENT DAY
C IHR = CURRENT CYCLE ( = 00 OR 12)
C NDATE = CURRENT DATE
C CFLAG = SWITCH THAT PLACES MISSINGS FOR WINTER
C PRODUCTS IN THE SUMMER.
C KFILDI = DATA SET REFERNCE NUMBER FOR INPUT HEADERS
C AND STATION LIST.
C NUNIT = DATA SET REFERENCE NUMBER FOR INPUT CONTROL
C RECORDS.
C IEND = FLAG INDICATING END OF INPUT CONTROL RECORDS.
C ITERM = TERMINATOR FOR LIST OF PROJRCTIONS.
C NUMPRJ = NUMBER OF PROJECTIONS IN MESSAGE
C CCALL(ND1,6) = CALL LETTERS OF THE STATIONS
C CFMT = FORMAT OF INPUT CARD LINES TO READ
C KFILDO = PRINT FILE
C KFILX = UNIT # FOR MOS FCST FILE
C CSEC2 = DESCRIPTION OF BUFR MESSAGE (IN SECT 2)
C INDEX(K,L) = ARRAY CONTAINING LOCATION OF STATION K IN FILE
C DIRECTORY L, WHERE K=1,NSTA AND L=1,15
C "READ_MOSDA" (INPUT/OUTPUT)
C
C SUBPROGRAMS CALLED:
C UNIQUE: - BDRIVR, BPACK, BUFOPT, BUFRGN, RDWMO, BCATGR,
C BPROB, BPROJ, BSPEC, BTMPDP, BWDIR, BWSPD,
C BCLDMR, BDATE, BGENER, BNMLFQ, BCMAP, GETCON
C LIBRARY:
C W3LIB - W3TAG, W3FK40, W3AI15, W3FI62, GBYTE,
C SBYTE, W3UTCDAT
C MDLLIB - GET_NCEPDATE, RDC,RDI
C
C EXIT STATES:
C COND = 0 - SUCCESSFUL RUN
C = 10 - PROBLEM READING NMC DATE FILE
C = 200 - PROBLEM POSTING TRANSMISSION FILE
C
C REMARKS: LIST CAVEATS, OTHER HELPFUL HINTS OR INFORMATION
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE: SP
C
C$$$
PROGRAM BUFRLAMP
CCC PARAMETER (MAXSTA=3500,MAXPRJ=70,MAXDSC=150,MAXMES=3000000)
CGSR PARAMETER (MAXSTA=6000,MAXPRJ=25,MAXDSC=150,MAXMES=3000000)
CGSR INCREASED MAXPROJ FROM 25 TO 38
C PARAMETER (MAXSTA=6000,MAXPRJ=38,MAXDSC=150,MAXMES=3000000)
PARAMETER (MAXSTA=10000,MAXPRJ=38,MAXDSC=150,MAXMES=3000000)
CC PARAMETER (MAXBUL=150)
PARAMETER (MAXBUL=20)
CHARACTER*1 CFLAG,MBUF(MAXMES,MAXBUL)
CHARACTER*8 CSTA(MAXSTA),CCALL(MAXSTA,6),CFMT
CHARACTER*11 WMO(MAXBUL)
CHARACTER*21 CSEC2
CGSR INCREASED LTEMP DIMENNSION FROM 18 TO 20
C TO ACCOMODATE 38 PROJECTIONS IN 2 LINES
INTEGER KFILDO,KFILDI
INTEGER NWMO(MAXBUL),KDATA(MAXSTA,MAXPRJ),LDESC(MAXDSC),ID(4),
* LPROJ(MAXPRJ),LTEMP(20),NBPB(MAXBUL),IVPRJ(MAXPRJ),
CGSR INCREASED CFMT DIMENNSION FROM 18 TO 20
C TO ACCOMODATE 38 PROJECTIONS IN 2 LINES
* INDEX(MAXSTA,15)
DATA KFILDI/5/,NUNIT/25/,CFMT/'(20I4) '/,ITERM/9999/,IEND/0/,
* NDESC/0/,NBPB/MAXBUL*0/,ICND/0/,KFILX/40/,
* IUNIT/10/,KFILDO/6/,KFILD/27/
CALL W3TAGB('MDL_BUFRLAMP2',2002,0011,0066,'OST22')
C
C GET DESCRIPTION FOR SECTION 2 OF BUFR MESSAGE
C
READ(NUNIT,3)CSEC2
3 FORMAT(A21)
C
C GET CURRENT DATE FROM NMC'S DATE FILE.
C
CALL GET_NCEPDATE(IUNIT,IYR,IMO,IDA,IHR,NDATE,IERR)
IF (IERR.NE.0) THEN
WRITE(KFILDO,10) IERR
10 FORMAT(' PROBLEM READING DATE FILE. IERR = ',I4)
CALL W3TAGE('MDL_BUFRLAMP2')
CALL EXIT(10)
ENDIF
IDATE=(IMO*100)+IDA
C
C READ WMO HEADERS AND ASSOCIATED STATION LISTS.
C
CALL RDWMO(NUNIT,NSTA,CSTA,WMO,NWMO,NBUL,MAXSTA,MAXBUL)
C
NEW=0
CALL RDLNK(KFILD,KFILDO,NEW,CSTA,CCALL,NSTA,MAXSTA)
C
C READ LIST OF PROJECTIONS
C
CGSR INCREASED DIMENNSION FROM 18 TO 20 BELOW
C TO CORRECTELY PASS ARGUMENTS LTEMP AND CFMT
CALL RDI(KFILDO,0,KFILDI,LPROJ,MAXPRJ,LTEMP,20,CFMT,NUMPRJ,
* ITERM,IER)
CGSR ERROR DIAGNOSTIC - remove when done
CGSR WRITE(KFILDO,111) NUMPRJ,LTEMP,LPROJ
CGSR 111 FORMAT(/'NUMPRJ=',I4,/'LTEMP',20I4, /'LPROJ', 40I4)
C READ A SET OF CONTROL RECORDS FROM THE INPUT CONTROL FILE.
100 CALL BDRIVR(ID,MAXDSC,LDESC,NDESC,SCALE,REF,NBITS,
* IVPRJ,MAXPRJ,NVPRJ,CFLAG,IEND,IOPT,KFILDI)
CGSR ERROR DIAGNOSTIC - remove when done
CGSR WRITE(KFILDO,112) NDESC,LDESC,IVPRJ,NVPRJ
CGSR 112 FORMAT(/'NDESC=',I4,/'LDESC=',150I6,/'IVPRJ=',38I4,/' NVPRJ=',I4)
C IEND = 1 INDICATES THE END OF THE INPUT CONTROL RECORDS.
IF (IEND.EQ.0) THEN
C GET FORECASTS DATA AND DO NECESSARY CONVERSIONS TO PREPARE
C THE DATA FOR PACKING.
CALL BUFOPT(KFILDO,KFILX,NSTA,CCALL,KDATA,ID,LPROJ,
* SCALE,REF,NDATE,MAXSTA,IVPRJ,NVPRJ,NUMPRJ,IOPT,
* 0,MAXSTA,54,INDEX,ICND)
C CHECK TO SEE IF SNOW FORECASTS SHOULD BE CHECKED FOR AN
C INVALID SEASON.
IF (CFLAG.EQ.'*') THEN
CALL SEACHK(IDATE,KDATA,MAXSTA,NUMPRJ,WMO,NWMO,NBUL)
ENDIF
C PACK CONVERTED AND SCALED DATA INTO MBUF.
CALL BPACK(NSTA,KDATA,CSTA,NBITS,MBUF,NWMO,NBPB,NBUL,MAXSTA,
* NUMPRJ,MAXMES,IOPT)
GOTO 100
ENDIF
C GENERATE ALL BUFR BULLETINS.
CALL BUFRGN(NSTA,WMO,NWMO,NBUL,LDESC,NDESC,MBUF,NBPB,IYR,IMO,
* IDA,IHR,MAXMES,NUMPRJ,CSTA,CSEC2)
CALL W3TAGE('TDL_BUFRMOS2')
STOP
END