******************************************************************
*
*	TITLE:  DRIVER FOR UNPACKING VOYAGER MAG (PLS) EDR
*
*	FILE NAME:  UNPACK.FOR
*
*	PURPOSE:  TO CALL THE ROUTINES THAT UNPACK THE HEADER, UNPACK THE 
*                  SUBHEADER (PLS DATA) AND UNPACK THE MAG DATA.
*
*	HISTORY:
*
*	AUTHOR               DATE           CHANGE
*	------               ----           ------
*	S. J. KEMPLER       8/12/85         ORIGINAL CODE
*			    6/6/88	    CHECKED STATUS (SEE CODE)
*
*	CALLING SEQUENCE:  SUBROUTINE UNPACK (INBUF,UNSTAT)
*
*	ARGUMENT LIST:
*
*	NAME	   	TYPE	   USED	   PURPOSE
*	----   	   	----	   ----	   -------
*	INBUF(6512)	 L*1	     I	   6512 BYTES CONTAINING HEADER,
*					   SUBHEADER (PLS DATA) AND MAG
*					   DATA FROM AN EDR.
*	UNSTAT		 I*4	     O	   UNSTAT FLAG:
*					     0 = NORMAL COMPLETION
*					     1 = DATA MODE IS NOT GS-3
*					     2 = INCORRECT PROJID
*
*	MODULES REFERENCED:
*
*		UNHEAD, UNPLS, UNMAG
*
*	COMMON AREAS:
*
*		SEE UNPACK.INC FOR COMMON AREA DEFINITIONS
*
*	PDL:
*
*		SET UNSTAT TO 0
*		CALL UNHEAD TO UNPACK THE 60 HEADER WORDS
*		CALL UNPLS TO UNPACK THE 68 SUBHEADER PLS DATA WORDS
*		CALL UNMAG TO UNPACK THE 1500 MAG DATA WORDS
*		ENDIF
*		RETURN
*******************************************************************
*
      SUBROUTINE UNPACK(INBUF,UNSTAT)
C
      LOGICAL*1 INBUF(6512)
C
      INTEGER*4 UNSTAT
C
      INCLUDE 'EDR:UNPACK.INC'
C
CCC
C     CHANGE "UNSTAT=0" TO "UNSTAT=1" TO IMPLEMENT CHECKING FOR OTHER
C       VALID MODES. 8/31/89
      UNSTAT=1
CCC                          
C
D     TYPE *,' UNPACK:INBUF(1-20)',(INBUF(I), I=1,20)
C
      DO 1 I=1,240
         HEAD(I) = INBUF(I)
  1   CONTINUE
C
D     TYPE *,' UNPACK:HEAD(1-20)',(HEAD(I), I=1,20)
C
      DO 2 I=241,512
         J=I-240
         PLS(J) = INBUF(I)
  2   CONTINUE
C
      DO 3 I=513,6512
         J=I-512
         MAG(J) = INBUF(I)
  3   CONTINUE
C
      CALL UNHEAD(INBUF,UNSTAT)
C
CCCC     NEXT LINE ADDED 6/8/88 TO ACCESS ONLY GS-3 DATA
C
      IF(UNSTAT.NE.0) GO TO 99
C
      CALL UNPLS(INBUF,UNSTAT)
C
      CALL UNMAG(INBUF,UNSTAT)
C
 99   RETURN
      END
