program raxscale c rescale raxis data by dividing by 4 integer*4 i4 integer*2 i2(2) equivalence (i4,i2) integer*2 iline(2048),is integer*4 x,i32 byte bline(4096) CHARACTER*80 INFILE,OUTFILE equivalence (iline,bline) i32=32768 is='100000'O write(6,*)' i32, is=',i32,is 5001 WRITE(6,1100) 1100 FORMAT(/'$Input filename (CR to quit): ') READ(5,1200) INFILE 1200 FORMAT(A) IF (INFILE(:5).EQ.' ') STOP 5 OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',readonly > ,access='direct',recl=1024 > ) WRITE(6,1300) 1300 FORMAT(/'$Input outfile name: ') READ(5,1200) OUTFILE open(unit=3,file=outfile,status='NEW', > access='direct',recl=1024) c read(2,155) (bline(k),k=1,4096) read(2,rec=1) (bline(k),k=1,4096) 155 FORMAT (4096A1) write(3,rec=1) (iline(k),k=1,2048) nover=0 do 100 i=1,1900 c read(2,end=1999) (iline(k),k=1,2048) c read(2,155) (bline(k),k=1,4096) read(2,rec=i+1) (bline(k),k=1,4096) c do 110 j=1,1900 c i2(1)=iline(j) c if(i4.ge.i32) then c i4=i4-i32 cc write(6,*)'case a:',i4*2 c i4=i4*2 c else c write(6,*)'case b:',i4/4 c i4=i4/4 c endif c iline(j)=i2(1) c110 continue do 110 j=1,1900 if (iline(j).lt.0) then nover=nover+1 i2(1)=iline(j) i4=2*(i4-i32) iline(j)=i2(1) else iline(j)=iline(j)/4 endif 110 continue write(3,rec=i+1) (iline(k),k=1,2048) 100 continue write(6,*)' The file contained',nover,' pixels greater than 32767.' close(2) c close(2,status='delete') close(3) goto 5001 999 write(6,11001) 11001 format(/' FILE DOES NOT EXIST ') stop 1999 stop 'Unexpectable end of file' end