C
C________________________________________________________________
C
C     PROGRAM  W I S _ U N C M
C________________________________________________________________
C
C PROGRAM WIS_UNCM PERFORMS THE INVERSE OPERATION OF WIS_CMPR.
C THE ORIGINAL FILES ARE ASCII DATA FILES GENERATED BY HIGH-SENSE
C GEOPHYSICS LIMITED AS THE FINAL DATA FILES FOR THE WISCONSIN
C 1998/99 AEROMAGNETIC SURVEY.
C
C FOR A BRIEF DESCRIPTION OF THE COMPRESSION, SEE THE SOURCE CODE
C FOR PROGRAM WIS_CMPR.  THE UNCOMPRESSION (THIS PROGRAM) IS ITS
C EXACT INVERSE AND SHOULD PRODUCE FILES IDENTICAL TO THE
C ORIGINAL INPUT FILES.
C
C NOTES:
C
C 1) SOME COMPILERS SPECIFY RECORD LENGTHS IN 4-BYTE WORDS AND
C OTHER COMPILERS USE BYTES.  IF COMPILING THIS SOURCE CODE, THE
C OPEN STATEMENTS MAY NEED MODIFICATION.
C
C 2) THE ORIGINAL FILES USED THE CONVENTION THAT, WHERE
C APPLICABLE, A LEADING ZERO BEFORE THE DECIMAL WAS SUPPRESSED (
C FOR EXAMPLE -.73 INSTEAD OF THE CONVENTIONAL -0.73 ).
C THEREFORE, OBTAINING AN EXACT MATCH OF THE UNCOMPRESSED FILES
C TO THE ORIGINAL FILES MAY BE DEPENDENT UPON PROPER SELECTION OF
C COMPILER OPTIONS TO PRODUCE THE SUPPRESSED LEADING ZERO.
C
C 3) THE ORIGINAL FILES HAD 17 TRAILING PAD SPACES IN EACH ASCII
C RECORD.  THIS PROGRAM HAS INCLUDED THOSE PADS FOR COMPARISON
C AND CONSISTANCY PURPOSES.  BEYOND THAT, THEY SERVE NO PURPOSE
C AND CAN BE REMOVED IF DESIRED.
C
C 4) THE COMPRESSED FILES SHOULD ALWAYS BE PORTED IN A "BINARY"
C MODE.  THE UNCOMPRESSED OR ORIGINAL FILES CAN USUALLY BE PORTED
C IN EITHER "BINARY" OR "ASCII" MODE BUT TO AVOID CONFUSION
C SHOULD BE PORTED IN "ASCII" MODE.
C
C 5) IN ASCII FORMATTED FILES, SOME MACHINES USE A SINGLE NEWLINE
C CHARACTER (ASCII DECIMAL 10) TO DESIGNATE THE END OF A RECORD.
C OTHERS USE A CARRIAGE-RETURN (ASCII DECIMAL 13) AND NEWLINE
C CHARACTER.  IF THE ORIGINAL FILES ARE PORTED ACROSS PLATFORMS
C IN A "BINARY" MODE, THE UNCOMPRESSED FILES MAY BE A DIFFERENT
C LENGTH THAN THE ORIGINAL FILES DUE TO THE EXTRA CARRIAGE RETURN
C CHARACTER.
C
C
C PROGRAM WIS_UNCM WRITTEN BY ROB BRACKEN, USGS.
C FORTRAN 77, HP FORTRAN/9000, HP-UX RELEASE 11.0
C VERSION 1.0, 19991220.
C VERSION 1.1, 19991229. (I4CNV MAKES BYTE SWAPPING TRANSPARENT)
C
C NOTE:  THIS ALGORITHM IS AN IN-HOUSE PROGRAM GENERATED BY ROB
C BRACKEN AT THE USGS.  IT HAS NOT YET BEEN OFFICIALLY RELEASED
C AND MAY CONTAIN METHODS OR IDEAS THAT SHOULD BE CREDITED TO THE
C WRITER.  NO GUARANTIES OR WARRANTIES ARE GIVEN, EXPRESSED OR
C IMPLIED.
C
C
      program wis_uncm
C
C
C DECLARATIONS
C
C     I/O
      integer*4 itty,otty,idsk,odsk
      parameter(itty=5,otty=6,idsk=10,odsk=11)
      character*132 ifile,ofile
