      module m_writefits

contains
      subroutine writeimage(filename,array,nx,ny,bitpix)

!     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(nx,ny)
      integer nx,ny
      character filename*(*)
      logical simple,extend

      status=0
!     Name of the FITS file to be created:
!     filename='ATESTFILEnew.FITS'

!     Get an unused Logical Unit Number to use to create the FITS file
      call ftgiou(unit,status)

!     create the new empty FITS file
      blocksize=1
      call ftinit(unit,filename,blocksize,status)

!  Initialize parameters about the FITS image.
!  BITPIX = 16 means that the image pixels will consist of 16-bit
!  integers.  The size of the image is given by the NAXES values. 
!  The EXTEND = TRUE parameter indicates that the FITS file
!  may contain extensions following the primary array.
      simple=.true.
!     bitpix=16
!     bitpix=8
      naxis=2
      naxes(1)=nx
      naxes(2)=ny
      extend=.true.

!     write the required header keywords
      call ftphpr(unit,simple,bitpix,naxis,naxes,0,1,extend,status)


!  Write the array to the FITS file.
!  The last letter of the subroutine name defines the datatype of the
!  array argument; in this case the 'J' indicates that the array has an
!  integer*4 datatype. ('I' = I*2, 'E' = Real*4, 'D' = Real*8).
!  The 2D array is treated as a single 1-D array with NAXIS1 * NAXIS2
!  total number of pixels.  GROUP is seldom used parameter that should
!  almost always be set = 1.
      group=1
      fpixel=1
      nelements=naxes(1)*naxes(2)
      call ftpprj(unit,group,fpixel,nelements,array,status)

!     write another optional keyword to the header
      call ftpkyj(unit,'EXPOSURE',1500,'Total Exposure Time',status)

!     close the file and free the unit number
      call ftclos(unit, status)
      call ftfiou(unit, status)
      end subroutine

      end module


