IMFORTの使用例

東京大学理学部天文学教育研究センター　　濱部　勝

以下の例によって、IRAF形式の画像を読み込み、何らかの処理を行なって その結果を再びIRAF形式の画像として書き出すプログラムの概略が理解できる だろう。例では、処理のもっともな簡単なものとして$2\times 2$のビンニングを 行なっている。

また、画素タイプに関わる部分は冗長だがなるべく一般的に使えるように 書いてみた。

プログラムのコンパイルは、以下の例のプログラムソースを{\tt test.f}とする時、

% f77 -o test.e test.f /iraf/iraf/bin.sparc/libimfort.a \
                       /iraf/iraf/bin.sparc/libsys.a \
                       /iraf/iraf/bin.sparc/libvops.a  \
                       /iraf/iraf/unix/bin.sparc/libos.a 

プログラム例

      program imgbin2
c     a simple example to demonstrate how-to-use IMFORT library

      character sfile*80, title*40, dfile*80, cdum*80
      integer   im, nim, dtype, laxis(7), irc
      integer*2 IGG(512)
      dimension G(512,512), GG(512), DR(256,256), WORK(256)

      sfile='In_img'                              ! source file
      dfile='Out_img'                             ! destination file

c---- open source file and read its title
      mode=1                                      ! read-only access mode
      call IMOPEN (sfile, mode, im, irc)          ! open source file
      call IMACCK(im,'title',irc)                 ! check image-title keyword
      call IMGKWC(im,'title',title,irc)           ! get image-title keyword
      write(*,'(''     Object :'',a)') title

c---- get source image size
      call IMGSIZ (im, laxis, naxis, dtype, irc)  ! determine the size and datatype
      iext=laxis(1)
      jext=laxis(2)
      write(*,'(''     Image size ='',i4,'' x'',i4)') iext, jext

c---- determine the data type
      if      ( dtype.eq.3 ) then
         write(*,*) '     Data type: short integer'
      else if ( dtype.eq.4 ) then
         write(*,*) 
     +        '     Data type: integer (generally = long integer)'
      else if ( dtype.eq.5 ) then
         write(*,*) '     Data type: long integer'
      else if ( dtype.eq.6 ) then
         write(*,*) 
     +        '     Data type: single precision floating (real)'
      else if ( dtype.eq.7 ) then
         write(*,*) 
     +        '     Data type: double precision floating '
      else if ( dtype.eq.11 ) then
         write(*,*) 
     +        '     Data type: unsigned short integer '
      else
         write(*,*) 'Warning: data type invalid !'
         stop
      end if

c---- read array
      irc=0
      if ( dtype.eq.3 ) then
         do j=1, jext
            call IMGL2S (im, igg, j, irc)         ! get 1-line from the image   
            do i=1, iext                          !   (values are short)
               g(i,j)=igg(i)
            end do
         end do
      else if ( dtype.eq.6 ) then
         do j=1, jext
            call IMGL2R (im, gg, j, irc)          ! get 1-line from the image
            do i=1, iext                          !   (values are real)
               g(i,j)=gg(i)
            end do
         end do
      else
         write(*,*) 'Data type is invalid !'
         stop
      end if

c---- open a new image file
      naxis=2
      laxis(1)=iext/2
      laxis(2)=jext/2
      call IMCREA (dfile,laxis,naxis,dtype,irc)   ! create a new image 
      mode=3                                      ! read/write access mode
      call IMOPEN (dfile, 3, nim, irc)            ! open the created image
      call IMGSIZ (nim, laxis, naxis, dtype, irc) ! determine the size and datatype
      call IMHCPY(im, nim, irc)                   ! copy an image header
      call IMCLOS(im,irc)                         ! close the source image

c---- do some process and write the result into a new image array
      call bin2(nim,g,dtype,work,iext,jext,laxis(1),laxis(2))

c---- close the created image
      call IMCLOS(nim,irc)                        ! close the destination image
      
      stop
      end
c===================================================================
      subroutine bin2(nim,g,dtype,work,iext,jext,isub,jsub)

c     an example of process ( 2x2 binning )

      integer   dtype
      dimension g(iext,jext), work(isub)

      DO J=1,JSUB
         do i=1, isub
            work(i)=0.0
            do jj=(j-1)*2+1, (j-1)*2+2
               do ii=(i-1)*2+1, (i-1)*2+2
                  work(i)=work(i)+g(ii,jj)
               end do
            end do
            work(i)=work(i)/float(2*2)
         end do
         call IMPL2R (nim,work,j,irc)             ! put 1-line into the array 
      END DO

      return
      end