*
*
*
******************************************************************
*
*	TITLE:  UNPACK VOYAGER 60 WORD EDR HEADER
*
*	FILE NAME:  UNHEAD.FOR
*
*	PURPOSE:  TO UNPACK THE HEADER AND CHECK FOR CORRECT DATA MODE
*
*	HISTORY:
*
*	AUTHOR            DATE             CHANGE
*	--------          ----             ------
*	S. J. KEMPLER     8/12/85          ORIGINAL CODE
*			  6/8/88	   MADE MODES 9-15 VALID (SEE CODE)
*                         8/31/89          ALSO MADE MODES 17,18,20-24 AND
*                                           26-31 VALID
*
*	CALLING SEQUENCE:  SUBROUTINE UNHEAD (INBUF,UNSTAT)
*
*	ARGUMENT LIST:
*
*	NAME		TYPE	USED	PURPOSE
*	-----		----	----	-------
*	INBUF(6512)	 L*1	  I	6512 BYTES CONTAINING HEADER,
*					SUBHEADER (PLS DATA) AND MAG
*					DATA FROM AN EDR.
*	UNSTAT		 I*4	  O	UNSTAT FLAG:
*					     0 = NORMAL COMPLETION
*					     1 = DATA MODE IS NOT GS-3
*					     2 = INCORRECT PROJID
*
*	MODULES REFERENCED:
*
*		MOVBIT
*
*	COMMON AREAS:
*
*		SEE UNPACK.INC FOR COMMON AREA DEFINITIONS
*
*	PDL:
*
*		SET UNSTAT TO 0
*		CALL MOVBIT TO LOAD DATMOD WITH DATA MODE
*		CALL MOVBIT TO LOAD MOD60 WITH MOD 60 COUNT WORD
*		LOAD PROJID WITH THE 3 CHARACTER PROJECT ID
*		CALL MOVBIT TO LOAD ALL OTHER ITEMS OF THE HEADER FIELD 
*                INTO INDIVIDUAL I*2 VARIABLES
*		IF DATA MODE IS NOT GS-3
*		THEN
*			SET UNSTAT TO 1
*		ELSE IF INCORRECT PROJID
*			THEN
*				SET UNSTAT TO 2
*			ENDIF
*		ENDIF
*		RETURN
*
******************************************************************* 
C
      SUBROUTINE UNHEAD(INBUF,UNSTAT)
C
      LOGICAL*1 INBUF(6512)
C
      LOGICAL*1 LPROJ(3)
C
      INTEGER*4 UNSTAT
C
      INCLUDE 'EDR:UNPACK.INC'
C
      EQUIVALENCE (PROJID,LPROJ(1))
C
CCC
C     CHANGE "UNSTAT=0" TO "UNSTAT=1" TO IMPLEMENT CHECKING FOR OTHER
C       VALID MODES. 8/31/89
      UNSTAT=1
CCC                          
C
D     TYPE *,' UNHEAD:HEAD(1-20)',(HEAD(I), I=1,20)
C
      LPROJ(1) = HEAD(1)
      LPROJ(2) = HEAD(2)
      LPROJ(3) = HEAD(3)
C
      ISTAT = LIB$TRA_EBC_ASC(PROJID,PROJID)