C
C     INPUT DATA
      integer*4 ifl,idir1,idir2
      character*2 adir
      real*8 dlond,dlatd,dutmxm,dutmym,dfid
      integer*4 iyd,iyd1,iyd2,iut,iut1,iut2
      real*8 drdrm,dbarm,dgpsm,ddiunt,drmgnt,ddmgnt,dimgnt,dlmgnt
C
C     I*4 CONVERTED VARIABLES
      integer*4 i4fld,i4lon,i4lat,i4utx,i4uty,i4fid,i4yjd,i4utc,
     &          i4rdr,i4bar,i4gps,i4diu,i4rmg,i4dmg,i4img,i4lmg
      integer*4 i4a(16,3)
C
C     COMPRESSION SUBROUTINE
      integer*4 nbytes
C
C     OUTPUT BUFFER
      byte iobuff(128)
      integer*4 i4buff(32)
      equivalence(iobuff,i4buff)
C
C     MISC COUNTERS AND INDICIES
      integer*4 i,iinb,io0,irec,j,ninb,nrec,nwrite
C
C
C PROGRAM DESCRIPTION
C
      write(otty,801)
  801 format(//,' This program UNCOMPRESSES ascii data files',
     & ' from the Wisconsin',/,' 98/99 aeromag survey, flown by',
     & ' High-Sense Geophysics Limited.')
C
C
C GET NAME OF INPUT AND OUTPUT FILES
C
      write(otty,802)
  802 format(/,' Type name of input compressed file',/,' * ',$)
      read(itty,803) ifile
  803 format(a132)
C
      write(otty,804)
  804 format(' Type name of output ascii file',/,' * ',$)
      read(itty,803) ofile
C
C
C OPEN INPUT AND OUTPUT FILES
C
C
      open(odsk,file=ofile,status='new',form='formatted')
C
C     NOTE:  CERTAIN COMPILERS MAY USE 4-BYTE UNITS FOR RECL=
c      open(idsk,file=ifile,status='old',form='unformatted',
c     & access='direct',recl=16)
C
C     NOTE:  OTHER COMPILERS MAY USE 1-BYTE UNITS FOR RECL=
      open(idsk,file=ifile,status='old',form='unformatted',
     & access='direct',recl=64)
C
C
C INITIALIZATIONS
C
C     TOT NBR OF RECS AND DATA BYTES FROM 1ST REC OF INPUT FILE
      io0=0
      irec=0
      iinb=0
      call readb(idsk,iobuff,io0,irec,iinb,*912)
c      nrec=i4buff(1)
      call i4cnv(1, nrec,iobuff(1))
c      ninb=i4buff(2)
      call i4cnv(1, ninb,iobuff(5))
C
C     INPUT BUFFER INDEX OF BYTES CURRENTLY IN BUFFER
      io0=0
C
C     CURRENT INPUT RECORD NUMBER
C     (RECORD 1 IS RESERVED FOR TOTAL NUMBER OF DATA BYTES)
      irec=1
C
C     TOT NBR OF INPUT DATA BYTES CURRENTLY HAVING BEEN UTILIZED
      iinb=0
C
C     I4 DIFFERENCING ARRAY
      do j=1,3
        do i=1,16
          i4a(i,j)=0
        enddo
      enddo
C
C     NUMBER OF OUTPUT RECORDS (143 BYTES PER RECORD + 17 PADS)
      nwrite=0
C
C
C LOAD IOBUFF() FOR UNCOMPRESSING
C
  207 call readb(idsk,iobuff,io0,irec,iinb,*912)
C
C
C UNCOMPRESS ONE RECORD FROM IOBUFF() INTO I4A()
C
      call unmash(i4a(1,3),iobuff,nbytes,*913)
      iinb=iinb+nbytes
C
C
C ADD ARRAY VARIABLES AND SHIFT THEM
C
      do i=1,16
        i4a(i,2)=i4a(i,1)+i4a(i,3)
        i4a(i,1)=i4a(i,2)
        i4a(i,2)=i4a(i,3)
      enddo
