PROGRAM FSIR_LOCMAP
!
!	THIS PROGRAM ILLUSTRATES THE READING OF A FILE IN THE BYU MERS SIR
!       FILE FORMAT.  IT READS THE FILE, TESTS THE LOCATION TRANSFORMATIONS,
!       WRITES OUT A BYTE-ARRAY COPY OF THE IMAGE, AND WRITES A SIR FORMAT
!       OUTPUT FILE
!
!	WRITTEN BY D.LONG: Jan. 2002  +f90 version
!
! link with f90 SIR fortran library routines

  CHARACTER (len=120) :: FNAME, FNAME2

! IMAGE STORAGE VARIABLES

  PARAMETER (MAXSIZE=4500000)             ! MAXIMUM PIXELS/IMAGE
  REAL, dimension(MAXSIZE) :: 	STVAL     ! READ ARRAY

  LOGICAL YESNO1  ! external function to simplify y/n decisions 

! IMAGE FILE HEADER INFORMATION

  INCLUDE 'SIR_f90.inc'
  INCLUDE 'SIREZ_f90.inc'

!  LOCAL VARIABLES

  TYPE(sirhead) head
  INTEGER :: iu = 10 ! FILE UNIT I/O
  INTEGER :: ierr, ix, iy, ni
  REAL :: half, x, y, alat, alon

  EXTERNAL length1

! PROMPT USER FOR FILE NAME INPUT

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

  WRITE(*,*) 'SIR In= "',fname(1:length1(fname)),'"'

! READ SIR FILE HEADER


  CALL GETSIRHEAD(fname,iu,head,ierr)

!  WE DON'T NEED THE IMAGE DATA IN THE SIR SO WE DON'T READ IT

!	WRITE OUT IMAGE HEADER INFORMATION

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

!     DETERMINE IF PIXEL CENTER OR CORNER DESIRED

  half=0.0
  WRITE (*,140)
140 FORMAT(' Lat,Lon for Lower-Left corner (Y) or Center (N) of pixel? ',$)
  IF (.NOT.YESNO1(.TRUE.)) half=0.5

!     COMPUTE THE LATTITUDE IMAGE

  nsx=head%nsx
  nsy=head%nsy

  DO ix=1,nsx
     DO iy=1,nsy
        x=ix+half
        y=iy+half
        CALL SIRPIX2LATLON(x,y,alon,alat,head)
        ni=ISIRLEX(ix,iy,head)
        stval(ni)=alat
     END DO
  END DO

! SET SIR HEADER SCALE FACTORS

  head%ioff=-91
  head%iscale=360
  head%anodata=-91.0
  head%vmin=-90.0
  head%vmax=90.0

! MODIFY HEADER DATA

  head%type='Lat. of '//fname(1:length1(fname))
  fname2=fname(1:length1(fname))//'_lat'
  
  head%idatatype=2     ! MAKE SURE OUTPUT IMAGE IS IN STANDARD I*2 FORM
  head%itype=31        ! SET FILE TYPE CODE TO LATITUDE

! WRITE SIR FORMAT FILE

  WRITE (*,*) 'Writing "',fname2(1:length1(fname2)),'"'
  CALL PUTSIRFILE(fname2,iu,head,stval,ierr)
  
  IF (ierr.LT.0) &
       WRITE (*,*) '*** ERROR WRITING FIRST SIR FILE ***'

!     COMPUTE THE LONGITUDE IMAGE

  DO IX=1,NSX
     DO IY=1,NSY
        X=IX+HALF
        Y=IY+HALF
        CALL SIRPIX2LATLON(X,Y,ALON,ALAT,HEAD)
        NI=ISIRLEX(IX,IY,HEAD)
        IF (ALON.GT.180.0) ALON=ALON-360.0
        IF (ALON.LT.-180.0) ALON=ALON+360.0
        STVAL(NI)=ALON
     END DO
  END DO

! MODIFY HEADER SCALE FACTORS

  head%ioff=-181
  head%iscale=180
  head%anodata=-181.0
  head%vmin=-180.0
  head%vmax=180.0
  
! MODIFY HEADER DATA

  head%type='Long. of '//fname(1:length1(fname))
  fname2=fname(1:length1(fname))//'_lon'
  head%itype=30        ! SET FILE TYPE CODE TO LONGITUDE

! WRITE SIR FORMAT FILE

  WRITE (*,*) 'Writing "',fname2(1:length1(fname2)),'"'
  CALL PUTSIRFILE(fname2,iu,head,stval,ierr)

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

  STOP
END PROGRAM FSIR_LOCMAP


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

LOGICAL FUNCTION YESNO1(DEFAULT)
!
!	READS TERMINAL FOR A CHARACTER AND RETURNS
!	"PRINT"S OUT DEFAULT VALUE
!	.TRUE. = YES  .FALSE. = NO
!	DEFAULT IS FOR WHEN ONLY RETURN IS PRESSED
!
  LOGICAL DEFAULT
  character*1 ANS
  
  YESNO1=DEFAULT
  IF (DEFAULT) THEN
     PRINT 2
2    FORMAT(' [Y] ',$)
  ELSE
     PRINT 3
3    FORMAT(' [N] ',$)
  ENDIF
  READ (*,1,END=99,ERR=99) ANS
1 FORMAT(A1)
  IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') YESNO1=.TRUE.
  IF (ANS.EQ.'N'.OR.ANS.EQ.'n') YESNO1=.FALSE.
99 RETURN
END FUNCTION YESNO1
