         Program fits2dat_binary
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Angelica Costa Jan/03: From f90 to g77
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	 call go
	 end
	 
	 subroutine usage
	 implicit none
	 print *, 'Converts a map from fits to text'
	 print *, 
     & 'COMPILE: g77  fits2dat_binary.f -o fits2dat_binary.x',
     & '/home3/max/healpix/cfitsio/libcfitsio.a'  
	 print *, 
     & 'USAGE:   call fits2dat_binary.x <PolarType>',
     & ' <Nside> <infile> <outfile>'
	 print *,
     & 'EXAMPLE: call fits2dat_binary.x 1 32 qaz_map???.fits',
     & 'qaz_map.dat'
	 return
	 end

         subroutine go
         implicit  none
	 INTEGER  npixtot, nnpixtot, nmaps, nnmaps, naxis
	 parameter(nnpixtot=12*1024**2, nnmaps=4)
	 REAL     map(0:nnpixtot-1,1:nnmaps)
	 REAL     nullval
	 LOGICAL  anynull
	 CHARACTER*80 infile, outfile
	 INTEGER  status, unit, readwrite, blocksize, naxes(2), nfound, naxis
	 INTEGER  group, firstpix, nbuffer, npix, i, polar_type, Nside, lnblnk
	 REAL     blank, testval
	 REAL*8   bscale, bzero
	 LOGICAL  extend
	 INTEGER  nmove, hdutype
	 INTEGER  column, frow, imap
	 INTEGER  datacode, repeat, width
	 CHARACTER*80 comment
	 INTEGER  maxdim    !number of columns in the extension
	 PARAMETER(maxdim=20)
	 INTEGER  nrows, tfields, varidat
	 CHARACTER*20 ttype(maxdim), tform(maxdim), tunit(maxdim), extname

c       ----------------------------------------------------------------
c        get the arguments
c       ----------------------------------------------------------------
	 open (2,file='args.dat',status='old',err=777)
	 read (2,*,err=777,end=777) polar_type, Nside, infile, outfile
	 close(2)
	 npixtot = 12*Nside**2
	 if (npixtot.gt.nnpixtot) pause 'npixtot SIZE ERROR'
	 if (polar_type.eq.1) then
	    nmaps = 1
	 else
	    nmaps = 4
	 endif
	 write(*,*) 'Polarization_Type_________________', polar_type 
	 write(*,*) 'Nside_____________________________', Nside
	 write(*,*) 'npix______________________________', npixtot 
	 write(*,*) 'Infile____________________________',
     & infile (1:lnblnk( infile))
	 write(*,*) 'Outfile___________________________',
     & outfile(1:lnblnk(outfile))
	
c       ----------------------------------------------------------------
c        loading the file
c       ----------------------------------------------------------------
	 status   = 0
	 unit     = 150
	 naxes(1) = 1
	 naxes(2) = 1
	 nfound   = -1
	 anynull  = .false.
	 bscale   = 1.0d0
	 bzero    = 0.0d0
	 blank    = -2.e25
	 nullval  = bscale*blank + bzero

	 readwrite=0
	 call ftopen(unit,infile,readwrite,blocksize,status)
	 if (status .gt. 0) call printerror(status)
	 !     -----------------------------------------

	 !     determines the presence of image
	 call ftgkyj(unit,'NAXIS', naxis, comment, status)
	 if (status .gt. 0) call printerror(status)

	 !     determines the presence of an extension
	 call ftgkyl(unit,'EXTEND', extend, comment, status)
	 if (status .gt. 0) status = 0 ! no extension : 
	 !     to be compatible with first version of the code

	 if (naxis .gt. 0) then ! there is an image
            !        determine the size of the image (look naxis1 and naxis2)
            call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status)

            !        check that it found only NAXIS1
            if (nfound .eq. 2 .and. naxes(2) .gt. 1) then
               print *,'multi-dimensional image'
               print *,'expected 1-D data.'
               stop
            end if

            if (nfound .lt. 1) then
               call printerror(status)
               print *,'can not find NAXIS1.'
               stop
            endif

            npix=naxes(1)
            if (npix .ne. npixtot) then
               print *,'found ',npix,' pixels'
               print *,'expected ',npixtot
               stop
            endif

            call ftgkyd(unit,'BSCALE',bscale,comment,status)
            if (status .eq. 202) then ! BSCALE not found
               bscale = 1.0d0
               status = 0
            endif
            call ftgkyd(unit,'BZERO', bzero, comment,status)
            if (status .eq. 202) then ! BZERO not found
               bzero  = 0.0d0
               status = 0
            endif
            call ftgkye(unit,'BLANK', blank, comment,status)
            if (status .eq. 202) then ! BLANK not found 
               ! (according to fitsio BLANK is integer)
               blank  = -2.e25
               status = 0
            endif
            nullval = bscale*blank + bzero

            !        -----------------------------------------

            group    = 1 
            firstpix = 1
            call ftgpve
     &      (unit,group,firstpix,npix,nullval,map,anynull,status)
            ! if there are any NaN pixels, (real data)
            ! or BLANK pixels (integer data) they will take nullval value
            ! and anynull will switch to .true.
            ! otherwise, switch it by hand if necessary
            testval = 1.e-6 * ABS(nullval)
            do i=0, npix-1
               if (ABS(map(i,1)-nullval) .lt. testval) then
        	  anynull = .true.
