PROGRAM SIRexample_f90
!
! this program illustrates the reading and writing of a BYU SIR file
! format image.  It reads a SIR file, tests the location transformations,
! writes a byte-array version, and writes out a SIR
!
! written by DGL  30 Jan. 2002
!
IMPLICIT NONE

INCLUDE 'SIR_f90.inc'   ! get function type definitions
INCLUDE 'SIREZ_f90.inc' ! get sirhead TYPE definition

TYPE(sirhead) :: head

INTEGER MAXSIZE
PARAMETER(MAXSIZE=4500000)         ! MAXIMUM PIXELS

INTEGER LENGTH1
EXTERNAL LENGTH1

REAL, dimension(MAXSIZE) :: stval
INTEGER(kind=1), dimension(MAXSIZE) :: b 

INTEGER, PARAMETER :: lu = 8   ! i/o unit for read/write

INTEGER :: i,j, ierr, nsx, nsy, ix, iy, ix1, iy1, ns
INTEGER :: ind, ind2, ival, nn1, nn2 
REAL :: smin, smax, alat, alon, alat1, alon1, value
REAL :: x, y, x1, y1, smin1, smax1, ss, val

CHARACTER (len=70) :: fname, oname

!	PROMPT USER FOR FILE NAME INPUT

WRITE (*,15)
15 FORMAT(/' Enter Input SIR File Name: ',$)
READ (*,20) fname
20 FORMAT(A70)

40 CONTINUE
WRITE (*,*) 'SIR In= "',fname(1:LENGTH1(fname)),'"'

!	READ SIR FILE HEADER

CALL GETSIRHEAD(fname,lu,head,ierr)

!     READ IMAGE CONTENTS

IF (ierr.GE.0) THEN
   CALL GETSIRDATA(lu,head,stval,ierr,smin,smax)
ELSE
   WRITE (*,*) '*** ERROR OPENING INPUT FILE',ierr
ENDIF
IF (ierr.LT.0) STOP

!	WRITE OUT IMAGE HEADER INFORMATION

WRITE (*,*)
WRITE (*,*) 'SIR File Header Information:'
CALL PRINTSIRHEAD(head)
WRITE (*,*)

! test the  geometric transformations

nsx=head%nsx
nsy=head%nsy
DO ix=1,nsx,nsx-1
   DO iy=1,nsy,nsy-1
      x=ix
      y=iy
      CALL SIRPIX2LATLON(x,y,alon,alat,head)
      j=isirlatlon2pix(alon,alat,x1,y1,head)
      j=isirpix(x1,y1,ix1,iy1,head)
      value=head%anodata
      IF (j.GT.0) value=stval(j)
      WRITE (*,400) ix,iy,alat,alon,x1,y1,ix1,iy1,value
 400 FORMAT('Pix(',I4,',',I4,') Lat/Lon (',F6.2,',',F7.2, &
      ') (',F6.1,',',F6.1,')(',I4,',',I4,') ',F7.3)
   END DO
END DO

!	REDETERMINE MAX/MIN OF DATA ARRAY

smin=1.e25
smax=-1.e25
DO nn1=0,nsy-1
   DO nn2=1,nsx
      ind = ISIRLEX(nn2,nn1,head)
      IF (stval(ind).NE.head%anodata) THEN
	 smin=MIN(smin,stval(ind))
	 smax=MAX(smax,stval(ind))
      ENDIF
   END DO
END DO

smin1=smin
smax1=smax

WRITE (*,*)
WRITE (*,*) 'Array min, max values:',smin1,smax1

WRITE (*,34) 'Saturation Max?'
34 FORMAT(X,'New ',A,X,$)
READ (*,*) smax
WRITE (*,34) 'Saturation Min?'
READ (*,*) smin

!	SCALE ARRAY AND PUT INTO BYTE ARRAY
!
!     NOTE THAT SIR IMAGE DATA HAS THE ORIGIN AT THE LOWER-LEFT OF THE
!     IMAGE.  THE BYTE ARRAY HAS THE ORIGIN AT THE UPPER-LEFT.
!
ss=(smax-smin)/255.0
IF (ss.GT.0.0) THEN
   ss=1.0/ss
ELSE
   ss=1.0
ENDIF
DO nn1=0,nsy-1
   DO nn2=1,nsx
      ind = nn1*nsx + nn2
      ind2= (nsy-nn1)*nsx + nn2
      val=stval(ind)
      ival=(val-smin)*ss
      IF (ival.LT.0) ival=0
      IF (ival.GT.255) ival=255
      IF (ival.GT.127) ival=ival-256
      b(ind2)=ival
   END DO
END DO

!     GET OUTPUT FILE NAME FOR BYTE FILE

WRITE (*,25)
25 FORMAT(' Enter BYTE Output File Name: ',$)
READ (*,20) oname
WRITE (*,*) 'BYTE Out="',oname(1:LENGTH1(oname)),'"'

!	NOW WRITE OUT BYTE FILE

WRITE(*,*) 'Output Image Size: (X x Y)',nsx,nsy
ns=nsx*nsy

OPEN(UNIT=lu,FILE=oname,STATUS='NEW',FORM='UNFORMATTED')
WRITE (lu) (b(i),i=1,ns)
CLOSE(lu)

!     GET OUTPUT FILE NAME FOR SIR FILE

WRITE (*,30)
30 FORMAT(' Enter SIR Output File Name: ',$)
READ (*,20) oname
WRITE (*,*) 'SIR Out="',oname(1:LENGTH1(oname)),'"'

!	WRITE SIR FORMAT FILE

CALL PUTSIRFILE(oname,lu,head,stval,ierr)

IF (IERR.LT.0) &
     WRITE (*,*) '*** ERROR WRITING SIR FILE ***'

360 STOP

END PROGRAM


INTEGER FUNCTION LENGTH1(LINE)
!
!	COMPUTES THE LENGTH (NON-BLANK) OF A STRING
!
CHARACTER*(*) LINE
N=LEN(LINE)
DO I=N,1,-1
   IF (LINE(I:I).NE.' '.AND.LINE(I:I).NE.CHAR(0)) THEN
      LENGTH1=I
      GOTO 10
   ENDIF
END DO
LENGTH1=1
10 RETURN
END FUNCTION LENGTH1
