C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: PDSENS.F PACKS GRIB PDS EXTENSION 41- FOR ENSEMBLE C PRGMMR: RICHARD WOBUS ORG: W/NP20 DATE: 98-09-28 C C ABSTRACT: PACKS BRIB 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 ENTRY, BLANK ALL UNUSED FIELDS 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 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 ILAST - LAST BYTE TO BE PACKED (IF GREATER OR EQUAL TO FIRST BY C IN ANY OF FOUR SECTIONS ABOVE, WHOLE SECTION IS PACKED. C C OUTPUT ARGUMENT LIST: (INCLUDING WORK ARRAYS) C MSGA - FULL PDS SECTION, INCLUDING NEW ENSEMBLE EXTENSION C C REMARKS: USE PDSEUP.F FOR UNPACKING PDS ENSEMBLE EXTENSION. C SUBPROGRAM CAN BE CALLED FROM A MULTIPROCESSING ENVIRONMENT. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: CRAY, WORKSTATIONS C C$$$ C TESTING GRIB EXTENSION 41- PACKER AND UNPACKER SUBROUTINES C CFPP$ NOCONCUR R SUBROUTINE PDSENS(KENS,KPROB,XPROB,KCLUST,KMEMBR,ILAST,MSGA) INTEGER KENS(5),KPROB(2),KCLUST(16),KMEMBR(80) DIMENSION XPROB(2) CHARACTER*1 MSGA(100) IF(ILAST.LT.41) THEN GO TO 333 ENDIF C PACKING IS DONE IN FOUR SECTIONS ENDING AT BYTE IL IF(ILAST.GE.41) IL=45 IF(ILAST.GE.46) IL=55 IF(ILAST.GE.61) IL=76 IF(ILAST.GE.77) IL=86 do i=42,il CALL SBYTEC(MSGA, 0, i*8, 8) enddo C CHANGING THE NUMBER OF BYTES (FIRST THREE BYTES IN PDS) CALL SBYTEC(MSGA, IL, 0,24) C PACKING FIRST SECTION (GENERAL INTORMATION SECTION) IF(IL.GE.45) CALL SBYTESC(MSGA,KENS,40*8,8,0,5) C PACKING 2ND SECTION (PROBABILITY SECTION) IF(IL.GE.55) THEN CALL SBYTESC(MSGA,KPROB,45*8,8,0,2) CALL W3FI01(LW) CALL W3FI76(XPROB(1),IEXP,IMANT,8*LW) CALL SBYTEC(MSGA,IEXP,47*8,8) CALL SBYTEC(MSGA,IMANT,48*8,24) CALL W3FI76(XPROB(2),IEXP,IMANT,8*LW) CALL SBYTEC(MSGA,IEXP,51*8,8) CALL SBYTEC(MSGA,IMANT,52*8,24) ENDIF C PACKING 3RD SECTION (CLUSTERING INFORMATION) IF(IL.GE.76) CALL SBYTESC(MSGA,KCLUST,60*8,8,0,16) C PACKING 4TH SECTION (CLUSTER MEMBERSHIP) IF(IL.GE.86) CALL SBYTESC(MSGA,KMEMBR,76*8,1,0,80) C 333 CONTINUE RETURN END