C
      RECID = 0
      CALL MOVBIT(  HEAD,  28,  4,  RECID,   0)
      SCID = 0
      CALL MOVBIT(  HEAD,  24,  4,   SCID,   0)
      RECNUM = 0
      CALL MOVBIT(  HEAD,  40,  8, RECNUM,   0)
      CALL MOVBIT(  HEAD,  32,  8, RECNUM,   8)
      DATMOD = 0
      CALL MOVBIT(  HEAD,  48,  8, DATMOD,   0)
      EEXTFL = 0
      CALL MOVBIT(  HEAD,  56,  2, EEXTFL,   0)
      SCPLAB = 0
      CALL MOVBIT(  HEAD,  58,  1, SCPLAB,   0)
      RECTIM = 0
      CALL MOVBIT(  HEAD,  59,  5, RECTIM,   0)
      ERTSHR = 0
      CALL MOVBIT(  HEAD,  72,  8, ERTSHR,   0)
      CALL MOVBIT(  HEAD,  64,  8, ERTSHR,   8)
      ERTSSC = 0
      CALL MOVBIT(  HEAD,  88,  8, ERTSSC,   0)
      CALL MOVBIT(  HEAD,  80,  8, ERTSSC,   8)
      ERTSML = 0
      CALL MOVBIT(  HEAD, 104,  8, ERTSML,   0)
      CALL MOVBIT(  HEAD,  96,  8, ERTSML,   8)
      YEAR1 = 0
      CALL MOVBIT(  HEAD, 112,  8,  YEAR1,   0)
      DATSRC = 0
      CALL MOVBIT(  HEAD, 120,  2, DATSRC,   0)
      GOLAY = 0
      CALL MOVBIT(  HEAD, 122,  2,  GOLAY,   0)
      SEGNUM = 0
      CALL MOVBIT(  HEAD, 124,  4, SEGNUM,   0)
      ERTEHR = 0
      CALL MOVBIT(  HEAD, 136,  8, ERTEHR,   0)
      CALL MOVBIT(  HEAD, 128,  8, ERTEHR,   8)
      ERTESC = 0
      CALL MOVBIT(  HEAD, 152,  8, ERTESC,   0)
      CALL MOVBIT(  HEAD, 144,  8, ERTESC,   8)
      ERTEML = 0
      CALL MOVBIT(  HEAD, 168,  8, ERTEML,   0)
      CALL MOVBIT(  HEAD, 160,  8, ERTEML,   8)
      YEAR2 = 0
      CALL MOVBIT(  HEAD, 176,  8,  YEAR2,   0)
      SWVERS = 0
      CALL MOVBIT(  HEAD, 184,  8, SWVERS,   0)
      SCETHR = 0
      CALL MOVBIT(  HEAD, 200,  8, SCETHR,   0)
      CALL MOVBIT(  HEAD, 192,  8, SCETHR,   8)
      SCETSC = 0
      CALL MOVBIT(  HEAD, 216,  8, SCETSC,   0)
      CALL MOVBIT(  HEAD, 208,  8, SCETSC,   8)
      SCETML = 0
      CALL MOVBIT(  HEAD, 232,  8, SCETML,   0)
      CALL MOVBIT(  HEAD, 224,  8, SCETML,   8)
      YEAR3 = 0
      CALL MOVBIT(  HEAD, 240,  8,  YEAR3,   0)
      SCEVFL = 0
      CALL MOVBIT(  HEAD, 252,  4, SCEVFL,   0)
      CORRFL = 0
      CALL MOVBIT(  HEAD, 248,  4, CORRFL,   0)
      MOD216 = 0
      CALL MOVBIT(  HEAD, 264,  8, MOD216,   0)
      CALL MOVBIT(  HEAD, 256,  8, MOD216,   8)
      MOD60 = 0
      CALL MOVBIT(  HEAD, 272,  8,  MOD60,   0)
      LINCNT = 0
      CALL MOVBIT(  HEAD, 288,  8, LINCNT,   0)
      CALL MOVBIT(  HEAD, 280,  8, LINCNT,   8)
      TELRAT = 0
      CALL MOVBIT(  HEAD, 296,  8, TELRAT,   0)
      EFFRAT = 0
      CALL MOVBIT(  HEAD, 304,  8, EFFRAT,   0)
      FORMID = 0
      CALL MOVBIT(  HEAD, 312,  8, FORMID,   0)
      BERTOL = 0
      CALL MOVBIT(  HEAD, 320,  8, BERTOL,   0)
      DSNCON = 0
      CALL MOVBIT(  HEAD, 328,  8, DSNCON,   0)
      RECAGC = 0
      CALL MOVBIT(  HEAD, 344,  8, RECAGC,   0)
      CALL MOVBIT(  HEAD, 336,  8, RECAGC,   8)
      DSNNUM = 0
      CALL MOVBIT(  HEAD, 352,  8, DSNNUM,   0)
      EBEC = 0
      CALL MOVBIT(  HEAD, 376,  8,   EBEC,   0)
      CALL MOVBIT(  HEAD, 368,  8,   EBEC,   8)
      SYMSNR = 0
      CALL MOVBIT(  HEAD, 392,  8, SYMSNR,   0)
      CALL MOVBIT(  HEAD, 384,  8, SYMSNR,   8)
      DECSNR = 0
      CALL MOVBIT(  HEAD, 408,  8, DECSNR,   0)
      CALL MOVBIT(  HEAD, 400,  8, DECSNR,   8)
      PHYSRN = 0
      CALL MOVBIT(  HEAD, 424,  8, PHYSRN,   0)
      CALL MOVBIT(  HEAD, 416,  8, PHYSRN,   8)
