1 program main 2 3C This is the FITSIO cookbook program that contains an annotated listing of 4C various computer programs that read and write files in FITS format 5C using the FITSIO subroutine interface. These examples are 6C working programs which users may adapt and modify for their own 7C purposes. This Cookbook serves as a companion to the FITSIO User's 8C Guide that provides more complete documentation on all the 9C available FITSIO subroutines. 10 11C Call each subroutine in turn: 12 13 call writeimage 14 call writeascii 15 call writebintable 16 call copyhdu 17 call selectrows 18 call readheader 19 call readimage 20 call readtable 21 print * 22 print *,"All the fitsio cookbook routines ran successfully." 23 24 end 25C ************************************************************************* 26 subroutine writeimage 27 28C Create a FITS primary array containing a 2-D image 29 30 integer status,unit,blocksize,bitpix,naxis,naxes(2) 31 integer i,j,group,fpixel,nelements,array(300,200) 32 character filename*80 33 logical simple,extend 34 35C The STATUS parameter must be initialized before using FITSIO. A 36C positive value of STATUS is returned whenever a serious error occurs. 37C FITSIO uses an `inherited status' convention, which means that if a 38C subroutine is called with a positive input value of STATUS, then the 39C subroutine will exit immediately, preserving the status value. For 40C simplicity, this program only checks the status value at the end of 41C the program, but it is usually better practice to check the status 42C value more frequently. 43 44 status=0 45 46C Name of the FITS file to be created: 47 filename='ATESTFILEZ.FITS' 48 49C Delete the file if it already exists, so we can then recreate it. 50C The deletefile subroutine is listed at the end of this file. 51 call deletefile(filename,status) 52 53C Get an unused Logical Unit Number to use to open the FITS file. 54C This routine is not required; programmers can choose any unused 55C unit number to open the file. 56 call ftgiou(unit,status) 57 58C Create the new empty FITS file. The blocksize parameter is a 59C historical artifact and the value is ignored by FITSIO. 60 blocksize=1 61 call ftinit(unit,filename,blocksize,status) 62 63C Initialize parameters about the FITS image. 64C BITPIX = 16 means that the image pixels will consist of 16-bit 65C integers. The size of the image is given by the NAXES values. 66C The EXTEND = TRUE parameter indicates that the FITS file 67C may contain extensions following the primary array. 68 simple=.true. 69 bitpix=16 70 naxis=2 71 naxes(1)=300 72 naxes(2)=200 73 extend=.true. 74 75C Write the required header keywords to the file 76 call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status) 77 78C Initialize the values in the image with a linear ramp function 79 do j=1,naxes(2) 80 do i=1,naxes(1) 81 array(i,j)=i - 1 +j - 1 82 end do 83 end do 84 85C Write the array to the FITS file. 86C The last letter of the subroutine name defines the datatype of the 87C array argument; in this case the 'J' indicates that the array has an 88C integer*4 datatype. ('I' = I*2, 'E' = Real*4, 'D' = Real*8). 89C The 2D array is treated as a single 1-D array with NAXIS1 * NAXIS2 90C total number of pixels. GROUP is seldom used parameter that should 91C almost always be set = 1. 92 group=1 93 fpixel=1 94 nelements=naxes(1)*naxes(2) 95 call ftpprj(unit,group,fpixel,nelements,array,status) 96 97C Write another optional keyword to the header 98C The keyword record will look like this in the FITS file: 99C 100C EXPOSURE= 1500 / Total Exposure Time 101C 102 call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status) 103 104C The FITS file must always be closed before exiting the program. 105C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 106 call ftclos(unit, status) 107 call ftfiou(unit, status) 108 109C Check for any errors, and if so print out error messages. 110C The PRINTERROR subroutine is listed near the end of this file. 111 if (status .gt. 0)call printerror(status) 112 end 113C ************************************************************************* 114 subroutine writeascii 115 116C Create an ASCII table containing 3 columns and 6 rows. For convenience, 117C the ASCII table extension is appended to the FITS image file created 118C previously by the WRITEIMAGE subroutine. 119 120 integer status,unit,readwrite,blocksize,tfields,nrows,rowlen 121 integer nspace,tbcol(3),diameter(6), colnum,frow,felem 122 real density(6) 123 character filename*40,extname*16 124 character*16 ttype(3),tform(3),tunit(3),name(6) 125 data ttype/'Planet','Diameter','Density'/ 126 data tform/'A8','I6','F4.2'/ 127 data tunit/' ','km','g/cm'/ 128 data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/ 129 data diameter/4880,12112,12742,6800,143000,121000/ 130 data density/5.1,5.3,5.52,3.94,1.33,0.69/ 131 132C The STATUS parameter must always be initialized. 133 status=0 134 135C Name of the FITS file to append the ASCII table to: 136 filename='ATESTFILEZ.FITS' 137 138C Get an unused Logical Unit Number to use to open the FITS file. 139 call ftgiou(unit,status) 140 141C Open the FITS file with write access. 142C (readwrite = 0 would open the file with readonly access). 143 readwrite=1 144 call ftopen(unit,filename,readwrite,blocksize,status) 145 146C FTCRHD creates a new empty FITS extension following the current 147C extension and moves to it. In this case, FITSIO was initially 148C positioned on the primary array when the FITS file was first opened, so 149C FTCRHD appends an empty extension and moves to it. All future FITSIO 150C calls then operate on the new extension (which will be an ASCII 151C table). 152 call ftcrhd(unit,status) 153 154C define parameters for the ASCII table (see the above data statements) 155 tfields=3 156 nrows=6 157 extname='PLANETS_ASCII' 158 159C FTGABC is a convenient subroutine for calculating the total width of 160C the table and the starting position of each column in an ASCII table. 161C Any number of blank spaces (including zero) may be inserted between 162C each column of the table, as specified by the NSPACE parameter. 163 nspace=1 164 call ftgabc(tfields,tform,nspace,rowlen,tbcol,status) 165 166C FTPHTB writes all the required header keywords which define the 167C structure of the ASCII table. NROWS and TFIELDS give the number of 168C rows and columns in the table, and the TTYPE, TBCOL, TFORM, and TUNIT 169C arrays give the column name, starting position, format, and units, 170C respectively of each column. The values of the ROWLEN and TBCOL parameters 171C were previously calculated by the FTGABC routine. 172 call ftphtb(unit,rowlen,nrows,tfields,ttype,tbcol,tform,tunit, 173 & extname,status) 174 175C Write names to the first column, diameters to 2nd col., and density to 3rd 176C FTPCLS writes the string values to the NAME column (column 1) of the 177C table. The FTPCLJ and FTPCLE routines write the diameter (integer) and 178C density (real) value to the 2nd and 3rd columns. The FITSIO routines 179C are column oriented, so it is usually easier to read or write data in a 180C table in a column by column order rather than row by row. 181 frow=1 182 felem=1 183 colnum=1 184 call ftpcls(unit,colnum,frow,felem,nrows,name,status) 185 colnum=2 186 call ftpclj(unit,colnum,frow,felem,nrows,diameter,status) 187 colnum=3 188 call ftpcle(unit,colnum,frow,felem,nrows,density,status) 189 190C The FITS file must always be closed before exiting the program. 191C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 192 call ftclos(unit, status) 193 call ftfiou(unit, status) 194 195C Check for any error, and if so print out error messages. 196C The PRINTERROR subroutine is listed near the end of this file. 197 if (status .gt. 0)call printerror(status) 198 end 199C ************************************************************************* 200 subroutine writebintable 201 202C This routine creates a FITS binary table, or BINTABLE, containing 203C 3 columns and 6 rows. This routine is nearly identical to the 204C previous WRITEASCII routine, except that the call to FTGABC is not 205C needed, and FTPHBN is called rather than FTPHTB to write the 206C required header keywords. 207 208 integer status,unit,readwrite,blocksize,hdutype,tfields,nrows 209 integer varidat,diameter(6), colnum,frow,felem 210 real density(6) 211 character filename*40,extname*16 212 character*16 ttype(3),tform(3),tunit(3),name(6) 213 data ttype/'Planet','Diameter','Density'/ 214 data tform/'8A','1J','1E'/ 215 data tunit/' ','km','g/cm'/ 216 data name/'Mercury','Venus','Earth','Mars','Jupiter','Saturn'/ 217 data diameter/4880,12112,12742,6800,143000,121000/ 218 data density/5.1,5.3,5.52,3.94,1.33,0.69/ 219 220C The STATUS parameter must always be initialized. 221 status=0 222 223C Name of the FITS file to append the ASCII table to: 224 filename='ATESTFILEZ.FITS' 225 226C Get an unused Logical Unit Number to use to open the FITS file. 227 call ftgiou(unit,status) 228 229C Open the FITS file, with write access. 230 readwrite=1 231 call ftopen(unit,filename,readwrite,blocksize,status) 232 233C Move to the last (2nd) HDU in the file (the ASCII table). 234 call ftmahd(unit,2,hdutype,status) 235 236C Append/create a new empty HDU onto the end of the file and move to it. 237 call ftcrhd(unit,status) 238 239C Define parameters for the binary table (see the above data statements) 240 tfields=3 241 nrows=6 242 extname='PLANETS_BINARY' 243 varidat=0 244 245C FTPHBN writes all the required header keywords which define the 246C structure of the binary table. NROWS and TFIELDS gives the number of 247C rows and columns in the table, and the TTYPE, TFORM, and TUNIT arrays 248C give the column name, format, and units, respectively of each column. 249 call ftphbn(unit,nrows,tfields,ttype,tform,tunit, 250 & extname,varidat,status) 251 252C Write names to the first column, diameters to 2nd col., and density to 3rd 253C FTPCLS writes the string values to the NAME column (column 1) of the 254C table. The FTPCLJ and FTPCLE routines write the diameter (integer) and 255C density (real) value to the 2nd and 3rd columns. The FITSIO routines 256C are column oriented, so it is usually easier to read or write data in a 257C table in a column by column order rather than row by row. Note that 258C the identical subroutine calls are used to write to either ASCII or 259C binary FITS tables. 260 frow=1 261 felem=1 262 colnum=1 263 call ftpcls(unit,colnum,frow,felem,nrows,name,status) 264 colnum=2 265 call ftpclj(unit,colnum,frow,felem,nrows,diameter,status) 266 colnum=3 267 call ftpcle(unit,colnum,frow,felem,nrows,density,status) 268 269C The FITS file must always be closed before exiting the program. 270C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 271 call ftclos(unit, status) 272 call ftfiou(unit, status) 273 274C Check for any error, and if so print out error messages. 275C The PRINTERROR subroutine is listed near the end of this file. 276 if (status .gt. 0)call printerror(status) 277 end 278C ************************************************************************* 279 subroutine copyhdu 280 281C Copy the 1st and 3rd HDUs from the input file to a new FITS file 282 283 integer status,inunit,outunit,readwrite,blocksize,morekeys,hdutype 284 character infilename*40,outfilename*40 285 286C The STATUS parameter must always be initialized. 287 status=0 288 289C Name of the FITS files: 290 infilename='ATESTFILEZ.FITS' 291 outfilename='BTESTFILEZ.FITS' 292 293C Delete the file if it already exists, so we can then recreate it 294C The deletefile subroutine is listed at the end of this file. 295 call deletefile(outfilename,status) 296 297C Get unused Logical Unit Numbers to use to open the FITS files. 298 call ftgiou(inunit,status) 299 call ftgiou(outunit,status) 300 301C Open the input FITS file, with readonly access 302 readwrite=0 303 call ftopen(inunit,infilename,readwrite,blocksize,status) 304 305C Create the new empty FITS file (value of blocksize is ignored) 306 blocksize=1 307 call ftinit(outunit,outfilename,blocksize,status) 308 309C FTCOPY copies the current HDU from the input FITS file to the output 310C file. The MOREKEY parameter allows one to reserve space for additional 311C header keywords when the HDU is created. FITSIO will automatically 312C insert more header space if required, so programmers do not have to 313C reserve space ahead of time, although it is more efficient to do so if 314C it is known that more keywords will be appended to the header. 315 morekeys=0 316 call ftcopy(inunit,outunit,morekeys,status) 317 318C Append/create a new empty extension on the end of the output file 319 call ftcrhd(outunit,status) 320 321C Skip to the 3rd extension in the input file which in this case 322C is the binary table created by the previous WRITEBINARY routine. 323 call ftmahd(inunit,3,hdutype,status) 324 325C FTCOPY now copies the binary table from the input FITS file 326C to the output file. 327 call ftcopy(inunit,outunit,morekeys,status) 328 329C The FITS files must always be closed before exiting the program. 330C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 331C Giving -1 for the value of the first argument causes all previously 332C allocated unit numbers to be released. 333 334 call ftclos(inunit, status) 335 call ftclos(outunit, status) 336 call ftfiou(-1, status) 337 338C Check for any error, and if so print out error messages. 339C The PRINTERROR subroutine is listed near the end of this file. 340 if (status .gt. 0)call printerror(status) 341 end 342C ************************************************************************* 343 subroutine selectrows 344 345C This routine copies selected rows from an input table into a new output 346C FITS table. In this example all the rows in the input table that have 347C a value of the DENSITY column less that 3.0 are copied to the output 348C table. This program illustrates several generally useful techniques, 349C including: 350C how to locate the end of a FITS file 351C how to create a table when the total number of rows in the table 352C is not known until the table is completed 353C how to efficiently copy entire rows from one table to another. 354 355 integer status,inunit,outunit,readwrite,blocksize,hdutype 356 integer nkeys,nspace,naxes(2),nfound,colnum,frow,felem 357 integer noutrows,irow,temp(100),i 358 real nullval,density(6) 359 character infilename*40,outfilename*40,record*80 360 logical exact,anynulls 361 362C The STATUS parameter must always be initialized. 363 status=0 364 365C Names of the FITS files: 366 infilename='ATESTFILEZ.FITS' 367 outfilename='BTESTFILEZ.FITS' 368 369C Get unused Logical Unit Numbers to use to open the FITS files. 370 call ftgiou(inunit,status) 371 call ftgiou(outunit,status) 372 373C The input FITS file is opened with READONLY access, and the output 374C FITS file is opened with WRITE access. 375 readwrite=0 376 call ftopen(inunit,infilename,readwrite,blocksize,status) 377 readwrite=1 378 call ftopen(outunit,outfilename,readwrite,blocksize,status) 379 380C move to the 3rd HDU in the input file (a binary table in this case) 381 call ftmahd(inunit,3,hdutype,status) 382 383C This do-loop illustrates how to move to the last extension in any FITS 384C file. The call to FTMRHD moves one extension at a time through the 385C FITS file until an `End-of-file' status value (= 107) is returned. 386 do while (status .eq. 0) 387 call ftmrhd(outunit,1,hdutype,status) 388 end do 389 390C After locating the end of the FITS file, it is necessary to reset the 391C status value to zero and also clear the internal error message stack 392C in FITSIO. The previous `End-of-file' error will have produced 393C an unimportant message on the error stack which can be cleared with 394C the call to the FTCMSG routine (which has no arguments). 395 396 if (status .eq. 107)then 397 status=0 398 call ftcmsg 399 end if 400 401C Create a new empty extension in the output file. 402 call ftcrhd(outunit,status) 403 404C Find the number of keywords in the input table header. 405 call ftghsp(inunit,nkeys,nspace,status) 406 407C This do-loop of calls to FTGREC and FTPREC copies all the keywords from 408C the input to the output FITS file. Notice that the specified number 409C of rows in the output table, as given by the NAXIS2 keyword, will be 410C incorrect. This value will be modified later after it is known how many 411C rows will be in the table, so it does not matter how many rows are specified 412C initially. 413 do i=1,nkeys 414 call ftgrec(inunit,i,record,status) 415 call ftprec(outunit,record,status) 416 end do 417 418C FTGKNJ is used to get the value of the NAXIS1 and NAXIS2 keywords, 419C which define the width of the table in bytes, and the number of 420C rows in the table. 421 call ftgknj(inunit,'NAXIS',1,2,naxes,nfound,status) 422 423C FTGCNO gets the column number of the `DENSITY' column; the column 424C number is needed when reading the data in the column. The EXACT 425C parameter determines whether or not the match to the column names 426C will be case sensitive. 427 exact=.false. 428 call ftgcno(inunit,exact,'DENSITY',colnum,status) 429 430C FTGCVE reads all 6 rows of data in the `DENSITY' column. The number 431C of rows in the table is given by NAXES(2). Any null values in the 432C table will be returned with the corresponding value set to -99 433C (= the value of NULLVAL). The ANYNULLS parameter will be set to TRUE 434C if any null values were found while reading the data values in the table. 435 frow=1 436 felem=1 437 nullval=-99. 438 call ftgcve(inunit,colnum,frow,felem,naxes(2),nullval, 439 & density,anynulls,status) 440 441C If the density is less than 3.0, copy the row to the output table. 442C FTGTBB and FTPTBB are low-level routines to read and write, respectively, 443C a specified number of bytes in the table, starting at the specified 444C row number and beginning byte within the row. These routines do 445C not do any interpretation of the bytes, and simply pass them to or 446C from the FITS file without any modification. This is a faster 447C way of transferring large chunks of data from one FITS file to another, 448C than reading and then writing each column of data individually. 449C In this case an entire row of bytes (the row length is specified 450C by the naxes(1) parameter) is transferred. The datatype of the 451C buffer array (TEMP in this case) is immaterial so long as it is 452C declared large enough to hold the required number of bytes. 453 noutrows=0 454 do irow=1,naxes(2) 455 if (density(irow) .lt. 3.0)then 456 noutrows=noutrows+1 457 call ftgtbb(inunit,irow,1,naxes(1),temp,status) 458 call ftptbb(outunit,noutrows,1,naxes(1),temp,status) 459 end if 460 end do 461 462C Update the NAXIS2 keyword with the correct no. of rows in the output file. 463C After all the rows have been written to the output table, the 464C FTMKYJ routine is used to overwrite the NAXIS2 keyword value with 465C the correct number of rows. Specifying `\&' for the comment string 466C tells FITSIO to keep the current comment string in the keyword and 467C only modify the value. Because the total number of rows in the table 468C was unknown when the table was first created, any value (including 0) 469C could have been used for the initial NAXIS2 keyword value. 470 call ftmkyj(outunit,'NAXIS2',noutrows,'&',status) 471 472C The FITS files must always be closed before exiting the program. 473C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 474 call ftclos(inunit, status) 475 call ftclos(outunit, status) 476 call ftfiou(-1, status) 477 478C Check for any error, and if so print out error messages. 479C The PRINTERROR subroutine is listed near the end of this file. 480 if (status .gt. 0)call printerror(status) 481 end 482C ************************************************************************* 483 subroutine readheader 484 485C Print out all the header keywords in all extensions of a FITS file 486 487 integer status,unit,readwrite,blocksize,nkeys,nspace,hdutype,i,j 488 character filename*80,record*80 489 490C The STATUS parameter must always be initialized. 491 status=0 492 493C Get an unused Logical Unit Number to use to open the FITS file. 494 call ftgiou(unit,status) 495 496C name of FITS file 497 filename='ATESTFILEZ.FITS' 498 499C open the FITS file, with read-only access. The returned BLOCKSIZE 500C parameter is obsolete and should be ignored. 501 readwrite=0 502 call ftopen(unit,filename,readwrite,blocksize,status) 503 504 j = 0 505100 continue 506 j = j + 1 507 508 print *,'Header listing for HDU', j 509 510C The FTGHSP subroutine returns the number of existing keywords in the 511C current header data unit (CHDU), not counting the required END keyword, 512 call ftghsp(unit,nkeys,nspace,status) 513 514C Read each 80-character keyword record, and print it out. 515 do i = 1, nkeys 516 call ftgrec(unit,i,record,status) 517 print *,record 518 end do 519 520C Print out an END record, and a blank line to mark the end of the header. 521 if (status .eq. 0)then 522 print *,'END' 523 print *,' ' 524 end if 525 526C Try moving to the next extension in the FITS file, if it exists. 527C The FTMRHD subroutine attempts to move to the next HDU, as specified by 528C the second parameter. This subroutine moves by a relative number of 529C HDUs from the current HDU. The related FTMAHD routine may be used to 530C move to an absolute HDU number in the FITS file. If the end-of-file is 531C encountered when trying to move to the specified extension, then a 532C status = 107 is returned. 533 call ftmrhd(unit,1,hdutype,status) 534 535 if (status .eq. 0)then 536C success, so jump back and print out keywords in this extension 537 go to 100 538 539 else if (status .eq. 107)then 540C hit end of file, so quit 541 status=0 542 end if 543 544C The FITS file must always be closed before exiting the program. 545C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 546 call ftclos(unit, status) 547 call ftfiou(unit, status) 548 549C Check for any error, and if so print out error messages. 550C The PRINTERROR subroutine is listed near the end of this file. 551 if (status .gt. 0)call printerror(status) 552 end 553C ************************************************************************* 554 subroutine readimage 555 556C Read a FITS image and determine the minimum and maximum pixel value. 557C Rather than reading the entire image in 558C at once (which could require a very large array), the image is read 559C in pieces, 100 pixels at a time. 560 561 integer status,unit,readwrite,blocksize,naxes(2),nfound 562 integer group,firstpix,nbuffer,npixels,i 563 real datamin,datamax,nullval,buffer(100) 564 logical anynull 565 character filename*80 566 567C The STATUS parameter must always be initialized. 568 status=0 569 570C Get an unused Logical Unit Number to use to open the FITS file. 571 call ftgiou(unit,status) 572 573C Open the FITS file previously created by WRITEIMAGE 574 filename='ATESTFILEZ.FITS' 575 readwrite=0 576 call ftopen(unit,filename,readwrite,blocksize,status) 577 578C Determine the size of the image. 579 call ftgknj(unit,'NAXIS',1,2,naxes,nfound,status) 580 581C Check that it found both NAXIS1 and NAXIS2 keywords. 582 if (nfound .ne. 2)then 583 print *,'READIMAGE failed to read the NAXISn keywords.' 584 return 585 end if 586 587C Initialize variables 588 npixels=naxes(1)*naxes(2) 589 group=1 590 firstpix=1 591 nullval=-999 592 datamin=1.0E30 593 datamax=-1.0E30 594 595 do while (npixels .gt. 0) 596C read up to 100 pixels at a time 597 nbuffer=min(100,npixels) 598 599 call ftgpve(unit,group,firstpix,nbuffer,nullval, 600 & buffer,anynull,status) 601 602C find the min and max values 603 do i=1,nbuffer 604 datamin=min(datamin,buffer(i)) 605 datamax=max(datamax,buffer(i)) 606 end do 607 608C increment pointers and loop back to read the next group of pixels 609 npixels=npixels-nbuffer 610 firstpix=firstpix+nbuffer 611 end do 612 613 print * 614 print *,'Min and max image pixels = ',datamin,datamax 615 616C The FITS file must always be closed before exiting the program. 617C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 618 call ftclos(unit, status) 619 call ftfiou(unit, status) 620 621C Check for any error, and if so print out error messages. 622C The PRINTERROR subroutine is listed near the end of this file. 623 if (status .gt. 0)call printerror(status) 624 end 625C ************************************************************************* 626 subroutine readtable 627 628C Read and print data values from an ASCII or binary table 629C This example reads and prints out all the data in the ASCII and 630C the binary tables that were previously created by WRITEASCII and 631C WRITEBINTABLE. Note that the exact same FITSIO routines are 632C used to read both types of tables. 633 634 integer status,unit,readwrite,blocksize,hdutype,ntable 635 integer felem,nelems,nullj,diameter,nfound,irow,colnum 636 real nulle,density 637 character filename*40,nullstr*1,name*8,ttype(3)*10 638 logical anynull 639 640C The STATUS parameter must always be initialized. 641 status=0 642 643C Get an unused Logical Unit Number to use to open the FITS file. 644 call ftgiou(unit,status) 645 646C Open the FITS file previously created by WRITEIMAGE 647 filename='ATESTFILEZ.FITS' 648 readwrite=0 649 call ftopen(unit,filename,readwrite,blocksize,status) 650 651C Loop twice, first reading the ASCII table, then the binary table 652 do ntable=2,3 653 654C Move to the next extension 655 call ftmahd(unit,ntable,hdutype,status) 656 657 print *,' ' 658 if (hdutype .eq. 1)then 659 print *,'Reading ASCII table in HDU ',ntable 660 else if (hdutype .eq. 2)then 661 print *,'Reading binary table in HDU ',ntable 662 end if 663 664C Read the TTYPEn keywords, which give the names of the columns 665 call ftgkns(unit,'TTYPE',1,3,ttype,nfound,status) 666 write(*,2000)ttype 6672000 format(2x,"Row ",3a10) 668 669C Read the data, one row at a time, and print them out 670 felem=1 671 nelems=1 672 nullstr=' ' 673 nullj=0 674 nulle=0. 675 do irow=1,6 676C FTGCVS reads the NAMES from the first column of the table. 677 colnum=1 678 call ftgcvs(unit,colnum,irow,felem,nelems,nullstr,name, 679 & anynull,status) 680 681C FTGCVJ reads the DIAMETER values from the second column. 682 colnum=2 683 call ftgcvj(unit,colnum,irow,felem,nelems,nullj,diameter, 684 & anynull,status) 685 686C FTGCVE reads the DENSITY values from the third column. 687 colnum=3 688 call ftgcve(unit,colnum,irow,felem,nelems,nulle,density, 689 & anynull,status) 690 write(*,2001)irow,name,diameter,density 6912001 format(i5,a10,i10,f10.2) 692 end do 693 end do 694 695C The FITS file must always be closed before exiting the program. 696C Any unit numbers allocated with FTGIOU must be freed with FTFIOU. 697 call ftclos(unit, status) 698 call ftfiou(unit, status) 699 700C Check for any error, and if so print out error messages. 701C The PRINTERROR subroutine is listed near the end of this file. 702 if (status .gt. 0)call printerror(status) 703 end 704C ************************************************************************* 705 subroutine printerror(status) 706 707C This subroutine prints out the descriptive text corresponding to the 708C error status value and prints out the contents of the internal 709C error message stack generated by FITSIO whenever an error occurs. 710 711 integer status 712 character errtext*30,errmessage*80 713 714C Check if status is OK (no error); if so, simply return 715 if (status .le. 0)return 716 717C The FTGERR subroutine returns a descriptive 30-character text string that 718C corresponds to the integer error status number. A complete list of all 719C the error numbers can be found in the back of the FITSIO User's Guide. 720 call ftgerr(status,errtext) 721 print *,'FITSIO Error Status =',status,': ',errtext 722 723C FITSIO usually generates an internal stack of error messages whenever 724C an error occurs. These messages provide much more information on the 725C cause of the problem than can be provided by the single integer error 726C status value. The FTGMSG subroutine retrieves the oldest message from 727C the stack and shifts any remaining messages on the stack down one 728C position. FTGMSG is called repeatedly until a blank message is 729C returned, which indicates that the stack is empty. Each error message 730C may be up to 80 characters in length. Another subroutine, called 731C FTCMSG, is available to simply clear the whole error message stack in 732C cases where one is not interested in the contents. 733 call ftgmsg(errmessage) 734 do while (errmessage .ne. ' ') 735 print *,errmessage 736 call ftgmsg(errmessage) 737 end do 738 end 739C ************************************************************************* 740 subroutine deletefile(filename,status) 741 742C A simple little routine to delete a FITS file 743 744 integer status,unit,blocksize 745 character*(*) filename 746 747C Simply return if status is greater than zero 748 if (status .gt. 0)return 749 750C Get an unused Logical Unit Number to use to open the FITS file 751 call ftgiou(unit,status) 752 753C Try to open the file, to see if it exists 754 call ftopen(unit,filename,1,blocksize,status) 755 756 if (status .eq. 0)then 757C file was opened; so now delete it 758 call ftdelt(unit,status) 759 else if (status .eq. 103)then 760C file doesn't exist, so just reset status to zero and clear errors 761 status=0 762 call ftcmsg 763 else 764C there was some other error opening the file; delete the file anyway 765 status=0 766 call ftcmsg 767 call ftdelt(unit,status) 768 end if 769 770C Free the unit number for later reuse 771 call ftfiou(unit, status) 772 end 773