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 2001-06-05 IREDELL APPLY LINUX PORT BY EBISUZAKI 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) CHARACTER*1 MSGA(100) 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 CALL GBYTEC (MSGA,JSGN,47*8,1) CALL GBYTEC (MSGA,JEXP,47*8+1,7) CALL GBYTEC (MSGA,IFR,47*8+8,24) XPROB(1)=(-1)**JSGN*IFR*16.**(JEXP-70) C CALL GBYTEC (MSGA,JSGN,51*8,1) CALL GBYTEC (MSGA,JEXP,51*8+1,7) CALL GBYTEC (MSGA,IFR,51*8+8,24) XPROB(2)=(-1)**JSGN*IFR*16.**(JEXP-70) 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