C
      DO 10 I=1,10
         J = (I-1) * 16
C
         DQSW(I) = 0
         CALL MOVBIT(  HEAD, 432+J,  8, DQSW(I),   0)
         DQI(I) = 0
         CALL MOVBIT(  HEAD, 440+J,  8,  DQI(I),   0)
C
  10  CONTINUE
C
      DO 20 I=1,80
         J = (I-1) * 16
C
         DPI(I) = 0
         CALL MOVBIT(  HEAD, 592+J,  8, DPI(I),   0)
         GCI(I) = 0
         CALL MOVBIT(  HEAD, 600+J,  8, GCI(I),   0)
C
  20  CONTINUE
C
      DPIRIS = 0
      CALL MOVBIT(  HEAD, 1872,  8, DPIRIS,   0)
      GPIRIS = 0
      CALL MOVBIT(  HEAD, 1880,  8, GPIRIS,   0)
      DRSDAT = 0
      CALL MOVBIT(  HEAD, 1888,  8, DRSDAT,   0)
      GCBEC = 0
      CALL MOVBIT(  HEAD, 1896,  8,  GCBEC,   0)
      GBITES = 0
      CALL MOVBIT(  HEAD, 1912,  8, GBITES,   0)
      CALL MOVBIT(  HEAD, 1904,  8, GBITES,   8)
C
CCCC      6/8/88 - DATMOD'S BETWEEN 9 & 15 MADE VALID DURING ENCOUNTER
CCCC      IF (DATMOD.NE.10) UNSTAT=1
C
CCCC      8/31/89 - OTHER VALID DATMOD'S ADDED AS BELOW
C         IF (DATMOD.LT.9.OR.DATMOD.GT.15) UNSTAT=1
C
      IF (DATMOD.GE.9.AND.DATMOD.LE.15)  UNSTAT=0
      IF (DATMOD.EQ.17)                  UNSTAT=0
      IF (DATMOD.EQ.18)                  UNSTAT=0
      IF (DATMOD.GE.20.AND.DATMOD.LE.24) UNSTAT=0
      IF (DATMOD.GE.26.AND.DATMOD.LE.31) UNSTAT=0
C
CCCC
      IF (PROJID.NE.'MJS') UNSTAT=2
C
      RETURN
      END