C
C
C PUT THE 1ST COLUMN OF THE DIFFERENCING ARRAY INTO 16 VARIABLES
C
      i4fld=i4a( 1,1)
      i4lon=i4a( 2,1)
      i4lat=i4a( 3,1)
      i4utx=i4a( 4,1)
      i4uty=i4a( 5,1)
      i4fid=i4a( 6,1)
      i4yjd=i4a( 7,1)
      i4utc=i4a( 8,1)
      i4rdr=i4a( 9,1)
      i4bar=i4a(10,1)
      i4gps=i4a(11,1)
      i4diu=i4a(12,1)
      i4rmg=i4a(13,1)
      i4dmg=i4a(14,1)
      i4img=i4a(15,1)
      i4lmg=i4a(16,1)
C
C
C CONVERT 16 INTEGER*4 VARIABLES TO THE 17 VARIOUS FIELDS
C
      ifl=i4fld/10000
      idir1=(i4fld-ifl*10000)/100
      idir2=i4fld-ifl*10000-idir1*100
C
      adir(1:1)=char(idir1+32)
      adir(2:2)=char(idir2+32)
      dlond =dfloat(i4lon)*1.d-4
      dlatd =dfloat(i4lat)*1.d-4
      dutmxm=dfloat(i4utx)*1.d-1
      dutmym=dfloat(i4uty)*1.d-1
      dfid  =dfloat(i4fid)*1.d-1
      iyd   =       i4yjd
          iyd1=iyd/1000
          iyd2=iyd-iyd1*1000
      iut   =       i4utc
          iut1=iut/10000
          iut2=iut-iut1*10000
      drdrm =dfloat(i4rdr)*1.d-2
      dbarm =dfloat(i4bar)*1.d-1
      dgpsm =dfloat(i4gps)*1.d-1
      ddiunt=dfloat(i4diu)*1.d-2
      drmgnt=dfloat(i4rmg)*1.d-2
      ddmgnt=dfloat(i4dmg)*1.d-2
      dimgnt=dfloat(i4img)*1.d-2
      dlmgnt=dfloat(i4lmg)*1.d-2
C
C
C WRITE ONE RECORD TO THE OUTPUT FILE
C
      write(odsk,805)
     & ifl,adir,dlond,dlatd,dutmxm,dutmym,dfid,iyd1,iyd2,iut1,
     & iut2,drdrm,dbarm,dgpsm,ddiunt,drmgnt,ddmgnt,dimgnt,dlmgnt
  805 format(i6,a2,2f10.4,2f10.1,f9.1,2i3,i4,i4.3,f8.2,2f7.1,
     & 5f10.2,'                 ')
      nwrite=nwrite+1
      if(iinb.ge.ninb) goto 999
      goto 207