c       	  goto 111
               endif
            enddo
c  111      continue

	 else if (extend) then ! there is an extension
            nmove = +1
            call ftmrhd(unit, nmove, hdutype, status)
            !cc         write(*,*) hdutype

            if (hdutype .ne. 2) then ! not a binary table
               stop 'this is not a binary table'
            endif

            !        reads all the keywords
            call ftghbn
     &      (unit, maxdim,nrows,tfields,ttype,tform,
     &      tunit,extname,varidat,status)

            if (tfields .lt. nmaps) then
               print *,'found ',tfields,' maps in the file'
               print *,'expected ',nmaps
               stop
            endif

            !        finds the bad data value
            call ftgkye(unit,'BAD_DATA',nullval,comment,status)
            if (status .eq. 202) then ! bad_data not found
               nullval = -1.6375e30 ! default value
               status  = 0
            endif

            do imap = 1, nmaps
               !parse TFORM keyword to find out the length of the column vector
               call ftbnfm(tform(imap), datacode, repeat, width, status)

               !reads the columns
               column   = imap
               frow     = 1
               firstpix = 1
               npix     = nrows * repeat
               if (npix .ne. npixtot) then
        	  print *,'found ',npix,' pixels'
        	  print *,'expected ',npixtot
        	  stop
               endif
               call ftgcve
     &         (unit, column, frow, firstpix, npix, nullval, 
     &         map(0,imap), anynull, status)
            enddo

	 else ! no image no extension, you are dead, man
            stop ' No image, no extension'
	 endif

	 !     close the file
	 call ftclos(unit, status)
	 
	 !     saving text file
	 print *, 'Saving ', outfile
         open (2,file=outfile)
         do i = 0, npix-1
	    write (2,*) (map(i,imap),imap=1,nmaps)
	 enddo
	 close(2)
	 
	 !     check for any error, and if so print out error messages
	 if (status .gt. 0) call printerror(status)
	 return
 777	 call usage
	 end	

      subroutine printerror(status)
      !=======================================================================
      !     Print out the FITSIO error messages to the user
      !=======================================================================
      implicit none
      INTEGER  status
      CHARACTER*30 errtext 
      CHARACTER*80 errmessage 
      !-----------------------------------------------------------------------
      !     check if status is OK (no error); if so, simply return
      if (status .le. 0)return

      !     get the text string which describes the error
      call ftgerr(status,errtext)
      print *,'FITSIO Error Status =',status,': ',errtext

      !     read and print out all the error messages on the FITSIO stack
      call ftgmsg(errmessage)
      do while (errmessage .ne. ' ')
         print *,errmessage
         call ftgmsg(errmessage)
      end do

      return
      end 