C
C
C
*
******************************************************************
*
*	TITLE:  UNPACK VOYAGER 68 WORD EDR SUBHEADER (PLS DATA)
*
*************** CONTAINS L SHOER CORRECTION ******************
*
*	FILE NAME:  UNPLS.FOR
*
*	PURPOSE:  TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE 
*                  SPECIFIED MOD60 FORMAT
* 
*	HISTORY:
*
*	AUTHOR       	  DATE              CHANGE
*	--------          ----              ------
*	S. J. KEMPLER     8/12/85           ORIGINAL CODE
*
*	CALLING SEQUENCE:  SUBROUTINE UNPLS (INBUF,UNSTAT)
*
*	ARGUMENT LIST:
*
*	NAME		TYPE	USED	PURPOSE
*	-----		-----	----	-------
*	INBUF(6512)	 L*1	  I	6512 BYTES CONTAINING HEADER,
*					SUBHEADER (PLS DATA) AND MAG
*					DATA FROM AN EDR.
*	UNSTAT		 I*4	  O	UNSTAT FLAG:
*					     0 = NORMAL COMPLETION
*					     1 = DATA MODE IS NOT GS-3
*					     2 = INCORRECT PROJID
*
*	MODULES REFERENCED:
*
*		MOVBIT
*
*	COMMON AREAS:
*
*		SEE UNPACK.INC FOR COMMON AREA DEFINITIONS
*
*	NOTES:
*
*		THE PLS DATA FORMAT TO BE USED IS DETERMINED BY THE REMAINDER
*                AFTER DIVIDING THE VARIABLE MOD60 BY 15.  THEREFORE,
*                FORMATS MAY BE NUMBERED 0 TO 14.
*
*	PDL:
*
*		SET UNSTAT TO 0
*		CALL MOVBIT TO LOAD THE FIRST 20 WORDS (PLS HEADER) INTO I*2
*                VARIABLES
*		CALCULATE THE REMAINDER OF MOD60 DIVIDED BY 15
*		CALL MOVBIT TO LOAD THE REMAINING 48 WORDS ACCORDING TO THE 
*                 FORMAT NUMBER CALCULATED ABOVE (SEE NOTES) INTO I*2 VARIABLES
*		RETURN
*
******************************************************************* 
      SUBROUTINE UNPLS(INBUF,UNSTAT)
C
      LOGICAL*1 INBUF(6512)
C
      INTEGER*4 UNSTAT
C
      INCLUDE 'EDR:UNPACK.INC'
C
C
      COMAND = 0
      CALL MOVBIT(  PLS,   8,  8, COMAND,   0)
      CALL MOVBIT(  PLS,   0,  8, COMAND,   8)
      IBCOM = 0
      CALL MOVBIT(  PLS,  40,  8,  IBCOM,   0)
      CALL MOVBIT(  PLS,  32,  8,  IBCOM,   8)
      OBCOM = 0
      CALL MOVBIT(  PLS,  56,  8,  OBCOM,   0)
      CALL MOVBIT(  PLS,  48,  8,  OBCOM,   8)
C
      DO 10 I=1,10
         J = (I-1) * 32
C
         STAT1(I) = 0
         CALL MOVBIT(  PLS, 72+J,  8, STAT1(I),   0)
         CALL MOVBIT(  PLS, 64+J,  8, STAT1(I),   8)
         STAT2(I) = 0
         CALL MOVBIT(  PLS, 88+J,  8, STAT2(I),   0)
         CALL MOVBIT(  PLS, 80+J,  8, STAT2(I),   8)
C
  10  CONTINUE
C
      STATIM = 0
      CALL MOVBIT(  PLS, 472,   8, STATIM,   0)
      CALL MOVBIT(  PLS, 464,   8, STATIM,   8)
      CALL MOVBIT(  PLS, 456,   8, STATIM,  16)
      CALL MOVBIT(  PLS, 448,   8, STATIM,  24)
C
      PLSREC = IMOD(MOD60,15) + 1
      GO TO (1,2,2,2,2,2,2,2,2,2,2,2,13,14,15) PLSREC
C
  1   L63 = O
      CALL MOVBIT(  PLS, 640,   8,    L63,   0)
      L64 = O
      CALL MOVBIT(  PLS, 648,   8,    L64,   0)
C
  2   LSTAT1 = O
      CALL MOVBIT(  PLS, 864,   8, LSTAT1,   0)
C
      I=0
      DO 20 I1=1,16
C
         DO 21 I2=1,4
            I=I+1
            J = (I-1) * 8
C
            LSHORT(I1,I2) = 0
            CALL MOVBIT(  PLS, 872+J,  8, LSHORT(I1,I2),   0)
C
  21     CONTINUE
  20  CONTINUE
C
C     L SHORT CORRECTION BEFORE THE YEAR 2000
C
      IF (YEAR3.GT.60) THEN
         DO 25 I=1,15
            DO 26 J=1,4
C
                LSHORT(I,J) = LSHORT(I+1,J)
  26        CONTINUE
  25     CONTINUE
