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 ', & ' ' 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