C
C
C EXIT PROCEDURE
C
C     io0 INDEX ERROR
  912 write(otty,811) io0
  811 format(//,' (MAIN)  ERROR.  io0 =',i12,' > 128',//)
      goto 999
C
C     NUMBER TOO LARGE ERROR
  913 write(otty,814)
  814 format(//,' (MAIN)  ERROR.  Number > 1,073,873,451',//)
      goto 999
C
  999 write(otty,808) nwrite,nwrite*143
  808 format(/,' Output:',i12,' records',i12,' bytes')
      if(irec.gt.nrec) irec=nrec
      write(otty,809) irec,irec*64
  809 format(  ' Input: ',i12,' records',i12,
     & ' bytes (w/overhead)')
      write(otty,810) dfloat(nwrite)*1.43d4/6.4d1/irec,ninb
  810 format(  ' Ratio: ',f12.2,'%       ',i12,
     & ' bytes (compressed)',/)
C
      close(unit=idsk)
      close(unit=odsk)
      end
C
C________________________________________________________________
C
C     SUBROUTINE  R E A D B
C________________________________________________________________
C
C SUBROUTINE READB READS A BINARY RECORD FROM A DIRECT ACCESS
C INPUT FILE.  THE FILE MUST BE OPENED BEFORE CALLING READB.
C
C INPUT ARGUMENT:
C   IDSK   - INTEGER*4.  UNIT NUMBER OF A DIRECT ACCESS INPUT
C            FILE.  THE FILE MUST HAVE BEEN OPENED WITH A RECORD
C            LENGTH OF 64 BYTES BEFORE CALLING THIS SUBROUTINE.
C
C INPUT/OUTPUT ARGUMENTS:
C   IOBUFF - BYTE.  ARRAY OF LENGTH 128 BYTES CONTAINING THE DATA
C            WHICH HAS BEEN READ FROM THE INPUT FILE.  BEFORE
C            READING NEW DATA, THE DATA IN IOBUFF WILL BE LEFT-
C            SHIFTED TO DROP THE BYTES THAT HAVE ALREADY BEEN
C            UTILIZED IN THE CALLING PROGRAM.  THE NUMBER OF
C            BYTES TO DROP IS CALCULATED FROM THE INPUT VALUES OF
C            IINB, IREC, AND IO0.  ONCE SHIFTED, A 64-BYTE RECORD
C            IS READ INTO THE ELEMENTS TO THE RIGHT OF THE
C            ADJUSTED IO0.  IF THE 128-BYTE IOBUFF ARRAY DOES NOT
C            HAVE ENOUGH ADDITIONAL SPACE FOR A 64-BYTE RECORD,
C            THE READ IS NOT PERFORMED.  ALSO, IF A READ ERROR IS
C            ENCOUNTED (AS MIGHT OCCUR AT THE END OF THE FILE),
C            THE READ IS NOT PERFORMED.
C   IO0    - INTEGER*4.  THE VALID-DATA INDEX OF ARRAY IOBUFF.
C            VALID DATA ARE CONTAINED IN ALL ELEMENTS OF IOBUFF
C            TO THE LEFT OF IO0 INCLUSIVE.  ALL ELEMENTS TO THE
C            RIGHT OF IO0 EXCLUSIVE ARE NON-DATA AND MAY BE
C            MODIFIED BY THIS SUBROUTINE.  IO0 WILL BE MODIFIED
C            DURING THE CALL TO REFLECT THE AMOUNT OF LEFT SHIFT
C            AS DESCRIBED ABOVE IN ARGUMENT IOBUFF.  THE VALUE OF
C            IO0 DURING THE CALL IS USED IN THE CALCULATION FOR
C            DETERMINING THE AMOUNT OF LEFT SHIFT.  IF, AFTER THE
C            LEFT SHIFT, IO0 IS GREATER THAN 63, A NEW RECORD
C            WILL NOT BE READ IN.  IF HOWEVER, A NEW RECORD IS
C            READ IN, IO0 WILL BE MODIFIED AGAIN TO REFLECT THE
C            RIGHT END OF THE NEW DATA.
C   IREC   - INTEGER*4.  THE CURRENT RECORD NUMBER OF THE INPUT
C            FILE.  IF A READ IS TO BE MADE, IREC WILL BE
C            INCREMENTED BEFORE READING.  IF IO0 IS GREATER THAN
C            63, IREC WILL NOT BE CHANGED AND A READ WILL NOT BE
C            PERFORMED.  THE VALUE OF IREC DURING THE CALL IS
C            USED IN THE CALCULATION FOR DETERMINING THE AMOUNT
C            OF LEFT SHIFT OF ARRAY IOBUFF.
C
C INPUT ARGUMENT:
C   IINB   - INTEGER*4.  THE TOTAL NUMBER OF BYTES UTILIZED BY
C            THE CALLING PROGRAM BEFORE CALLING THIS SUBROUTINE.
C            TYPICALLY, IINB WILL BE SLIGHTLY SMALLER THAN THE
C            TOTAL NUMBER OF BYTES READ IN.  AN APPROPRIATE
C            CALCULATION USING IREC, IO0, AND IINB GIVES THE
C            NUMBER OF BYTES AT THE LEFT END OF IOBUFF THAT HAVE
C            ALREADY BEEN UTILIZED BY THE CALLING PROGRAM.  FOR
C            EXAMPLE IF THREE 64-BYTE RECORDS HAVE BEEN READ IN,
C            IO0=70, AND IINB=150, THEN THE CONTENTS OF IOBUFF
C            WILL BE SHIFTED LEFT 28 BYTES AND THE VALUE OF IO0
C            DECREASED TO 42.  THIS MAKES ROOM FOR A NEW 64-BYTE
C            RECORD TO BE READ IN AND IO0 WILL THEN BE INCREASED
C            TO 42+64=106.  IINB IS NOT CHANGED IN THIS
C            SUBROUTINE.  HOWEVER, THE NUMBER OF BYTES THAT ARE
C            UTILIZED OFF OF THE LEFT END OF IOBUFF BY THE
C            CALLING PROGRAM AFTER THE CALL TO THIS SUBROUTINE
C            MUST BE ADDED TO IINB BY THE CALLING PROGRAM BEFORE
C            AGAIN CALLING THIS SUBROUTINE.
C
C RETURNS:
C   NORMAL - WHENEVER THE PRESCRIBED OPERATIONS ARE COMPLETED.
C   1ST    - ONLY IF DURING THE CALL, IO0 IS GREATER THAN 128.
C
C
C SUBROUTINE READB WRITTEN BY ROB BRACKEN, USGS.
C FORTRAN 77, HP FORTRAN/9000, HP-UX RELEASE 11.0
C VERSION 1.0, 19991220.
C
C NOTE:  THIS ALGORITHM IS AN IN-HOUSE PROGRAM GENERATED BY ROB
C BRACKEN AT THE USGS.  IT HAS NOT YET BEEN OFFICIALLY RELEASED
C AND MAY CONTAIN METHODS OR IDEAS THAT SHOULD BE CREDITED TO THE
C WRITER.  NO GUARANTIES OR WARRANTIES ARE GIVEN, EXPRESSED OR
C IMPLIED.
C
C
      subroutine readb(idsk,iobuff,io0,irec,iinb,*)
C
C
C DECLARATIONS
C
C     INPUT ARGUMENT
      integer*4 idsk
C
C     INPUT/OUTPUT ARGUMENTS
      byte iobuff(*)
      integer*4 io0,irec
C
C     INPUT ARGUMENT
      integer*4 iinb
C
C     READING ARRAY
      byte jbuff(64)
C
C     MISC INDICIES
      integer*4 i,io1
C
C
C CHECK VALUES OF INDEX VARIABLES
C
      if(io0.lt.1) io0=0
      if(io0.gt.128) goto 991
      if(iinb.lt.0) iinb=0
      if(irec.lt.0) irec=0
C
C
C SLIDE IOBUFF() TO THE LEFT AND ADJUST io0 ACCORDINGLY
C
      io1=io0-((irec-1)*64-iinb)
      do i=io1+1,io0
        iobuff(i-io1)=iobuff(i)
      enddo
      io0=io0-io1
      if(io0.lt.0) io0=0
      if(io0.gt.128) goto 991
C
C
C READ FROM INPUT FILE ONLY IF THERE IS ENOUGH ROOM IN IOBUFF()
C
      if(io0.ge.64) goto 990
      irec=irec+1
      read(idsk,rec=irec,err=901) jbuff
C
C
C PUT DATA INTO READING ARRAY
C
      do i=1,64
        iobuff(io0+i)=jbuff(i)
      enddo
      io0=io0+64
      if(io0.gt.128) goto 991
      goto 990
C
C
C EXIT PROCEDURE
C
  901 irec=irec-1
  990 return
  991 return 1
      end
C
C________________________________________________________________
C
C     SUBROUTINE  U N M A S H
C________________________________________________________________
C
C SUBROUTINE UNMASH UNCOMPRESSES AN ARRAY OF VARIABLE LENGTH INTO
C 16 FOUR-BYTE INTEGERS.  THE METHOD USED UNCODIFIES THE BITS
C THAT DESCRIBE A VALUE AND THEN PLACES THE VALUE IN A 4-BYTE
C INTEGER.  THE NUMBER OF BITS USED IN THE COMPRESSED INTEGER HAS
C BEEN CODIFIED INTO THE BIT PATTERN SO THAN THE BOUNDARIES ARE
C IMPLICIT.
C
C OUTPUT ARGUMENT:
C   I4A    - INTEGER*4.  16-ELEMENT ARRAY CONTAINING THE INTEGERS
C            THAT HAVE BEEN UNCOMPRESSED.  FOR DETAILS, SEE
C            SUBROUTINE MASHER.
C
C INPUT ARGUMENTS:
C   MASH   - BYTE.  64-ELEMENT ARRAY CONTAINING THE COMPRESSED
C            CODE AND VALUES.  UNDER MOST CIRCUMSTANCES THE
C            ENTIRE LENGTH OF MASH WILL NOT BE READ, BUT IT MUST
C            BE 64 BYTES TO HANDLE THE POSSIBILITY THAT NO
C            COMPRESSION HAD OCCURRED.
C   NBYTES - INTEGER*4.  THE ACTUAL NUMBER OF BYTES THAT WERE
C            READ IN FROM MASH TO OBTAIN THE 16 INTEGERS.  THE
C            COMPRESSED STREAM OF 16 INTEGERS ALWAYS ENDS ON A
C            BYTE BOUNDARY.
C
C RETURNS:
C   NORMAL - WHENEVER THE PRESCRIBED OPERATIONS ARE COMPLETED.
C   1ST    - NEVER USED.  THIS SUBROUTINE SHOULD NOT PRODUCE
C            DATA-DEPENDENT ERRORS.  (BUT, IT IS VERY GOOD AT
C            "G.I.G.O.")
C
C
C SUBROUTINE UNMASH WRITTEN BY ROB BRACKEN, USGS.
C FORTRAN 77, HP FORTRAN/9000, HP-UX RELEASE 11.0
C VERSION 1.0, 19991220.
C
C NOTE:  THIS ALGORITHM IS AN IN-HOUSE PROGRAM GENERATED BY ROB
C BRACKEN AT THE USGS.  IT HAS NOT YET BEEN OFFICIALLY RELEASED
C AND MAY CONTAIN METHODS OR IDEAS THAT SHOULD BE CREDITED TO THE
C WRITER.  NO GUARANTIES OR WARRANTIES ARE GIVEN, EXPRESSED OR
C IMPLIED.
C
C
      subroutine unmash(i4a,mash,nbytes,*)
C
C
C DECLARATIONS
C
C     INPUT ARGUMENTS
      integer*4 i4a(16)
      byte mash(64)
      integer*4 nbytes
C
C     THE NUMBER TO UNCOMPRESS
      integer*4 n4
C
C     INSTRUCTION ARRAY
C        COL1: INSTRUCTIONS FOR CLEAR BIT
C        COL2: INSTRUCTIONS FOR SET BIT
C        ROW1: ENTRY POINT, EVALUATE 1ST BIT IN THE SERIES
C        POS ARRAY VALUE:  ROW NUMBER FOR EVALUATING NEXT BIT
C        NEG ARRAY VALUE:  EXIT POINT, GOTO-VALUE FOR BRANCHING
      byte inst(7,2)
      data inst /  2,-1,-2,-3, 6,-4,-6,
     &            -8, 3, 4, 5, 7,-5,-7 /
C
C     MISC INDICIES
      integer*4 ibitsr,ipwr,ix,jrow,k,kcol
C
C
C INITIALIZATIONS
C
C     I4A() INDEX
      k=0
C
C     CURRENT BIT LOCATION IN MASH()
      ibitsr=8
      nbytes=1
C
C
C CHECK POSITION IN I4A AND INITIALIZE ENTRY-ROW NBR OF INST()
C
  209 if(k.ge.16) goto 990
      jrow=1
C
C
C INCREMENT CURRENT BIT LOC IN MASH()
C
  200 ibitsr=ibitsr-1
      if(ibitsr.lt.0) then
        ibitsr=7
        nbytes=nbytes+1
      endif
C
C
C FIND INSTRUCTION COLUMN BASED ON VALUE OF CURRENT BIT IN MASH()
C
      if(btest(mash(nbytes),ibitsr)) then
        kcol=2
      else
        kcol=1
      endif
C
C
C FIND INSTRUCTION FOR CURRENT BIT
C
      ix=inst(jrow,kcol)
      if(ix.gt.0) then
        jrow=ix
      else
        n4=0
        k=k+1
        goto(101,102,103,104,105,106,107,108),-ix
      endif
      goto 200
C
C
C EVALUATE I4A() FOR VARIOUS INSTRUCTIONS FROM INST()
C
C     INSTRUCTION -1, EVALUATE 0-BIT NUMBER
  101 i4a(k)=n4
      goto 209
C
C     INSTRUCTION -2, EVALUATE 1-BIT NUMBER
  102 ibitsr=ibitsr-1
      if(ibitsr.lt.0) then
        ibitsr=7
        nbytes=nbytes+1
      endif
      if(btest(mash(nbytes),ibitsr)) then
        n4=1
      else
        n4=-1
      endif
      i4a(k)=n4
      goto 209
C
C     INSTRUCTION -3, EVALUATE 4-BIT NUMBER
  103 do ipwr=3,0,-1
        ibitsr=ibitsr-1
        if(ibitsr.lt.0) then
          ibitsr=7
          nbytes=nbytes+1
        endif
        if(btest(mash(nbytes),ibitsr)) n4=n4+2**ipwr
      enddo
      if(n4.le.7) then
        n4=n4-9
      else
        n4=n4-6
      endif
      i4a(k)=n4
      goto 209
C
C     INSTRUCTION -4, EVALUATE 2-BIT NUMBER
  104 do ipwr=1,0,-1
        ibitsr=ibitsr-1
        if(ibitsr.lt.0) then
          ibitsr=7
          nbytes=nbytes+1
        endif
        if(btest(mash(nbytes),ibitsr)) n4=n4+2**ipwr
      enddo
      if(n4.le.1) then
        n4=n4-11
      else
        n4=n4+8
      endif
      i4a(k)=n4
      goto 209
C
C     INSTRUCTION -5, EVALUATE 6-BIT NUMBER
  105 do ipwr=5,0,-1
        ibitsr=ibitsr-1
        if(ibitsr.lt.0) then
          ibitsr=7
          nbytes=nbytes+1
        endif
        if(btest(mash(nbytes),ibitsr)) n4=n4+2**ipwr
      enddo
      if(n4.le.31) then
        n4=n4-43
      else
        n4=n4-20
      endif
      i4a(k)=n4
      goto 209
C
C     INSTRUCTION -6, EVALUATE 10-BIT NUMBER
  106 do ipwr=9,0,-1
        ibitsr=ibitsr-1
        if(ibitsr.lt.0) then
          ibitsr=7
          nbytes=nbytes+1
        endif
        if(btest(mash(nbytes),ibitsr)) n4=n4+2**ipwr
      enddo
      if(n4.le.511) then
        n4=n4-555
      else
        n4=n4-468
      endif
      i4a(k)=n4
      goto 209
C
C     INSTRUCTION -7, EVALUATE 18-BIT NUMBER
  107 do ipwr=17,0,-1
        ibitsr=ibitsr-1
        if(ibitsr.lt.0) then
          ibitsr=7
          nbytes=nbytes+1
        endif
        if(btest(mash(nbytes),ibitsr)) n4=n4+2**ipwr
      enddo
      if(n4.le.131071) then
        n4=n4-131627
      else
        n4=n4-130516
      endif
      i4a(k)=n4
      goto 209
C
C     INSTRUCTION -8, EVALUATE 31-BIT NUMBER
  108 do ipwr=30,0,-1
        ibitsr=ibitsr-1
        if(ibitsr.lt.0) then
          ibitsr=7
          nbytes=nbytes+1
        endif
        if(btest(mash(nbytes),ibitsr)) n4=n4+2**ipwr
      enddo
      if(n4.le.1073741823) then
        n4=n4-1073873451
      else
        n4=n4-1073610196
      endif
      i4a(k)=n4
      goto 209
C
C
C EXIT PROCEDURE
C
  990 return
  991 return 1
      end
C
C________________________________________________________________
C
C     SUBROUTINE  I 4 C N V
C________________________________________________________________
C
C SUBROUTINE I4CNV PUTS AN INTEGER*4 VALUE INTO A 4-ELEMENT BYTE
C ARRAY SUCH THAT THE FIRST ELEMENT IS THE MOST-SIGNIFICANT BYTE
C AND THE 4TH ELEMENT IS THE LEAST-SIGNIFICANT BYTE.  IT ALSO
C PERFORMS THE INVERSE OPERATION.  THE RESULT IS THE SAME AS IF
C AN EQUIVALENCE BETWEEN THE NUMBER AND THE ARRAY WAS PERFORMED
C ON A UNIX-LIKE MACHINE.  HOWEVER, IF THE EQUIVALENCE WAS
C PERFORMED ON A VAX-LIKE MACHINE, THE RESULT WOULD BE A REVERSAL
C OF THE BYTES.  THIS SUBROUTINE IS DESIGNED TO CIRCUMVENT THIS
C DISPARITY, SO THAT INTEGER*4 VARIABLES CAN BE WRITTEN TO AND
C READ FROM A FILE WITHOUT HAVING BYTE REVERSAL PROBLEMS AND
C WITHOUT NECESSITATING USE OF COMPILER SWITCHES TO FIX THE
C PROBLEMS.
C
C INPUT ARGUMENT:
C   NVERSE - INTEGER*4.  IF NVERSE IS SET TO 0, THE FORWARD
C            OPERATION WILL BE PERFORMED SUCH THAT THE INTEGER*4
C            VARIABLE WILL BE PUT INTO THE BYTE ARRAY.  IF NVERSE
C            IS SET TO 1, THE INVERSE OPERATION WILL BE PERFORMED
C            SUCH THAT THE BYTE ARRAY WILL BE PUT BACK INTO THE
C            INTEGER*4 VARIABLE.
C
C INPUT/OUTPUT ARGUMENTS:
C   I4A    - INTEGER*4.  THE INTEGER*4 VARIABLE TO BE CONVERTED.
C            IF NVERSE IS 0, I4A IS AN INPUT ARGUMENT.  IF NVERSE
C            IS 1, I4A IS AN OUTPUT ARGUMENT.
C   K1B    - BYTE.  THE 4-ELEMENT BYTE ARRAY TO BE CONVERTED.
C            IF NVERSE IS 0, I4A IS AN OUTPUT ARGUMENT.  IF
C            NVERSE IS 1, I4A IS AN INPUT ARGUMENT.
C
C
C SUBROUTINE I4CNV WRITTEN BY ROB BRACKEN, USGS.
C FORTRAN 77, HP FORTRAN/9000, HP-UX RELEASE 11.0
C VERSION 1.0, 19991229.
C
C NOTE:  THIS ALGORITHM IS AN IN-HOUSE PROGRAM GENERATED BY ROB
C BRACKEN AT THE USGS.  IT HAS NOT YET BEEN OFFICIALLY RELEASED
C AND MAY CONTAIN METHODS OR IDEAS THAT SHOULD BE CREDITED TO THE
C WRITER.  NO GUARANTIES OR WARRANTIES ARE GIVEN, EXPRESSED OR
C IMPLIED.
C
C
      subroutine i4cnv(nverse, i4a,k1b)
C
C DECLARATIONS
C
C     INPUT ARGUMENT
      integer*4 nverse
C
C     INPUT/OUTPUT ARGUMENTS
      integer*4 i4a
      byte k1b(4)
C
C     INTERNAL VARIABLES
      integer*4 i0,j0,k0,k
      byte ksgn
      integer*4 jsgn
C
C
C DECIDE WHETHER TO PERFORM FORWARD OR INVERSE OPERATION
C
      if(nverse.ge.1) goto 101
C
C
C PERFORM THE FORWARD OPERATION I4A -> K1B
C (ASSUMES THAT ALL INTEGERS ARE 4-BYTE TWOS COMPLEMENT,
C AND THE HIGH-BIT IS THE SIGN BIT)
C
C     INITIALIZE THE RUNNING VALUE AND THE SIGN BIT VALUE
      j0=i4a
      ksgn=0
C
C     CHECK FOR THE RUNNING VALUE LESS THAN ZERO
      if(j0.lt.0) then
C
C       CLEAR ONLY THE SIGN BIT
        j0=j0+2**30
        j0=j0+2**30
C
C       REMEMBER THE SIGN BIT FOR LATER APPLICATION TO THE MSB
        ksgn=64
      endif
C
C     CALCULATE THE BIT PATTERN FOR EACH OF THE 4 BYTES
      do k=4,2,-1
        i0=j0
        j0=i0/256
        k0=i0-j0*256
        if(k0.gt.127) k0=k0-256
        k1b(k)=k0
      enddo
      k1b(k)=j0
C
C     RESTORE THE SIGN BIT IN THE MOST SIGNIFICANT BYTE
      k1b(k)=k1b(k)-ksgn
      k1b(k)=k1b(k)-ksgn
      goto 990
C
C
C PERFORM THE INVERSE OPERATION K1B -> I4A
C
C     INITIALIZE THE RUNNING VALUE AND THE SIGN BIT VALUE
  101 i4a=k1b(1)
      jsgn=0
C
C     CHECK FOR THE RUNNING VALUE LESS THAN ZERO
      if(i4a.lt.0) then
C
C       CLEAR ONLY THE SIGN BIT
        i4a=i4a+128
C
C       REMEMBER THE SIGN BIT FOR LATER APPLICATION TO THE MSB
        jsgn=2**30
      endif
C
C     RESTORE THE BIT PATTERN FOR EACH OF THE 4 BYTES
      do k=2,4
        k0=k1b(k)
        if(k0.lt.0) k0=k0+256
        i4a=i4a*256+k0
      enddo
C
C     RESTORE THE SIGN BIT
      i4a=i4a-jsgn
      i4a=i4a-jsgn
C
C
C EXIT PROCEDURE
C
  990 return
      end