C
         DO 27 J=1,4
C
            LSHORT(16,J) = -1
C
  27     CONTINUE
      ENDIF
C
C
      ESTAT1 = O
      CALL MOVBIT(  PLS, 1384,   8, ESTAT1,   0)
C
      DO 30 I=1,16
         J = (I-1) * 8
C
         ESHORT(I) = 0
         CALL MOVBIT(  PLS, 1392+J,  8, ESHORT(I),   0)
C
  30  CONTINUE
C
      LSTAT2 = O
      CALL MOVBIT(  PLS, 1520,   8, LSTAT2,   0)
C
      I=0
      DO 40 I1=1,16
C
         DO 41 I2=1,4
            I=I+1
            J = (I-1) * 8
C
            LLONG(I1,I2) = 0
            CALL MOVBIT(  PLS, 1528+J,  8, LLONG(I1,I2),   0)
C
  41     CONTINUE
  40  CONTINUE
C
      ESTAT2 = O
      CALL MOVBIT(  PLS, 2040,   8, ESTAT2,   0)
C
      DO 50 I=1,16
         J = (I-1) * 8
C
         ELONG(I) = 0
         CALL MOVBIT(  PLS, 2048+J,  8, ELONG(I),   0)
C
  50  CONTINUE
C
      GO TO 95
C
  13  MSTAT = 0
      CALL MOVBIT(  PLS,   640,  8, DMSTAT,   0)
C
      DO 60 I=1,191
         J = (I-1) * 8
C
         M(I) = 0
         CALL MOVBIT(  PLS, 648+J,  8, M(I),   0)
C
  60  CONTINUE
C
      GO TO 95
C
  14  DO 70 I=1,192
         J = (I-1) * 8
C
         M(I) = 0
         CALL MOVBIT(  PLS, 640+J,  8, M(I),   0)
C
  70  CONTINUE
C
      GO TO 95
C
  15  DO 80 I=1,129
         J = (I-1) * 8
C
         M(I) = 0
         CALL MOVBIT(  PLS, 640+J,  8, M(I),   0)
C
  80  CONTINUE
C
      LSTAT = 0
      CALL MOVBIT(  PLS, 1672,  8, LSTAT,   0)
C
      I=0
      DO 90 I1=1,16
C
         DO 91 I2=1,4
            I=I+1
C
            IF(I.GT.62) GO TO 95
C
            J = (I-1) * 8
C
            LLONG(I1,I2) = 0
            CALL MOVBIT(  PLS, 1680+J,  8, LLONG(I1,I2),   0)
C
  91     CONTINUE
  90  CONTINUE
C
  95  RETURN
      END
C
C
C
C
*
*
******************************************************************
*
*	TITLE:  UNPACK VOYAGER 1500 WORD EDR MAG DATA
*
*	FILE NAME:  UNMAG.FOR
*
*	PURPOSE:  TO UNPACK THE MAG SCIENCE DATA
*
*	HISTORY:
*
*	AUTHOR            DATE            CHANGE
*	--------          ----            -------
*	S. J. KEMPLER     8/12/85         ORIGINAL CODE
*
*	CALLING SEQUENCE:  SUBROUTINE UNMAG (INBUF,UNSTAT)
*
*	ARGUMENT LIST:
*
*	NAME		TYPE	USED	PURPOSE
*	-----		-----	-----	--------
*	INBUF(6512)	 L*1	  I	6512 BYTES CONTAINING HEADER,
*					SUBHEADER (PLS DATA) AND MAG
*					DATA FROM AN EDR.
*	UNSTAT		 I*4	  O	UNSTAT FLAG:
*					     0 = NORMAL COMPLETION
*					     1 = DATA MODE IS NOT GS-3
*					     2 = INCORRECT PROJID
*
*	MODULES REFERENCED:
*
*		MOVBIT
*
*	COMMON AREAS:
*
*		SEE UNPACK.INC FOR COMMON AREA DEFINITIONS
*
*	NOTES:
*
*		SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE
*                FOLLOWING:
*				P diff	6 bits each
*				P ref	12 bits each
*				S diff	6 bits each
*				S ref	12 bits each
*				OB HFM	12 bits each
*				IB HFM	12 bits each
*
*	PDL:
*
*		SET UNSTAT TO 0
*		CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO I*2 VARIABLES
*		RETURN
*
******************************************************************* 
      SUBROUTINE UNMAG(INBUF,UNSTAT)
