program circle
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_format
  use gbl_message
  !---------------------------------------------------------------------
  ! GILDAS
  !  Make a circular average, to obtain a radial profile.
  !---------------------------------------------------------------------
  character(len=*), parameter :: pname = 'CIRCLE'
  ! Local
  character(len=filename_length) :: namex,namey
  logical :: error
  real(kind=4) :: center(2)
  integer(kind=4) :: i, j, n, npro, ier
  integer(kind=4), allocatable :: lena(:)
  real(kind=4), allocatable :: sum1(:),xcoor(:)
  type(gildas) :: x,y
  real(kind=8) :: yconv(6),xconv(3),azrange(2)
  integer :: ixaxis, ioff
  !
  call gildas_open
  call gildas_char('Y_NAME$',namey)
  call gildas_char('X_NAME$',namex)
  call gildas_real('CENTER$',center,2)
  call gildas_inte('PROFILE$',npro,1)
  call gildas_dble('AZIMUT$',azrange,2)
  call gildas_inte('X_AXIS$',ixaxis,1)
  call gildas_close
  !
  n = len_trim(namey)
  if (n.eq.0) goto 100
  n = len_trim(namex)
  if (n.eq.0) goto 100
  !
  if (ixaxis.eq.0) then
    ioff = 0
  else
    ioff = 1
  endif
  !
  call gildas_null(y)
  call gdf_read_gildas(y,namey,'.gdf',error,data=.false.)
  if (error) then
    call gag_message(seve%f,pname,'Cannot read input file '//trim(namey))
    goto 100
  endif
  if (abs(y%gil%inc(1)).ne.abs(y%gil%inc(2))) then
    call gag_message(seve%f,pname,'Can only work with equally sampled directions')
    goto 100
  endif
  !
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  x%gil%dim(1) = npro
  x%gil%dim(2) = y%gil%dim(3) + ioff
  x%gil%dim(3) = y%gil%dim(4)
  x%gil%inc(1) = abs(y%gil%inc(1))
  x%gil%convert(1,1) = 1.d0
  x%gil%convert(2,1) = 0.d0
  x%gil%convert(:,2) = y%gil%convert(:,3)
  x%gil%ref(2) = x%gil%ref(2) + ioff
  x%gil%convert(:,3) = x%gil%convert(:,4)
  yconv(1:3) = y%gil%convert(:,1)
  yconv(4:6) = y%gil%convert(:,2)
  xconv(1:3) = x%gil%convert(:,1)
  x%gil%dim(4) = 1
  x%char%code(1) = 'Radius'
  x%char%code(2) = y%char%code(3)
  x%char%code(3) = y%char%code(4)
  x%char%code(4) = ' '
  !
  call sic_parsef(namex,x%file,' ','.gdf')
  call gdf_create_image(x,error)
  !
  allocate (lena(npro),sum1(npro),stat=ier)
  if (ier.ne.0) goto 99
  allocate (y%r2d(y%gil%dim(1),y%gil%dim(2)),stat=ier)
  if (ier.ne.0) goto 99
  allocate (x%r2d(x%gil%dim(1),x%gil%dim(2)),stat=ier)
  if (ier.ne.0) goto 99
  !
  if (ioff.eq.1) then
    allocate(xcoor(x%gil%dim(1)),stat=ier)
    do i=1,x%gil%dim(1)
      xcoor(i) = (i-x%gil%ref(1))*x%gil%inc(1) + x%gil%val(1)
    enddo
  endif
  !
  ! Loop on input planes
  do j=1,y%gil%dim(4)
    x%blc(4) = 0
    x%trc(4) = 0
    x%blc(3) = j
    x%trc(3) = j
    x%r2d(:,:) = 0.
    do i=1,y%gil%dim(3)
      y%blc(4) = j
      y%trc(4) = j
      y%blc(3) = i
      y%trc(3) = i
      call gdf_read_data(y,y%r2d,error)
      if (error) goto 100
      !
      call radial(y%r2d,y%gil%dim(1),y%gil%dim(2),yconv,center,  &
                  x%r2d(:,i+ioff),x%gil%dim(1),xconv,         &
                  lena,sum1,x%gil%bval,x%gil%eval,azrange)
      if (ioff.eq.1) x%r2d(:,1) = xcoor(:)
    enddo
    call gdf_write_data(x,x%r2d,error)
  enddo
  !
  call gag_message(seve%i,pname,'Successful completion')
  call sysexi(1)  ! Success
  !
99 call gag_message(seve%f,pname,'Allocation error')
100 call sysexi (fatale)
end program circle
!
subroutine radial(y,nx,ny,yconv,center,p,np,xconv,nd,sd,bad,ebad,azrange)
  use gildas_def
  !---------------------------------------------------------------------
  !
  !---------------------------------------------------------------------
  integer(kind=index_length), intent(in)  :: nx,ny      ! Dimensions of input array
  real(kind=4),               intent(in)  :: y(nx,ny)   ! Input array
  real(kind=8),               intent(in)  :: yconv(6)   ! Conversion formula for input array
  real(kind=4),               intent(in)  :: center(2)  ! Center of circle
  integer(kind=index_length), intent(in)  :: np         ! Number of points in radial profile
  real(kind=4),               intent(out) :: p(np)      ! Output radial profile
  real(kind=8),               intent(in)  :: xconv(3)   ! Conversion formula for radial profile
  integer(kind=4),            intent(out) :: nd(np)     ! Work space
  real(kind=4),               intent(out) :: sd(np)     ! Work space
  real(kind=4),               intent(in)  :: bad        ! Blanking value
  real(kind=4),               intent(in)  :: ebad       ! Tolerance on blanking value
  real(kind=8),               intent(in)  :: azrange(2) ! Azimut range
  ! Local
  real(kind=8) :: xcent,ycent
  real(kind=8) :: xref,xval,xinc,yref,yval,yinc, pref,pval,pinc
  integer(kind=index_length) :: i,j,ip
  real(kind=8) :: dist,rp,xx,yy,pa,pi
  !
  pi = acos(-1.d0)
  xcent = center(1)
  ycent = center(2)
  xref = yconv(1)
  xval = yconv(2)
  xinc = yconv(3)
  yref = yconv(4)
  yval = yconv(5)
  yinc = yconv(6)
  pref = xconv(1)
  pval = xconv(2)
  pinc = xconv(3)
  !
  ! Clears work space
  do i=1,np
    sd(i) = 0.0
    nd(i) = 0
  enddo
  !
  ! Loop on pixels of input plane
  if (any(azrange.ne.0.d0)) then
    do j = 1,ny
      do i = 1,nx
        ! Ignore blanked pixels
        if ( abs(y(i,j)-bad).gt.ebad) then
          xx = (i-xref)*xinc+xval - xcent
          yy = (j-yref)*yinc+yval - ycent
          pa = atan2(yy,xx)
          if (pa.lt.0d0) pa = pa+2.d0*pi
          if (pa.ge.azrange(1) .and. pa.le.azrange(2)) then
            dist = (xx**2+yy**2)              
            rp   = (sqrt(dist)-pval)/pinc + pref
            ip   = int(rp)
            if (ip.le.np) then
              sd(ip) = sd(ip) + y(i,j)
              nd(ip) = nd(ip) + 1
            endif
          endif
        endif
      enddo
    enddo
  else
    do j = 1,ny
      do i = 1,nx
        ! Ignore blanked pixels
        if ( abs(y(i,j)-bad).gt.ebad) then
          dist = ((i-xref)*xinc+xval - xcent)**2 +  &
                 ((j-yref)*yinc+yval - ycent)**2
          rp   = (sqrt(dist)-pval)/pinc + pref
          ip   = int(rp)
          if (ip.le.np) then
            sd(ip) = sd(ip) + y(i,j)
            nd(ip) = nd(ip) + 1
          endif
        endif
      enddo
    enddo
  endif
  !
  ! Normalise the profile
  do i=1,np
    if (nd(i).gt.0) then
      p(i) = sd(i)/nd(i)
    else
      p(i) = bad
    endif
  enddo
end subroutine radial
