C C________________________________________________________________ C C PROGRAM W I S _ C M P R C________________________________________________________________ C C PROGRAM WIS_CMPR COMPRESSES ASCII DATA FILES OF A SPECIFIC C FORMAT, GENERATED BY HIGH-SENSE GEOPHYSICS LIMITED AS THE FINAL C DATA FILES FOR THE WISCONSIN 1998/99 AEROMAGNETIC SURVEY. THIS C PROGRAM IS NOT A GENERAL COMPRESSION ALGORITHM, BUT RATHER C UTILIZES SPECIFIC FORMATING KNOWLEDGE ABOUT THE FILES. IT C PARTICULARLY TAKES ADVANTAGE OF THE FACT THAT THE DATA ARE C ARRANGED IN A SPECIFIC ASCII FORMAT AND THAT MOST DATA CHANNELS C DO NOT CHANGE BY LARGE AMOUNTS FROM RECORD TO RECORD. C C THE ALGORITHM EMPLOYS THE FOLLOWING 3 STEP PROCESS: C C 1) CONVERT THE 17 ASCII-FORMATTED NUMBERS INTO 16 INTEGER*4 C VARIABLES, C 2) REDUCE THE ABSOLUTE VALUE OF EACH OF THE 16 INTEGER C VALUES BY FINDING THE DIFFERENCE BETWEEN IT AND C THE CORRESPONDING VALUE IN THE PREVIOUS RECORD, C 3) COMPRESS THE DIFFERENCES USING THE FACT THAT SMALLER C ABSOLUTE VALUES REQUIRE LESS STORAGE SPACE. C C THE COMPRESSION ROUTINE USED IN STEP 3 IS NOT A GENERAL C ROUTINE. IT DOES NOT UTILIZE ANY PROPRIETARY FORMAT, NOR IS IT C AS EFFICIENT AS IS MIGHT BE POSSIBLE. C 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_CMPR 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_cmpr 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 integer*4 io0,ioutb,irec,noutb,nrec integer*4 nread C C MISC INDEX VARIABLES integer*4 i,j C C INPUT DATA integer*4 ifl 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 FOUR-BYTE INTEGER 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 byte mash(64) C C OUTPUT BUFFER byte iobuff(128) integer*4 i4buff(32) equivalence(iobuff,i4buff) C C C PROGRAM DESCRIPTION C write(otty,801) 801 format(//,' This program COMPRESSES 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 ascii file',/,' * ',$) read(itty,803) ifile 803 format(a132) C write(otty,804) 804 format(' Type name of output compressed file',/,' * ',$) read(itty,803) ofile C C C OPEN INPUT AND OUTPUT FILES C open(idsk,file=ifile,status='old',form='formatted') C C NOTE: CERTAIN COMPILERS MAY USE 4-BYTE UNITS FOR RECL= c open(odsk,file=ofile,status='new',form='unformatted', c & access='direct',recl=16) C C NOTE: OTHER COMPILERS MAY USE 1-BYTE UNITS FOR RECL= open(odsk,file=ofile,status='new',form='unformatted', & access='direct',recl=64) C C C INITIALIZATIONS C C NUMBER OF INPUT RECORDS (143 BYTES PER RECORD) nread=0 C C DIFFERENCING ARRAY do j=1,3 do i=1,16 i4a(i,j)=0 enddo enddo C C THE OUTPUT BUFFER INDEX io0=0 C C CURRENT OUTPUT RECORD NUMBER C (RECORD 1 IS RESERVED FOR TOTAL NUMBER OF DATA BYTES) irec=1 C C CURRENT NUMBER OF DATA BYTES OUTPUT TO FILE ioutb=0 C C C READ ONE LINE FROM THE INPUT FILE C 207 read(idsk,805,end=106) & 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,2i4,f8.2,2f7.1, & 5f10.2) nread=nread+1 C C C CONVERT 19 ASCII NBRS (17 CHANNELS) TO 16 INTEGER*4 VARIABLES C i4fld= ifl*10000 & +(ichar(adir(1:1))-32)*100 & +(ichar(adir(2:2))-32) i4lon=nint(dlond *1.d4) i4lat=nint(dlatd *1.d4) i4utx=nint(dutmxm*1.d1) i4uty=nint(dutmym*1.d1) i4fid=nint(dfid *1.d1) iyd=iyd1*1000+iyd2 i4yjd= iyd iut=iut1*10000+iut2 i4utc= iut i4rdr=nint(drdrm *1.d2) i4bar=nint(dbarm *1.d1) i4gps=nint(dgpsm *1.d1) i4diu=nint(ddiunt*1.d2) i4rmg=nint(drmgnt*1.d2) i4dmg=nint(ddmgnt*1.d2) i4img=nint(dimgnt*1.d2) i4lmg=nint(dlmgnt*1.d2) C C C PUT THE 16 VARIABLES INTO THE INTEGER*4 DIFFERENCING ARRAY C i4a( 1,3)=i4fld i4a( 2,3)=i4lon i4a( 3,3)=i4lat i4a( 4,3)=i4utx i4a( 5,3)=i4uty i4a( 6,3)=i4fid i4a( 7,3)=i4yjd i4a( 8,3)=i4utc i4a( 9,3)=i4rdr i4a(10,3)=i4bar i4a(11,3)=i4gps i4a(12,3)=i4diu i4a(13,3)=i4rmg i4a(14,3)=i4dmg i4a(15,3)=i4img i4a(16,3)=i4lmg C C C SHIFT ARRAY VARIABLES AND DIFFERENCE THEM C do i=1,16 i4a(i,1)=i4a(i,2) i4a(i,2)=i4a(i,3) i4a(i,3)=i4a(i,2)-i4a(i,1) enddo C C C COMPRESS THE ARRAY INTO THE SHORTEST POSSIBLE BIT GROUP C call masher(i4a(1,3),mash,nbytes,*913) C C C LOAD MASH() INTO IO BUFFER AND WRITE WHEN NECESSARY C do i=1,nbytes iobuff(io0+i)=mash(i) enddo io0=io0+(i-1) C C CHECK WHETHER TO PERFORM A WRITE if(io0.ge.64) call writeb(odsk,iobuff,io0,irec,ioutb,*912) goto 207 C C C END OF INPUT FILE REACHED C C FINISH WRITING TO OUTPUT FILE 106 if(io0.gt.0) then call writeb(odsk,iobuff,io0,irec,ioutb,*912) goto 106 endif C C PUT NUMBER OF RECS AND DATA BYTES IN 1ST REC OF OUTPUT FILE nrec=irec c i4buff(1)=nrec call i4cnv(0, nrec,iobuff(1)) noutb=ioutb c i4buff(2)=noutb call i4cnv(0,noutb,iobuff(5)) io0=8 irec=0 call writeb(odsk,iobuff,io0,irec,ioutb,*912) goto 999 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) nread,nread*143 808 format(/,' Input: ',i12,' records',i12,' bytes') write(otty,809) nrec,nrec*64 809 format( ' Output:',i12,' records',i12, & ' bytes (w/overhead)') write(otty,810) dble(nrec)*6.4d3/1.43d2/nread,noutb 810 format( ' Ratio: ',f12.2,'% ',i12, & ' bytes (compressed)',/) C close(unit=idsk) close(unit=odsk) end C C________________________________________________________________ C C SUBROUTINE W R I T E B C________________________________________________________________ C C SUBROUTINE WRITEB WRITES A BINARY RECORD TO A DIRECT ACCESS C OUTPUT FILE. THE FILE MUST BE OPENED BEFORE CALLING WRITEB. C C INPUT ARGUMENT: C ODSK - INTEGER*4. UNIT NUMBER OF A DIRECT ACCESS OUTPUT 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 TO BE OUTPUTTED. THE FIRST 64 BYTES OF THE ARRAY C CONTENTS WILL BE OUTPUTTED. ANY REMAINING ELEMENTS C WILL BE SHIFTED TO THE LEFT (TOWARD LOWER ELEMENT C NUMBERS) BY 64 BYTES. IF THERE ARE LESS THAN 64 C BYTES OF VALID DATA IN THE ARRAY, NOTHING WILL BE C SHIFTED. HOWEVER THE VALID-DATA INDEX, IO0, WILL BE C ADJUSTED TO REFLECT THE OUTPUT. (IN THE OUTPUT FILE C SHORT RECORDS WILL BE PADDED WITH ZEROS.) SEE ALSO C ARGUMENT IO0. 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. IF DURING THE CALL C IO0 IS GREATER THAN ZERO, A WRITE WILL BE PERFORMED, C IOBUFF WILL BE SHIFTED LEFT 64 BYTES, AND IO0 WILL C BE DECREASED 64. IF AFTER THE SHIFT, IO0 BECOMES C LESS THAN ZERO, IT WILL BE INCREASED BACK TO ZERO. C IF DURING THE CALL, IO0 IS LESS THAN 1, A WRITE WILL C NOT BE PERFORMED AND NO OTHER ACTION WILL BE TAKEN. C IREC - INTEGER*4. THE CURRENT RECORD NUMBER OF THE OUTPUT C FILE. IF DURING THE CALL, IO0 IS GREATER THAN ZERO, C IREC WILL BE INCREMENTED BEFORE WRITING. IF IO0 IS C LESS THAN 1, IREC WILL NOT BE CHANGED AND A WRITE C WILL NOT BE PERFORMED. C IOUTB - INTEGER*4. A COUNTER TO TRACK THE NUMBER OF C VALID-DATA BYTES WRITTEN TO THE OUTPUT FILE. IOUTB C WILL BE INCREASED BY AN AMOUNT EQUALLING THE NUMBER C OF VALID-DATA BYTES WRITTEN. FOR EXAMPLE, IF DURING C THE CALL IOUTB=128, IREC=2, AND IO0=5, AFTER THE C CALL, IOUTB=133, IREC=3, AND IO0=0. 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 WRITEB 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 writeb(odsk,iobuff,io0,irec,ioutb,*) C C C DECLARATIONS C C INPUT ARGUMENT integer*4 odsk C C INPUT/OUTPUT ARGUMENTS byte iobuff(*) integer*4 io0,irec,ioutb C C WRITING ARRAY byte jbuff(64) C C MISC INDEX integer*4 i C C C CHECK VALUES OF INDEX VARIABLES C if(irec.lt.0) irec=0 if(io0.lt.1) then io0=0 goto 990 endif if(io0.gt.128) goto 991 C C C PUT DATA INTO WRITING ARRAY AND COUNT NUMBER OF BYTES GOING OUT C if(io0.ge.64) then C C FULL RECORD do i=1,64 jbuff(i)=iobuff(i) enddo ioutb=ioutb+64 else C C PARTIAL RECORD do i=1,io0 jbuff(i)=iobuff(i) enddo do i=io0+1,64 jbuff(i)=0 enddo ioutb=ioutb+io0 endif C C C WRITE TO OUTPUT FILE C irec=irec+1 write(odsk,rec=irec) jbuff C C C SLIDE IOBUFF() TO THE LEFT AND ADJUST io0 ACCORDINGLY C do i=65,io0 iobuff(i-64)=iobuff(i) enddo io0=io0-64 if(io0.lt.0) io0=0 C C C EXIT PROCEDURE C 990 return 991 return 1 end C C________________________________________________________________ C C SUBROUTINE M A S H E R C________________________________________________________________ C C SUBROUTINE MASHER COMPRESSES AN ARRAY OF 16 FOUR-BYTE INTEGERS. C THE METHOD USED CODIFIES THE NUMBER OF BITS NECESSARY TO C DESCRIBE THE VALUE AND THEN STORES BOTH THE CODE AND THE VALUE C IN AN EQUAL OR SMALLER NUMBER OF BITS. THE CODE IS DESIGNED SO C THAT NO INFORMATION IS LOST. SMALL VALUES ARE COMPRESSED WITH C MUCH LESS OVERHEAD THAN LARGE NUMBERS. C C INPUT ARGUMENT: C I4A - INTEGER*4. 16-ELEMENT ARRAY CONTAINING THE INTEGERS C TO BE COMPRESSED. THE FULL RANGE OF A 4-BYTE C INTEGER CANNOT BE COMPRESSED BECAUSE 1 BIT IS C NECESSARY AS AN ENTRY POINT INTO THE CODE. C THEREFORE, THE MAXIMUM RANGE BECOMES PLUS OR MINUS C 1,073,873,451 = 2^0+2^3+2^1+2^5+2^9+2^17+2^30. THIS C IS SLIGHTLY MORE THAN 1/2 THE RANGE OF A FULL C 32-BIT INTEGER. THE REASON THE FULL 32-BIT RANGE C HAS NOT BEEN MADE AVAILABLE ARISES FROM C COMPLICATIONS SURROUNDING THE POTENTIAL FOR C EXPANSION OF A RECORD RATHER THAN COMPRESSION. C C OUTPUT ARGUMENTS: C MASH - BYTE. 64-ELEMENT ARRAY CONTAINING THE COMPRESSED C CODE AND VALUES. UNDER MOST CIRCUMSTANCES MASH WILL C NOT BE FULLY UTILIZED, BUT IT MUST BE 64 BYTES TO C HANDLE THE POSSIBILITY THAT NO COMPRESSION OCCURRED. C NBYTES - INTEGER*4. THE ACTUAL NUMBER OF BYTES REQUIRED BY C THE COMPRESSED CODE AND NUMBERS. THE CODE AND C NUMBERS ARE PADDED ON THE RIGHT TO FILL TO THE NEXT C BYTE BOUNDARY. C C RETURNS: C NORMAL - WHENEVER THE PRESCRIBED OPERATIONS ARE COMPLETED. C 1ST - ONLY IF DURING THE CALL, AN ELEMENT OF I4A() IS C FOUND TO BE OUTSIDE THE MAXIMUM RANGE C C C SUBROUTINE MASHER 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 masher(i4a,mash,nbytes,*) C C C DECLARATIONS C C INPUT ARGUMENT integer*4 i4a(16) C C OUTPUT ARGUMENTS byte mash(64) integer*4 nbytes C C BIT-HOLDING ARRAY byte bits(512) C C THE NUMBER TO COMPRESS integer*4 n4 C C MISC INDICIES integer*4 i,j,jb,k,nbitsr C C C CONVERT I4A() INTO COMPRESSED BIT VALUES AND PUT EACH BIT VALUE C IN EACH CORROSPONDING ELEMENT OF BITS() C jb=0 do k=1,16 n4=i4a(k) C if( n4 .eq. 0) then bits(jb+1)=0 bits(jb+2)=0 jb=jb+2 else if(abs(n4).eq. 1) then bits(jb+1)=0 bits(jb+2)=1 bits(jb+3)=0 jb=jb+4 if(n4.lt.0) then bits(jb)=0 else bits(jb)=1 endif else if(abs(n4).le. 9) then bits(jb+1)=0 bits(jb+2)=1 bits(jb+3)=1 bits(jb+4)=0 jb=jb+4 if(n4.lt.0) then n4=n4+9 else n4=n4+6 endif do i=3,0,-1 jb=jb+1 if(btest(n4,i)) then bits(jb)=1 else bits(jb)=0 endif enddo else if(abs(n4).le. 11) then bits(jb+1)=0 bits(jb+2)=1 bits(jb+3)=1 bits(jb+4)=1 bits(jb+5)=0 bits(jb+6)=0 jb=jb+6 if(n4.lt.0) then n4=n4+11 else n4=n4-8 endif do i=1,0,-1 jb=jb+1 if(btest(n4,i)) then bits(jb)=1 else bits(jb)=0 endif enddo else if(abs(n4).le. 43) then bits(jb+1)=0 bits(jb+2)=1 bits(jb+3)=1 bits(jb+4)=1 bits(jb+5)=0 bits(jb+6)=1 jb=jb+6 if(n4.lt.0) then n4=n4+43 else n4=n4+20 endif do i=5,0,-1 jb=jb+1 if(btest(n4,i)) then bits(jb)=1 else bits(jb)=0 endif enddo else if(abs(n4).le. 555) then bits(jb+1)=0 bits(jb+2)=1 bits(jb+3)=1 bits(jb+4)=1 bits(jb+5)=1 bits(jb+6)=0 jb=jb+6 if(n4.lt.0) then n4=n4+555 else n4=n4+468 endif do i=9,0,-1 jb=jb+1 if(btest(n4,i)) then bits(jb)=1 else bits(jb)=0 endif enddo else if(abs(n4).le. 131627) then bits(jb+1)=0 bits(jb+2)=1 bits(jb+3)=1 bits(jb+4)=1 bits(jb+5)=1 bits(jb+6)=1 jb=jb+6 if(n4.lt.0) then n4=n4+131627 else n4=n4+130516 endif do i=17,0,-1 jb=jb+1 if(btest(n4,i)) then bits(jb)=1 else bits(jb)=0 endif enddo else if(abs(n4).le.1073873451) then bits(jb+1)=1 jb=jb+1 if(n4.lt.0) then n4=n4+1073873451 else n4=n4+1073610196 endif do i=30,0,-1 jb=jb+1 if(btest(n4,i)) then bits(jb)=1 else bits(jb)=0 endif enddo else goto 991 endif enddo C C C COMPRESS BITS() INTO MASH() C nbytes=(jb-1)/8+1 nbitsr=8*nbytes-jb C j=0 do k=1,nbytes-1 mash(k)=0 do i=7,0,-1 j=j+1 if(bits(j).ne.0) mash(k)=ior(mash(k),ishft(1,i)) enddo enddo C mash(k)=0 do i=7,nbitsr,-1 j=j+1 if(bits(j).ne.0) mash(k)=ior(mash(k),ishft(1,i)) enddo 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