C
      LOGICAL*1 INBUF(6512)
C
      INTEGER*4 UNSTAT
C
      INTEGER*4 PDXIND(10), PDYIND(10), PDZIND(10),
     I          PRXIND(2),  PRYIND(2),  PRZIND(2),
     I          SDXIND(5),  SDYIND(5),  SDZIND(5)
C
      INCLUDE 'EDR:UNPACK.INC'
C
      DATA PDXIND/ 0,168,264,288,336,360,456,480,528,552/
      DATA PDYIND/24,176,272,296,344,384,464,488,536,560/
      DATA PDZIND/48,184,280,304,352,408,472,496,544,568/
      DATA PRXIND/ 8,368/
      DATA PRYIND/32,392/
      DATA PRZIND/56,416/
      DATA SDXIND/192,312,432,504,576/
      DATA SDYIND/216,320,440,512,584/
      DATA SDZIND/240,328,448,520,592/
C
C
      IPD = 0
      IPR = 0
      ISD = 0
      ISR = 0
      IB  = 0
      IMAG=-600
C
      DO 90 I=1,80
         IMAG=IMAG+600
C
         DO 10 J=1,10
C
            IPD=IPD+1
C
            PDIFF(1,IPD) = 0
            CALL MOVBIT( MAG, PDXIND(J)+IMAG  , 5, PDIFF(1,IPD),  0)
            CALL MOVBIT( MAG, PDXIND(J)+IMAG+5, 1, PDIFF(1,IPD), 15)
            CALL GETBIT(PDIFF(1,IPD), 15, IVAL)
            IF(IVAL.EQ.1) THEN
               CALL SETBIT(PDIFF(1,IPD),5,10)
            ENDIF
C
            PDIFF(2,IPD) = 0
            CALL MOVBIT( MAG, PDYIND(J)+IMAG  , 5, PDIFF(2,IPD),   0)
            CALL MOVBIT( MAG, PDYIND(J)+IMAG+5, 1, PDIFF(2,IPD), 15)
            CALL GETBIT(PDIFF(2,IPD), 15, IVAL)
            IF(IVAL.EQ.1) THEN
               CALL SETBIT(PDIFF(2,IPD),5,10)
            ENDIF
C
            PDIFF(3,IPD) = 0
            CALL MOVBIT( MAG, PDZIND(J)+IMAG  , 5, PDIFF(3,IPD),   0)
            CALL MOVBIT( MAG, PDZIND(J)+IMAG+5, 1, PDIFF(3,IPD), 15)
            CALL GETBIT(PDIFF(3,IPD), 15, IVAL)
            IF(IVAL.EQ.1) THEN
               CALL SETBIT(PDIFF(3,IPD),5,10)
            ENDIF
C
  10     CONTINUE
C
         DO 20 J=1,2
C
            IPR=IPR+1
C
            CALL MOVBIT( MAG, PRXIND(J)+IMAG  , 6, PREF(1,IPR), 6)
            CALL MOVBIT( MAG, PRXIND(J)+IMAG+8, 6, PREF(1,IPR), 0)
C
            CALL MOVBIT( MAG, PRYIND(J)+IMAG  , 6, PREF(2,IPR), 6)
            CALL MOVBIT( MAG, PRYIND(J)+IMAG+8, 6, PREF(2,IPR), 0)
