C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: PDSEUP.F UNPACKS GRIB PDS EXTENSION 41- FOR ENSEMBLE C PRGMMR: RICHARD WOBUS ORG: W/NP20 DATE: 98-09-28 C C ABSTRACT: UNPACKS GRIB PDS EXTENSION STARTING ON BYTE 41 FOR ENSEMBLE C FORECAST PRODUCTS. FOR FORMAT OF PDS EXTENSION, SEE NMC OFFICE NOTE 38 C C PROGRAM HISTORY LOG: C 95-03-14 ZOLTAN TOTH AND MARK IREDELL C 95-10-31 IREDELL REMOVED SAVES AND PRINTS C 98-09-28 WOBUS CORRECTED MEMBER EXTRACTION C C USAGE: CALL PDSENS.F(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) C INPUT ARGUMENT LIST: C ILAST - LAST BYTE TO BE UNPACKED (IF GREATER/EQUAL TO FIRST BYT C IN ANY OF FOUR SECTIONS BELOW, WHOLE SECTION IS PACKED. C MSGA - FULL PDS SECTION, INCLUDING NEW ENSEMBLE EXTENSION C C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) C KENS(5) - BYTES 41-45 (GENERAL SECTION, ALWAYS PRESENT.) C KPROB(2) - BYTES 46-47 (PROBABILITY SECTION, PRESENT ONLY IF NEEDE C XPROB(2) - BYTES 48-51&52-55 (PROBABILITY SECTION, IF NEEDED.) C KCLUST(16)-BYTES 61-76 (CLUSTERING SECTION, IF NEEDED.) C KMEMBR(80)-BYTES 77-86 (CLUSTER MEMBERSHIP SECTION, IF NEEDED.) C C REMARKS: USE PDSENS.F FOR PACKING PDS ENSEMBLE EXTENSION. C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. C C ATTRIBUTES: C LANGUAGE: CF77 FORTRAN C MACHINE: CRAY, WORKSTATIONS C C$$$ C SUBROUTINE PDSEUP(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) INTEGER KENS(5),KPROB(2),KCLUST(16),KMEMBR(80) DIMENSION XPROB(2) INTEGER KREF CHARACTER*1 MSGA(100) REAL REFNCE C CHECKING TOTAL NUMBER OF BYTES IN PDS (IBYTES) CALL GBYTEC(MSGA, IBYTES, 0,24) IF(ILAST.GT.IBYTES) THEN C ILAST=IBYTES GO TO 333 ENDIF IF(ILAST.LT.41) THEN GO TO 333 ENDIF C UNPACKING FIRST SECTION (GENERAL INFORMATION) CALL GBYTESC(MSGA,KENS,40*8,8,0,5) C UNPACKING 2ND SECTION (PROBABILITY SECTION) IF(ILAST.GE.46) THEN CALL GBYTESC(MSGA,KPROB,45*8,8,0,2) C C call gbytec(MSGA,JSGN, 47*8, 1) call gbytec(MSGA,JEXP, 47*8+1, 7) call gbytec(MSGA,IFR, 47*8+8, 24) IF (IFR.EQ.0) THEN REFNCE = 0.0 ELSE REFNCE = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) IF (JSGN.NE.0) REFNCE = - REFNCE END IF XPROB(1)=REFNCE C call gbytec(MSGA,JSGN, 51*8, 1) call gbytec(MSGA,JEXP, 51*8+1, 7) call gbytec(MSGA,IFR, 51*8+8, 24) IF (IFR.EQ.0) THEN REFNCE = 0.0 ELSE REFNCE = FLOAT(IFR) * 16.0 ** (JEXP - 64 - 6) IF (JSGN.NE.0) REFNCE = - REFNCE END IF XPROB(2)=REFNCE ENDIF C C UNPACKING 3RD SECTION (CLUSTERING INFORMATION) IF(ILAST.GE.61) CALL GBYTESC(MSGA,KCLUST,60*8,8,0,16) C UNPACKING 4TH SECTION (CLUSTERMEMBERSHIP INFORMATION) IF(ILAST.GE.77) CALL GBYTESC(MSGA,KMEMBR,76*8,1,0,80) C 333 CONTINUE RETURN END