mirror of
https://bitbucket.org/cosmicvoids/vide_public.git
synced 2025-07-04 23:31:12 +00:00
Imported Healpix, cfitsio, cosmotool. Added cmake tool to build dependencies (cfitsio, hdf5, netcdf, boost, healpix, gsl, ..). Adjusted CMakeLists.txt
This commit is contained in:
Guilhem Lavaux
parent
4bfb62f177
commit
51f6798f88
241 changed files with 243806 additions and 0 deletions
772
external/cfitsio/cookbook.f
vendored
Normal file
772
external/cfitsio/cookbook.f
vendored
Normal file
|
|
@ -0,0 +1,772 @@
|
|||
program main
|
||||
|
||||
C This is the FITSIO cookbook program that contains an annotated listing of
|
||||
C various computer programs that read and write files in FITS format
|
||||
C using the FITSIO subroutine interface. These examples are
|
||||
C working programs which users may adapt and modify for their own
|
||||
C purposes. This Cookbook serves as a companion to the FITSIO User's
|
||||
C Guide that provides more complete documentation on all the
|
||||
C available FITSIO subroutines.
|
||||
|
||||
C Call each subroutine in turn:
|
||||
|
||||
call writeimage
|
||||
call writeascii
|
||||
call writebintable
|
||||
call copyhdu
|
||||
call selectrows
|
||||
call readheader
|
||||
call readimage
|
||||
call readtable
|
||||
print *
|
||||
print *,"All the fitsio cookbook routines ran successfully."
|
||||
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine writeimage
|
||||
|
||||
C Create a FITS primary array containing a 2-D image
|
||||
|
||||
integer status,unit,blocksize,bitpix,naxis,naxes(2)
|
||||
integer i,j,group,fpixel,nelements,array(300,200)
|
||||
character filename*80
|
||||
logical simple,extend
|
||||
|
||||
C The STATUS parameter must be initialized before using FITSIO. A
|
||||
C positive value of STATUS is returned whenever a serious error occurs.
|
||||
C FITSIO uses an `inherited status' convention, which means that if a
|
||||
C subroutine is called with a positive input value of STATUS, then the
|
||||
C subroutine will exit immediately, preserving the status value. For
|
||||
C simplicity, this program only checks the status value at the end of
|
||||
C the program, but it is usually better practice to check the status
|
||||
C value more frequently.
|
||||
|
||||
status=0
|
||||
|
||||
C Name of the FITS file to be created:
|
||||
filename='ATESTFILEZ.FITS'
|
||||
|
||||
C Delete the file if it already exists, so we can then recreate it.
|
||||
C The deletefile subroutine is listed at the end of this file.
|
||||
call deletefile(filename,status)
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file.
|
||||
C This routine is not required; programmers can choose any unused
|
||||
C unit number to open the file.
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C Create the new empty FITS file. The blocksize parameter is a
|
||||
C historical artifact and the value is ignored by FITSIO.
|
||||
blocksize=1
|
||||
call ftinit(unit,filename,blocksize,status)
|
||||
|
||||
C Initialize parameters about the FITS image.
|
||||
C BITPIX = 16 means that the image pixels will consist of 16-bit
|
||||
C integers. The size of the image is given by the NAXES values.
|
||||
C The EXTEND = TRUE parameter indicates that the FITS file
|
||||
C may contain extensions following the primary array.
|
||||
simple=.true.
|
||||
bitpix=16
|
||||
naxis=2
|
||||
naxes(1)=300
|
||||
naxes(2)=200
|
||||
extend=.true.
|
||||
|
||||
C Write the required header keywords to the file
|
||||
call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status)
|
||||
|
||||
C Initialize the values in the image with a linear ramp function
|
||||
do j=1,naxes(2)
|
||||
do i=1,naxes(1)
|
||||
array(i,j)=i - 1 +j - 1
|
||||
end do
|
||||
end do
|
||||
|
||||
C Write the array to the FITS file.
|
||||
C The last letter of the subroutine name defines the datatype of the
|
||||
C array argument; in this case the 'J' indicates that the array has an
|
||||
C integer*4 datatype. ('I' = I*2, 'E' = Real*4, 'D' = Real*8).
|
||||
C The 2D array is treated as a single 1-D array with NAXIS1 * NAXIS2
|
||||
C total number of pixels. GROUP is seldom used parameter that should
|
||||
C almost always be set = 1.
|
||||
group=1
|
||||
fpixel=1
|
||||
nelements=naxes(1)*naxes(2)
|
||||
call ftpprj(unit,group,fpixel,nelements,array,status)
|
||||
|
||||
C Write another optional keyword to the header
|
||||
C The keyword record will look like this in the FITS file:
|
||||
C
|
||||
C EXPOSURE= 1500 / Total Exposure Time
|
||||
C
|
||||
call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status)
|
||||
|
||||
C The FITS file must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(unit, status)
|
||||
call ftfiou(unit, status)
|
||||
|
||||
C Check for any errors, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine writeascii
|
||||
|
||||
C Create an ASCII table containing 3 columns and 6 rows. For convenience,
|
||||
C the ASCII table extension is appended to the FITS image file created
|
||||
C previously by the WRITEIMAGE subroutine.
|
||||
|
||||
integer status,unit,readwrite,blocksize,tfields,nrows,rowlen
|
||||
integer nspace,tbcol(3),diameter(6), colnum,frow,felem
|
||||
real density(6)
|
||||
character filename*40,extname*16
|
||||
character*16 ttype(3),tform(3),tunit(3),name(6)
|
||||
data ttype/'Planet','Diameter','Density'/
|
||||
data tform/'A8','I6','F4.2'/
|
||||
data tunit/' ','km','g/cm'/
|
||||
data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/
|
||||
data diameter/4880,12112,12742,6800,143000,121000/
|
||||
data density/5.1,5.3,5.52,3.94,1.33,0.69/
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Name of the FITS file to append the ASCII table to:
|
||||
filename='ATESTFILEZ.FITS'
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file.
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C Open the FITS file with write access.
|
||||
C (readwrite = 0 would open the file with readonly access).
|
||||
readwrite=1
|
||||
call ftopen(unit,filename,readwrite,blocksize,status)
|
||||
|
||||
C FTCRHD creates a new empty FITS extension following the current
|
||||
C extension and moves to it. In this case, FITSIO was initially
|
||||
C positioned on the primary array when the FITS file was first opened, so
|
||||
C FTCRHD appends an empty extension and moves to it. All future FITSIO
|
||||
C calls then operate on the new extension (which will be an ASCII
|
||||
C table).
|
||||
call ftcrhd(unit,status)
|
||||
|
||||
C define parameters for the ASCII table (see the above data statements)
|
||||
tfields=3
|
||||
nrows=6
|
||||
extname='PLANETS_ASCII'
|
||||
|
||||
C FTGABC is a convenient subroutine for calculating the total width of
|
||||
C the table and the starting position of each column in an ASCII table.
|
||||
C Any number of blank spaces (including zero) may be inserted between
|
||||
C each column of the table, as specified by the NSPACE parameter.
|
||||
nspace=1
|
||||
call ftgabc(tfields,tform,nspace,rowlen,tbcol,status)
|
||||
|
||||
C FTPHTB writes all the required header keywords which define the
|
||||
C structure of the ASCII table. NROWS and TFIELDS give the number of
|
||||
C rows and columns in the table, and the TTYPE, TBCOL, TFORM, and TUNIT
|
||||
C arrays give the column name, starting position, format, and units,
|
||||
C respectively of each column. The values of the ROWLEN and TBCOL parameters
|
||||
C were previously calculated by the FTGABC routine.
|
||||
call ftphtb(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit,
|
||||
& extname,status)
|
||||
|
||||
C Write names to the first column, diameters to 2nd col., and density to 3rd
|
||||
C FTPCLS writes the string values to the NAME column (column 1) of the
|
||||
C table. The FTPCLJ and FTPCLE routines write the diameter (integer) and
|
||||
C density (real) value to the 2nd and 3rd columns. The FITSIO routines
|
||||
C are column oriented, so it is usually easier to read or write data in a
|
||||
C table in a column by column order rather than row by row.
|
||||
frow=1
|
||||
felem=1
|
||||
colnum=1
|
||||
call ftpcls(unit,colnum,frow,felem,nrows,name,status)
|
||||
colnum=2
|
||||
call ftpclj(unit,colnum,frow,felem,nrows,diameter,status)
|
||||
colnum=3
|
||||
call ftpcle(unit,colnum,frow,felem,nrows,density,status)
|
||||
|
||||
C The FITS file must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(unit, status)
|
||||
call ftfiou(unit, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine writebintable
|
||||
|
||||
C This routine creates a FITS binary table, or BINTABLE, containing
|
||||
C 3 columns and 6 rows. This routine is nearly identical to the
|
||||
C previous WRITEASCII routine, except that the call to FTGABC is not
|
||||
C needed, and FTPHBN is called rather than FTPHTB to write the
|
||||
C required header keywords.
|
||||
|
||||
integer status,unit,readwrite,blocksize,hdutype,tfields,nrows
|
||||
integer varidat,diameter(6), colnum,frow,felem
|
||||
real density(6)
|
||||
character filename*40,extname*16
|
||||
character*16 ttype(3),tform(3),tunit(3),name(6)
|
||||
data ttype/'Planet','Diameter','Density'/
|
||||
data tform/'8A','1J','1E'/
|
||||
data tunit/' ','km','g/cm'/
|
||||
data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/
|
||||
data diameter/4880,12112,12742,6800,143000,121000/
|
||||
data density/5.1,5.3,5.52,3.94,1.33,0.69/
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Name of the FITS file to append the ASCII table to:
|
||||
filename='ATESTFILEZ.FITS'
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file.
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C Open the FITS file, with write access.
|
||||
readwrite=1
|
||||
call ftopen(unit,filename,readwrite,blocksize,status)
|
||||
|
||||
C Move to the last (2nd) HDU in the file (the ASCII table).
|
||||
call ftmahd(unit,2,hdutype,status)
|
||||
|
||||
C Append/create a new empty HDU onto the end of the file and move to it.
|
||||
call ftcrhd(unit,status)
|
||||
|
||||
C Define parameters for the binary table (see the above data statements)
|
||||
tfields=3
|
||||
nrows=6
|
||||
extname='PLANETS_BINARY'
|
||||
varidat=0
|
||||
|
||||
C FTPHBN writes all the required header keywords which define the
|
||||
C structure of the binary table. NROWS and TFIELDS gives the number of
|
||||
C rows and columns in the table, and the TTYPE, TFORM, and TUNIT arrays
|
||||
C give the column name, format, and units, respectively of each column.
|
||||
call ftphbn(unit,nrows,tfields,ttype,tform,tunit,
|
||||
& extname,varidat,status)
|
||||
|
||||
C Write names to the first column, diameters to 2nd col., and density to 3rd
|
||||
C FTPCLS writes the string values to the NAME column (column 1) of the
|
||||
C table. The FTPCLJ and FTPCLE routines write the diameter (integer) and
|
||||
C density (real) value to the 2nd and 3rd columns. The FITSIO routines
|
||||
C are column oriented, so it is usually easier to read or write data in a
|
||||
C table in a column by column order rather than row by row. Note that
|
||||
C the identical subroutine calls are used to write to either ASCII or
|
||||
C binary FITS tables.
|
||||
frow=1
|
||||
felem=1
|
||||
colnum=1
|
||||
call ftpcls(unit,colnum,frow,felem,nrows,name,status)
|
||||
colnum=2
|
||||
call ftpclj(unit,colnum,frow,felem,nrows,diameter,status)
|
||||
colnum=3
|
||||
call ftpcle(unit,colnum,frow,felem,nrows,density,status)
|
||||
|
||||
C The FITS file must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(unit, status)
|
||||
call ftfiou(unit, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine copyhdu
|
||||
|
||||
C Copy the 1st and 3rd HDUs from the input file to a new FITS file
|
||||
|
||||
integer status,inunit,outunit,readwrite,blocksize,morekeys,hdutype
|
||||
character infilename*40,outfilename*40
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Name of the FITS files:
|
||||
infilename='ATESTFILEZ.FITS'
|
||||
outfilename='BTESTFILEZ.FITS'
|
||||
|
||||
C Delete the file if it already exists, so we can then recreate it
|
||||
C The deletefile subroutine is listed at the end of this file.
|
||||
call deletefile(outfilename,status)
|
||||
|
||||
C Get unused Logical Unit Numbers to use to open the FITS files.
|
||||
call ftgiou(inunit,status)
|
||||
call ftgiou(outunit,status)
|
||||
|
||||
C Open the input FITS file, with readonly access
|
||||
readwrite=0
|
||||
call ftopen(inunit,infilename,readwrite,blocksize,status)
|
||||
|
||||
C Create the new empty FITS file (value of blocksize is ignored)
|
||||
blocksize=1
|
||||
call ftinit(outunit,outfilename,blocksize,status)
|
||||
|
||||
C FTCOPY copies the current HDU from the input FITS file to the output
|
||||
C file. The MOREKEY parameter allows one to reserve space for additional
|
||||
C header keywords when the HDU is created. FITSIO will automatically
|
||||
C insert more header space if required, so programmers do not have to
|
||||
C reserve space ahead of time, although it is more efficient to do so if
|
||||
C it is known that more keywords will be appended to the header.
|
||||
morekeys=0
|
||||
call ftcopy(inunit,outunit,morekeys,status)
|
||||
|
||||
C Append/create a new empty extension on the end of the output file
|
||||
call ftcrhd(outunit,status)
|
||||
|
||||
C Skip to the 3rd extension in the input file which in this case
|
||||
C is the binary table created by the previous WRITEBINARY routine.
|
||||
call ftmahd(inunit,3,hdutype,status)
|
||||
|
||||
C FTCOPY now copies the binary table from the input FITS file
|
||||
C to the output file.
|
||||
call ftcopy(inunit,outunit,morekeys,status)
|
||||
|
||||
C The FITS files must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
C Giving -1 for the value of the first argument causes all previously
|
||||
C allocated unit numbers to be released.
|
||||
|
||||
call ftclos(inunit, status)
|
||||
call ftclos(outunit, status)
|
||||
call ftfiou(-1, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine selectrows
|
||||
|
||||
C This routine copies selected rows from an input table into a new output
|
||||
C FITS table. In this example all the rows in the input table that have
|
||||
C a value of the DENSITY column less that 3.0 are copied to the output
|
||||
C table. This program illustrates several generally useful techniques,
|
||||
C including:
|
||||
C how to locate the end of a FITS file
|
||||
C how to create a table when the total number of rows in the table
|
||||
C is not known until the table is completed
|
||||
C how to efficiently copy entire rows from one table to another.
|
||||
|
||||
integer status,inunit,outunit,readwrite,blocksize,hdutype
|
||||
integer nkeys,nspace,naxes(2),nfound,colnum,frow,felem
|
||||
integer noutrows,irow,temp(100),i
|
||||
real nullval,density(6)
|
||||
character infilename*40,outfilename*40,record*80
|
||||
logical exact,anynulls
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Names of the FITS files:
|
||||
infilename='ATESTFILEZ.FITS'
|
||||
outfilename='BTESTFILEZ.FITS'
|
||||
|
||||
C Get unused Logical Unit Numbers to use to open the FITS files.
|
||||
call ftgiou(inunit,status)
|
||||
call ftgiou(outunit,status)
|
||||
|
||||
C The input FITS file is opened with READONLY access, and the output
|
||||
C FITS file is opened with WRITE access.
|
||||
readwrite=0
|
||||
call ftopen(inunit,infilename,readwrite,blocksize,status)
|
||||
readwrite=1
|
||||
call ftopen(outunit,outfilename,readwrite,blocksize,status)
|
||||
|
||||
C move to the 3rd HDU in the input file (a binary table in this case)
|
||||
call ftmahd(inunit,3,hdutype,status)
|
||||
|
||||
C This do-loop illustrates how to move to the last extension in any FITS
|
||||
C file. The call to FTMRHD moves one extension at a time through the
|
||||
C FITS file until an `End-of-file' status value (= 107) is returned.
|
||||
do while (status .eq. 0)
|
||||
call ftmrhd(outunit,1,hdutype,status)
|
||||
end do
|
||||
|
||||
C After locating the end of the FITS file, it is necessary to reset the
|
||||
C status value to zero and also clear the internal error message stack
|
||||
C in FITSIO. The previous `End-of-file' error will have produced
|
||||
C an unimportant message on the error stack which can be cleared with
|
||||
C the call to the FTCMSG routine (which has no arguments).
|
||||
|
||||
if (status .eq. 107)then
|
||||
status=0
|
||||
call ftcmsg
|
||||
end if
|
||||
|
||||
C Create a new empty extension in the output file.
|
||||
call ftcrhd(outunit,status)
|
||||
|
||||
C Find the number of keywords in the input table header.
|
||||
call ftghsp(inunit,nkeys,nspace,status)
|
||||
|
||||
C This do-loop of calls to FTGREC and FTPREC copies all the keywords from
|
||||
C the input to the output FITS file. Notice that the specified number
|
||||
C of rows in the output table, as given by the NAXIS2 keyword, will be
|
||||
C incorrect. This value will be modified later after it is known how many
|
||||
C rows will be in the table, so it does not matter how many rows are specified
|
||||
C initially.
|
||||
do i=1,nkeys
|
||||
call ftgrec(inunit,i,record,status)
|
||||
call ftprec(outunit,record,status)
|
||||
end do
|
||||
|
||||
C FTGKNJ is used to get the value of the NAXIS1 and NAXIS2 keywords,
|
||||
C which define the width of the table in bytes, and the number of
|
||||
C rows in the table.
|
||||
call ftgknj(inunit,'NAXIS',1,2,naxes,nfound,status)
|
||||
|
||||
C FTGCNO gets the column number of the `DENSITY' column; the column
|
||||
C number is needed when reading the data in the column. The EXACT
|
||||
C parameter determines whether or not the match to the column names
|
||||
C will be case sensitive.
|
||||
exact=.false.
|
||||
call ftgcno(inunit,exact,'DENSITY',colnum,status)
|
||||
|
||||
C FTGCVE reads all 6 rows of data in the `DENSITY' column. The number
|
||||
C of rows in the table is given by NAXES(2). Any null values in the
|
||||
C table will be returned with the corresponding value set to -99
|
||||
C (= the value of NULLVAL). The ANYNULLS parameter will be set to TRUE
|
||||
C if any null values were found while reading the data values in the table.
|
||||
frow=1
|
||||
felem=1
|
||||
nullval=-99.
|
||||
call ftgcve(inunit,colnum,frow,felem,naxes(2),nullval,
|
||||
& density,anynulls,status)
|
||||
|
||||
C If the density is less than 3.0, copy the row to the output table.
|
||||
C FTGTBB and FTPTBB are low-level routines to read and write, respectively,
|
||||
C a specified number of bytes in the table, starting at the specified
|
||||
C row number and beginning byte within the row. These routines do
|
||||
C not do any interpretation of the bytes, and simply pass them to or
|
||||
C from the FITS file without any modification. This is a faster
|
||||
C way of transferring large chunks of data from one FITS file to another,
|
||||
C than reading and then writing each column of data individually.
|
||||
C In this case an entire row of bytes (the row length is specified
|
||||
C by the naxes(1) parameter) is transferred. The datatype of the
|
||||
C buffer array (TEMP in this case) is immaterial so long as it is
|
||||
C declared large enough to hold the required number of bytes.
|
||||
noutrows=0
|
||||
do irow=1,naxes(2)
|
||||
if (density(irow) .lt. 3.0)then
|
||||
noutrows=noutrows+1
|
||||
call ftgtbb(inunit,irow,1,naxes(1),temp,status)
|
||||
call ftptbb(outunit,noutrows,1,naxes(1),temp,status)
|
||||
end if
|
||||
end do
|
||||
|
||||
C Update the NAXIS2 keyword with the correct no. of rows in the output file.
|
||||
C After all the rows have been written to the output table, the
|
||||
C FTMKYJ routine is used to overwrite the NAXIS2 keyword value with
|
||||
C the correct number of rows. Specifying `\&' for the comment string
|
||||
C tells FITSIO to keep the current comment string in the keyword and
|
||||
C only modify the value. Because the total number of rows in the table
|
||||
C was unknown when the table was first created, any value (including 0)
|
||||
C could have been used for the initial NAXIS2 keyword value.
|
||||
call ftmkyj(outunit,'NAXIS2',noutrows,'&',status)
|
||||
|
||||
C The FITS files must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(inunit, status)
|
||||
call ftclos(outunit, status)
|
||||
call ftfiou(-1, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine readheader
|
||||
|
||||
C Print out all the header keywords in all extensions of a FITS file
|
||||
|
||||
integer status,unit,readwrite,blocksize,nkeys,nspace,hdutype,i,j
|
||||
character filename*80,record*80
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file.
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C name of FITS file
|
||||
filename='ATESTFILEZ.FITS'
|
||||
|
||||
C open the FITS file, with read-only access. The returned BLOCKSIZE
|
||||
C parameter is obsolete and should be ignored.
|
||||
readwrite=0
|
||||
call ftopen(unit,filename,readwrite,blocksize,status)
|
||||
|
||||
j = 0
|
||||
100 continue
|
||||
j = j + 1
|
||||
|
||||
print *,'Header listing for HDU', j
|
||||
|
||||
C The FTGHSP subroutine returns the number of existing keywords in the
|
||||
C current header data unit (CHDU), not counting the required END keyword,
|
||||
call ftghsp(unit,nkeys,nspace,status)
|
||||
|
||||
C Read each 80-character keyword record, and print it out.
|
||||
do i = 1, nkeys
|
||||
call ftgrec(unit,i,record,status)
|
||||
print *,record
|
||||
end do
|
||||
|
||||
C Print out an END record, and a blank line to mark the end of the header.
|
||||
if (status .eq. 0)then
|
||||
print *,'END'
|
||||
print *,' '
|
||||
end if
|
||||
|
||||
C Try moving to the next extension in the FITS file, if it exists.
|
||||
C The FTMRHD subroutine attempts to move to the next HDU, as specified by
|
||||
C the second parameter. This subroutine moves by a relative number of
|
||||
C HDUs from the current HDU. The related FTMAHD routine may be used to
|
||||
C move to an absolute HDU number in the FITS file. If the end-of-file is
|
||||
C encountered when trying to move to the specified extension, then a
|
||||
C status = 107 is returned.
|
||||
call ftmrhd(unit,1,hdutype,status)
|
||||
|
||||
if (status .eq. 0)then
|
||||
C success, so jump back and print out keywords in this extension
|
||||
go to 100
|
||||
|
||||
else if (status .eq. 107)then
|
||||
C hit end of file, so quit
|
||||
status=0
|
||||
end if
|
||||
|
||||
C The FITS file must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(unit, status)
|
||||
call ftfiou(unit, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine readimage
|
||||
|
||||
C Read a FITS image and determine the minimum and maximum pixel value.
|
||||
C Rather than reading the entire image in
|
||||
C at once (which could require a very large array), the image is read
|
||||
C in pieces, 100 pixels at a time.
|
||||
|
||||
integer status,unit,readwrite,blocksize,naxes(2),nfound
|
||||
integer group,firstpix,nbuffer,npixels,i
|
||||
real datamin,datamax,nullval,buffer(100)
|
||||
logical anynull
|
||||
character filename*80
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file.
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C Open the FITS file previously created by WRITEIMAGE
|
||||
filename='ATESTFILEZ.FITS'
|
||||
readwrite=0
|
||||
call ftopen(unit,filename,readwrite,blocksize,status)
|
||||
|
||||
C Determine the size of the image.
|
||||
call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status)
|
||||
|
||||
C Check that it found both NAXIS1 and NAXIS2 keywords.
|
||||
if (nfound .ne. 2)then
|
||||
print *,'READIMAGE failed to read the NAXISn keywords.'
|
||||
return
|
||||
end if
|
||||
|
||||
C Initialize variables
|
||||
npixels=naxes(1)*naxes(2)
|
||||
group=1
|
||||
firstpix=1
|
||||
nullval=-999
|
||||
datamin=1.0E30
|
||||
datamax=-1.0E30
|
||||
|
||||
do while (npixels .gt. 0)
|
||||
C read up to 100 pixels at a time
|
||||
nbuffer=min(100,npixels)
|
||||
|
||||
call ftgpve(unit,group,firstpix,nbuffer,nullval,
|
||||
& buffer,anynull,status)
|
||||
|
||||
C find the min and max values
|
||||
do i=1,nbuffer
|
||||
datamin=min(datamin,buffer(i))
|
||||
datamax=max(datamax,buffer(i))
|
||||
end do
|
||||
|
||||
C increment pointers and loop back to read the next group of pixels
|
||||
npixels=npixels-nbuffer
|
||||
firstpix=firstpix+nbuffer
|
||||
end do
|
||||
|
||||
print *
|
||||
print *,'Min and max image pixels = ',datamin,datamax
|
||||
|
||||
C The FITS file must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(unit, status)
|
||||
call ftfiou(unit, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine readtable
|
||||
|
||||
C Read and print data values from an ASCII or binary table
|
||||
C This example reads and prints out all the data in the ASCII and
|
||||
C the binary tables that were previously created by WRITEASCII and
|
||||
C WRITEBINTABLE. Note that the exact same FITSIO routines are
|
||||
C used to read both types of tables.
|
||||
|
||||
integer status,unit,readwrite,blocksize,hdutype,ntable
|
||||
integer felem,nelems,nullj,diameter,nfound,irow,colnum
|
||||
real nulle,density
|
||||
character filename*40,nullstr*1,name*8,ttype(3)*10
|
||||
logical anynull
|
||||
|
||||
C The STATUS parameter must always be initialized.
|
||||
status=0
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file.
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C Open the FITS file previously created by WRITEIMAGE
|
||||
filename='ATESTFILEZ.FITS'
|
||||
readwrite=0
|
||||
call ftopen(unit,filename,readwrite,blocksize,status)
|
||||
|
||||
C Loop twice, first reading the ASCII table, then the binary table
|
||||
do ntable=2,3
|
||||
|
||||
C Move to the next extension
|
||||
call ftmahd(unit,ntable,hdutype,status)
|
||||
|
||||
print *,' '
|
||||
if (hdutype .eq. 1)then
|
||||
print *,'Reading ASCII table in HDU ',ntable
|
||||
else if (hdutype .eq. 2)then
|
||||
print *,'Reading binary table in HDU ',ntable
|
||||
end if
|
||||
|
||||
C Read the TTYPEn keywords, which give the names of the columns
|
||||
call ftgkns(unit,'TTYPE',1,3,ttype,nfound,status)
|
||||
write(*,2000)ttype
|
||||
2000 format(2x,"Row ",3a10)
|
||||
|
||||
C Read the data, one row at a time, and print them out
|
||||
felem=1
|
||||
nelems=1
|
||||
nullstr=' '
|
||||
nullj=0
|
||||
nulle=0.
|
||||
do irow=1,6
|
||||
C FTGCVS reads the NAMES from the first column of the table.
|
||||
colnum=1
|
||||
call ftgcvs(unit,colnum,irow,felem,nelems,nullstr,name,
|
||||
& anynull,status)
|
||||
|
||||
C FTGCVJ reads the DIAMETER values from the second column.
|
||||
colnum=2
|
||||
call ftgcvj(unit,colnum,irow,felem,nelems,nullj,diameter,
|
||||
& anynull,status)
|
||||
|
||||
C FTGCVE reads the DENSITY values from the third column.
|
||||
colnum=3
|
||||
call ftgcve(unit,colnum,irow,felem,nelems,nulle,density,
|
||||
& anynull,status)
|
||||
write(*,2001)irow,name,diameter,density
|
||||
2001 format(i5,a10,i10,f10.2)
|
||||
end do
|
||||
end do
|
||||
|
||||
C The FITS file must always be closed before exiting the program.
|
||||
C Any unit numbers allocated with FTGIOU must be freed with FTFIOU.
|
||||
call ftclos(unit, status)
|
||||
call ftfiou(unit, status)
|
||||
|
||||
C Check for any error, and if so print out error messages.
|
||||
C The PRINTERROR subroutine is listed near the end of this file.
|
||||
if (status .gt. 0)call printerror(status)
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine printerror(status)
|
||||
|
||||
C This subroutine prints out the descriptive text corresponding to the
|
||||
C error status value and prints out the contents of the internal
|
||||
C error message stack generated by FITSIO whenever an error occurs.
|
||||
|
||||
integer status
|
||||
character errtext*30,errmessage*80
|
||||
|
||||
C Check if status is OK (no error); if so, simply return
|
||||
if (status .le. 0)return
|
||||
|
||||
C The FTGERR subroutine returns a descriptive 30-character text string that
|
||||
C corresponds to the integer error status number. A complete list of all
|
||||
C the error numbers can be found in the back of the FITSIO User's Guide.
|
||||
call ftgerr(status,errtext)
|
||||
print *,'FITSIO Error Status =',status,': ',errtext
|
||||
|
||||
C FITSIO usually generates an internal stack of error messages whenever
|
||||
C an error occurs. These messages provide much more information on the
|
||||
C cause of the problem than can be provided by the single integer error
|
||||
C status value. The FTGMSG subroutine retrieves the oldest message from
|
||||
C the stack and shifts any remaining messages on the stack down one
|
||||
C position. FTGMSG is called repeatedly until a blank message is
|
||||
C returned, which indicates that the stack is empty. Each error message
|
||||
C may be up to 80 characters in length. Another subroutine, called
|
||||
C FTCMSG, is available to simply clear the whole error message stack in
|
||||
C cases where one is not interested in the contents.
|
||||
call ftgmsg(errmessage)
|
||||
do while (errmessage .ne. ' ')
|
||||
print *,errmessage
|
||||
call ftgmsg(errmessage)
|
||||
end do
|
||||
end
|
||||
C *************************************************************************
|
||||
subroutine deletefile(filename,status)
|
||||
|
||||
C A simple little routine to delete a FITS file
|
||||
|
||||
integer status,unit,blocksize
|
||||
character*(*) filename
|
||||
|
||||
C Simply return if status is greater than zero
|
||||
if (status .gt. 0)return
|
||||
|
||||
C Get an unused Logical Unit Number to use to open the FITS file
|
||||
call ftgiou(unit,status)
|
||||
|
||||
C Try to open the file, to see if it exists
|
||||
call ftopen(unit,filename,1,blocksize,status)
|
||||
|
||||
if (status .eq. 0)then
|
||||
C file was opened; so now delete it
|
||||
call ftdelt(unit,status)
|
||||
else if (status .eq. 103)then
|
||||
C file doesn't exist, so just reset status to zero and clear errors
|
||||
status=0
|
||||
call ftcmsg
|
||||
else
|
||||
C there was some other error opening the file; delete the file anyway
|
||||
status=0
|
||||
call ftcmsg
|
||||
call ftdelt(unit,status)
|
||||
end if
|
||||
|
||||
C Free the unit number for later reuse
|
||||
call ftfiou(unit, status)
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue