!----------------------------------------------------------------------- ! Choice of computers !----------------------------------------------------------------------- ! ! CRAY XMP,YMP/UNICOS (#define CRAY) ! VAX/VMS (#define VAX) ! Stardent 1500/3000/UNIX (#define STARDENT) ! IBM RS/6000-AIX (#define IBM) ! SUN Sparcstation (#define SUN) ! SGI Silicon Graphics (#define SGI) ! HP 7xx (#define HP) ! DEC ALPHA (#define ALPHA) ! +------------------------------------------------------------------+ ! _ SYSTEM DEPENDENT ROUTINES _ ! _ _ ! _ This module contains short utility routines that are not _ ! _ of the FORTRAN 77 standard and may differ from system to system. _ ! _ These include bit manipulation, I/O, JCL calls, and vector _ ! _ functions. _ ! +------------------------------------------------------------------+ ! +------------------------------------------------------------------+ ! ! DATA SET UTILITY AT LEVEL 003 AS OF 02/25/92 SUBROUTINE GBYTE_G1(IN,IOUT,ISKIP,NBYTE) ! ! THIS PROGRAM WRITTEN BY..... ! DR. ROBERT C. GAMMILL, CONSULTANT ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH ! MAY 1972 ! ! CHANGES FOR CRAY Y-MP8/832 ! CRAY CFT77 FORTRAN ! JULY 1992, RUSSELL E. JONES ! NATIONAL WEATHER SERVICE ! ! THIS IS THE FORTRAN VERSION OF GBYTE ! INTEGER IN(*) INTEGER IOUT INTEGER MASKS(32) ! DATA NBITSW/32/ ! ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT ! COMPUTER ! DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, & 67108863, 134217727, 268435455, 536870911, 1073741823, & 2147483647, -1/ ! ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW ! ICON = NBITSW - NBYTE IF (ICON.LT.0) RETURN MASK = MASKS(NBYTE) ! ! INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IN' THE NEXT BYTE APPEARS. ! INDEX = ISKIP / NBITSW ! ! II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD. ! II = MOD(ISKIP,NBITSW) ! ! MOVER SPECIFIES HOW FAR TO THE RIGHT NBYTE MUST BE MOVED IN ORDER ! TO BE RIGHT ADJUSTED. ! MOVER = ICON - II ! IF (MOVER.GT.0) THEN IOUT = IAND(ISHFT(IN(INDEX+1),-MOVER),MASK) ! ! THE BYTE IS SPLIT ACROSS A WORD BREAK. ! ELSE IF (MOVER.LT.0) THEN MOVEL = - MOVER MOVER = NBITSW - MOVEL IOUT = IAND(IOR(ISHFT(IN(INDEX+1),MOVEL), & & ISHFT(IN(INDEX+2),-MOVER)),MASK) ! ! THE BYTE IS ALREADY RIGHT ADJUSTED. ! ELSE IOUT = IAND(IN(INDEX+1),MASK) ENDIF ! RETURN END ! ! +------------------------------------------------------------------+ SUBROUTINE GBYTES_G1(IN,IOUT,ISKIP,NBYTE,NSKIP,N) ! ! THIS PROGRAM WRITTEN BY..... ! DR. ROBERT C. GAMMILL, CONSULTANT ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH ! MAY 1972 ! ! CHANGES FOR CRAY Y-MP8/832 ! CRAY CFT77 FORTRAN ! JULY 1992, RUSSELL E. JONES ! NATIONAL WEATHER SERVICE ! ! THIS IS THE FORTRAN VERSION OF GBYTES. ! INTEGER IN(*) INTEGER IOUT(*) INTEGER MASKS(32) ! DATA NBITSW/32/ ! ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT ! COMPUTER ! DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, & & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, & & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, & & 67108863, 134217727, 268435455, 536870911, 1073741823, & & 2147483647, -1/ ! ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW ! ICON = NBITSW - NBYTE IF (ICON.LT.0) RETURN MASK = MASKS(NBYTE) ! ! INDEX TELLS HOW MANY WORDS INTO THE ARRAY 'IN' THE NEXT BYTE APPEARS. ! INDEX = ISKIP / NBITSW ! ! II TELLS HOW MANY BITS THE BYTE IS FROM THE LEFT SIDE OF THE WORD. ! II = MOD(ISKIP,NBITSW) ! ! ISTEP IS THE DISTANCE IN BITS FROM THE START OF ONE BYTE TO THE NEXT. ! ISTEP = NBYTE + NSKIP ! ! IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT. ! IWORDS = ISTEP / NBITSW ! ! IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS. ! IBITS = MOD(ISTEP,NBITSW) ! DO 10 I = 1,N ! ! MOVER SPECIFIES HOW FAR TO THE RIGHT A BYTE MUST BE MOVED IN ORDER ! ! TO BE RIGHT ADJUSTED. ! TO BE RIGHT ADJUSTED. ! MOVER = ICON - II ! ! THE BYTE IS SPLIT ACROSS A WORD BREAK. ! IF (MOVER.LT.0) THEN MOVEL = - MOVER MOVER = NBITSW - MOVEL IOUT(I) = IAND(IOR(ISHFT(IN(INDEX+1),MOVEL), & & ISHFT(IN(INDEX+2),-MOVER)),MASK) ! ! RIGHT ADJUST THE BYTE. ! ELSE IF (MOVER.GT.0) THEN IOUT(I) = IAND(ISHFT(IN(INDEX+1),-MOVER),MASK) ! ! THE BYTE IS ALREADY RIGHT ADJUSTED. ! ELSE IOUT(I) = IAND(IN(INDEX+1),MASK) ENDIF ! ! INCREMENT II AND INDEX. ! II = II + IBITS INDEX = INDEX + IWORDS IF (II.GE.NBITSW) THEN II = II - NBITSW INDEX = INDEX + 1 ENDIF ! 10 CONTINUE RETURN END ! ! +------------------------------------------------------------------+ SUBROUTINE SBYTE_G1(IOUT,IN,ISKIP,NBYTE) ! THIS PROGRAM WRITTEN BY..... ! DR. ROBERT C. GAMMILL, CONSULTANT ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH ! JULY 1972 ! THIS IS THE FORTRAN VERSIONS OF SBYTE. ! FORTRAN 90 ! AUGUST 1990 RUSSELL E. JONES ! NATIONAL WEATHER SERVICE ! ! USAGE: CALL SBYTE (PCKD,UNPK,INOFST,NBIT) ! ! INPUT ARGUMENT LIST: ! UNPK - NBITS OF THE RIGHT SIDE OF UNPK IS MOVED TO ! ARRAY PCKD. INOFST BITS ARE SKIPPED OVER BEFORE ! THE DATA IS MOVED, NBITS ARE STORED. ! INOFST - A FULLWORD INTEGER SPECIFYING THE INITAL OFFSET ! IN BITS OF THE FIRST BYTE, COUNTED FROM THE ! LEFTMOST BIT IN PCKD. ! NBITS - A FULLWORD INTEGER SPECIFYING THE NUMBER OF BITS ! IN EACH BYTE TO BE PACKED. LEGAL BYTE WIDTHS ! ARE IN THE RANGE 1 - 32. ! OUTPUT ARGUMENT LIST: ! PCKD - THE FULLWORD IN MEMORY TO WHICH PACKING IS TO ! BEGIN STARTING AT BIT INOFST. THE INOSTAT BITS ! ARE NOT ALTERED. ! INTEGER IN INTEGER IOUT(*) INTEGER MASKS(32) ! DATA NBITSW/32/ ! ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT ! COMPUTER ! DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, & & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, & & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, & & 67108863, 134217727, 268435455, 536870911, 1073741823, & & 2147483647, -1/ ! ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW ! ICON = NBITSW - NBYTE IF (ICON.LT.0) RETURN MASK = MASKS(NBYTE) ! ! INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED. ! INDEX = ISKIP / NBITSW ! ! II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT. ! II = MOD(ISKIP,NBITSW) ! J = IAND(MASK,IN) MOVEL = ICON - II ! ! BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT. ! IF (MOVEL.GT.0) THEN MSK = ISHFT(MASK,MOVEL) IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), & & ISHFT(J,MOVEL)) ! ! THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK. ! ELSE IF (MOVEL.LT.0) THEN MSK = MASKS(NBYTE+MOVEL) IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), & & ISHFT(J,MOVEL)) ITEMP = IAND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2)) IOUT(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL)) ! ! BYTE IS TO BE STORED RIGHT-ADJUSTED. ! ELSE IOUT(INDEX+1) = IOR(IAND(NOT(MASK),IOUT(INDEX+1)),J) ENDIF ! RETURN END ! ! +------------------------------------------------------------------+ SUBROUTINE SBYTES_G1(IOUT,IN,ISKIP,NBYTE,NSKIP,N) ! THIS PROGRAM WRITTEN BY..... ! DR. ROBERT C. GAMMILL, CONSULTANT ! NATIONAL CENTER FOR ATMOSPHERIC RESEARCH ! JULY 1972 ! THIS IS THE FORTRAN VERSIONS OF SBYTES. ! ! FORTRAN 90 ! AUGUST 1990 RUSSELL E. JONES ! NATIONAL WEATHER SERVICE ! ! USAGE: CALL SBYTES (PCKD,UNPK,INOFST,NBIT, NSKIP,ITER) ! ! INPUT ARGUMENT LIST: ! UNPK - NBITS OF THE RIGHT SIDE OF EACH WORD OF ARRAY ! UNPK IS MOVED TO ARRAY PCKD. INOFST BITS ARE ! SKIPPED OVER BEFORE THE 1ST DATA IS MOVED, NBITS ! ARE STORED, NSKIP BITS ARE SKIPPED OVER, THE NEXT ! NBITS ARE MOVED, BIT ARE SKIPPED OVER, ETC. UNTIL ! ITER GROUPS OF BITS ARE PACKED. ! INOFST - A FULLWORD INTEGER SPECIFYING THE INITAL OFFSET ! IN BITS OF THE FIRST BYTE, COUNTED FROM THE ! LEFTMOST BIT IN PCKD. ! NBITS - A FULLWORD INTEGER SPECIFYING THE NUMBER OF BITS ! IN EACH BYTE TO BE PACKED. LEGAL BYTE WIDTHS ! ARE IN THE RANGE 1 - 32. ! NSKIP - A FULLWORD INTEGER SPECIFYING THE NUMBER OF BITS ! TO SKIP BETWEEN SUCCESSIVE BYTES. ALL NON-NEGATIVE ! SKIP COUNTS ARE LEGAL. ! ITER - A FULLWORD INTEGER SPECIFYING THE TOTAL NUMBER OF ! BYTES TO BE PACKED, AS CONTROLLED BY INOFST, ! NBIT AND NSKIP ABOVE. ALL NON-NEGATIVE ITERATION ! COUNTS ARE LEGAL. ! ! OUTPUT ARGUMENT LIST: ! PCKD - THE FULLWORD IN MEMORY TO WHICH PACKING IS TO ! BEGIN STARTING AT BIT INOFST. THE INOSTAT BITS ! ARE NOT ALTERED. NSKIP BITS ARE NOT ALTERED. ! INTEGER IN(*) INTEGER IOUT(*) INTEGER MASKS(32) ! DATA NBITSW/32/ ! ! MASKS TABLE PUT IN DECIMAL SO IT WILL COMPILE ON ANY 32 BIT ! COMPUTER ! DATA MASKS / 1, 3, 7, 15, 31, 63, 127, 255, 511, 1023, 2047, & & 4095, 8191, 16383, 32767, 65535, 131071, 262143, 524287, & & 1048575, 2097151, 4194303, 8388607, 16777215, 33554431, & & 67108863, 134217727, 268435455, 536870911, 1073741823, & & 2147483647, -1/ ! ! NBYTE MUST BE LESS THAN OR EQUAL TO NBITSW ! ICON = NBITSW - NBYTE IF (ICON.LT.0) RETURN MASK = MASKS(NBYTE) ! ! INDEX TELLS HOW MANY WORDS INTO IOUT THE NEXT BYTE IS TO BE STORED. ! INDEX = ISKIP / NBITSW ! ! II TELLS HOW MANY BITS IN FROM THE LEFT SIDE OF THE WORD TO STORE IT. ! II = MOD(ISKIP,NBITSW) ! ! ISTEP IS THE DISTANCE IN BITS FROM ONE BYTE POSITION TO THE NEXT. ! ISTEP = NBYTE + NSKIP ! ! IWORDS TELLS HOW MANY WORDS TO SKIP FROM ONE BYTE TO THE NEXT. ! IWORDS = ISTEP / NBITSW ! ! IBITS TELLS HOW MANY BITS TO SKIP AFTER SKIPPING IWORDS. ! IBITS = MOD(ISTEP,NBITSW) ! DO 10 I = 1,N J = IAND(MASK,IN(I)) MOVEL = ICON - II ! ! BYTE IS TO BE STORED IN MIDDLE OF WORD. SHIFT LEFT. ! IF (MOVEL.GT.0) THEN MSK = ISHFT(MASK,MOVEL) IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), & & ISHFT(J,MOVEL)) ! ! THE BYTE IS TO BE SPLIT ACROSS A WORD BREAK. ! ELSE IF (MOVEL.LT.0) THEN MSK = MASKS(NBYTE+MOVEL) IOUT(INDEX+1) = IOR(IAND(NOT(MSK),IOUT(INDEX+1)), & & ISHFT(J,MOVEL)) ITEMP = IAND(MASKS(NBITSW+MOVEL),IOUT(INDEX+2)) IOUT(INDEX+2) = IOR(ITEMP,ISHFT(J,NBITSW+MOVEL)) ! ! BYTE IS TO BE STORED RIGHT-ADJUSTED. ! ELSE IOUT(INDEX+1) = IOR(IAND(NOT(MASK),IOUT(INDEX+1)),J) ENDIF ! II = II + IBITS INDEX = INDEX + IWORDS IF (II.GE.NBITSW) THEN II = II - NBITSW INDEX = INDEX + 1 ENDIF ! 10 CONTINUE ! RETURN END