C
            CALL MOVBIT( MAG, PRZIND(J)+IMAG  , 6, PREF(3,IPR), 6)
            CALL MOVBIT( MAG, PRZIND(J)+IMAG+8, 6, PREF(3,IPR), 0)
C
  20     CONTINUE
C
         DO 30 J=1,5
C
            ISD=ISD+1
C     
            SDIFF(1,ISD) = 0
            CALL MOVBIT( MAG, SDXIND(J)+IMAG  , 5, SDIFF(1,ISD),   0)
            CALL MOVBIT( MAG, SDXIND(J)+IMAG+5, 1, SDIFF(1,ISD), 15)
            CALL GETBIT(SDIFF(1,ISD), 15, IVAL)
            IF(IVAL.EQ.1) THEN
               CALL SETBIT(SDIFF(1,ISD),5,10)
            ENDIF
C
            SDIFF(2,ISD) = 0
            CALL MOVBIT( MAG, SDYIND(J)+IMAG  , 5, SDIFF(2,ISD),   0)
            CALL MOVBIT( MAG, SDYIND(J)+IMAG+5, 1, SDIFF(2,ISD), 15)
            CALL GETBIT(SDIFF(2,ISD), 15, IVAL)
            IF(IVAL.EQ.1) THEN
               CALL SETBIT(SDIFF(2,ISD),5,10)
            ENDIF
C
            SDIFF(3,ISD) = 0
            CALL MOVBIT( MAG, SDZIND(J)+IMAG  , 5, SDIFF(3,ISD),   0)
            CALL MOVBIT( MAG, SDZIND(J)+IMAG+5, 1, SDIFF(3,ISD), 15)
            CALL GETBIT(SDIFF(3,ISD), 15, IVAL)
            IF(IVAL.EQ.1) THEN
               CALL SETBIT(SDIFF(3,ISD),5,10)
            ENDIF
C
  30     CONTINUE
C
            ISR=ISR+1
C
            CALL MOVBIT( MAG, 200+IMAG  , 6, SREF(1,ISR), 6)
            CALL MOVBIT( MAG, 200+IMAG+8, 6, SREF(1,ISR), 0)
C
            CALL MOVBIT( MAG, 224+IMAG  , 6, SREF(2,ISR), 6)
            CALL MOVBIT( MAG, 224+IMAG+8, 6, SREF(2,ISR), 0)
C
            CALL MOVBIT( MAG, 248+IMAG  , 6, SREF(3,ISR), 6)
            CALL MOVBIT( MAG, 248+IMAG+8, 6, SREF(3,ISR), 0)
C
            IB=IB+1
C
            CALL MOVBIT( MAG, 72 +IMAG  , 6, OBHFM(1,IB), 6)
            CALL MOVBIT( MAG, 72 +IMAG+8, 6, OBHFM(1,IB), 0)
C
            CALL MOVBIT( MAG, 88 +IMAG  , 6, OBHFM(2,IB), 6)
            CALL MOVBIT( MAG, 88 +IMAG+8, 6, OBHFM(2,IB), 0)
C
            CALL MOVBIT( MAG, 104+IMAG  , 6, OBHFM(3,IB), 6)
            CALL MOVBIT( MAG, 104+IMAG+8, 6, OBHFM(3,IB), 0)
C
C
            CALL MOVBIT( MAG, 120+IMAG  , 6, IBHFM(1,IB), 6)
            CALL MOVBIT( MAG, 120+IMAG+8, 6, IBHFM(1,IB), 0)
C
            CALL MOVBIT( MAG, 136+IMAG  , 6, IBHFM(2,IB), 6)
            CALL MOVBIT( MAG, 136+IMAG+8, 6, IBHFM(2,IB), 0)
C
            CALL MOVBIT( MAG, 152+IMAG  , 6, IBHFM(3,IB), 6)
            CALL MOVBIT( MAG, 152+IMAG+8, 6, IBHFM(3,IB), 0)
C
  90  CONTINUE
C
      RETURN
      END
