program correlate_1d
  use gildas_def
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! GILDAS  Computes the cross correlation of two data cubes along
  ! the last dimension
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: in_name1,in_name2,out_name
  logical :: error !! ,corr
  integer(kind=4) :: i, n
  type(gildas) :: x,y,z
  real(kind=4), allocatable :: work(:)
  integer(kind=4) :: ier
  !
  call gildas_open
  call gildas_char('IN_NAME1$',in_name1)
  call gildas_char('IN_NAME2$',in_name2)
  call gildas_char('OUT_NAME$',out_name)
  call gildas_close
  !
  call gildas_null(z)
  z%gil%ndim = 3
  call gdf_read_gildas(z,in_name1,'.gdf',error,data=.false.)
  if (error) call sysexi(fatale)
  !
  call gildas_null(y)
  y%gil%ndim = 3
  call gdf_read_gildas(y,in_name2,'.gdf',error,data=.false.)
  if (error) call sysexi(fatale)
  !
  do i=1,2
    if (y%gil%dim(i).ne.z%gil%dim(i)) then
      call gagout('F-CORRELATE,  Input cubes have different'//   &
     &        ' number of pixels')
      goto 100
    endif
  enddo
  !
  call do_check('Ref1',y%gil%ref(1),z%gil%ref(1),error)
  if (error)  goto 100
  call do_check('Val1',y%gil%val(1),z%gil%val(1),error)
  if (error)  goto 100
  call do_check('Inc1',y%gil%inc(1),z%gil%inc(1),error)
  if (error)  goto 100
  !
  call do_check('Ref2',y%gil%ref(2),z%gil%ref(2),error)
  if (error)  goto 100
  call do_check('Val2',y%gil%val(2),z%gil%val(2),error)
  if (error)  goto 100
  call do_check('Inc2',y%gil%inc(2),z%gil%inc(2),error)
  if (error)  goto 100
  !
  call do_check('Ref3',y%gil%ref(3),z%gil%ref(3),error)
  if (error)  goto 100
  call do_check('Val3',y%gil%val(3),z%gil%val(3),error)
  if (error)  goto 100
  call do_check('Inc3',y%gil%inc(3),z%gil%inc(3),error)
  if (error)  goto 100
  !
  call gildas_null(x)
  call gdf_copy_header (y,x,error)
  n = lenc(out_name)
  if (n.eq.0) goto 100
  call sic_parsef(out_name(1:n),x%file,' ','.gdf')
  !
  x%gil%extr_words = 0
  x%gil%blan_words = 2
  x%gil%bval = 0.0
  x%gil%eval = 0.0
  !
  ! Determine size of correlation spectrum
  x%gil%ndim = 1
  x%gil%dim(1) = z%gil%dim(3) !! + y%gil%dim(3) - 1
  x%gil%val(1) = z%gil%val(3)-y%gil%val(3)
  x%gil%ref(1) = z%gil%ref(3)-y%gil%ref(3)+x%gil%dim(1)/2
  x%gil%inc(1) = z%gil%inc(3)
  x%gil%faxi = 1
  x%char%code(1) = z%char%code(3)
  !
  x%loca%size = x%gil%dim(1)
  !
  call gdf_create_image(x,error)
  if (error) then
    call gagout('F-CORRELATE,  Cannot create spectrum') 
    goto 100
  endif
  !
  allocate (x%r1d(x%gil%dim(1)) , &
            work(x%gil%dim(1)) ,   &
            y%r3d(y%gil%dim(1),y%gil%dim(2),y%gil%dim(3)),  &
            z%r3d(z%gil%dim(1),z%gil%dim(2),x%gil%dim(3)), stat=ier)
  if (ier.ne.0) then
    call gagout('F-CORRELATE,  Cannot allocate work space')
    goto 100
  endif
  !
  call gdf_read_data(y,y%r3d,error)
  if (error) goto 100
  call gdf_read_data(z,z%r3d,error)
  if (error) goto 100
  !
  call do_correl_1d(  &
          z%gil%dim(1),z%gil%dim(2),x%gil%dim(3), &
          z%r3d,z%gil%bval,z%gil%eval,  &
          y%r3d,y%gil%bval,y%gil%eval,  &
          x%r1d,x%gil%dim(1),work)
  call gdf_write_data(x,x%r1d,error)
  if (error) goto 100
  !
  call gagout('S-CORRELATE,  Successful completion')
  goto 101
  !
100 call sysexi (fatale)
101 continue
end program correlate_1d
!
subroutine do_check(axis,yval,zval,error)
  use gkernel_interfaces
  character(len=*), intent(in)    :: axis   ! Axis name
  real(kind=8),     intent(inout) :: yval   !
  real(kind=8),     intent(in)    :: zval   !
  logical,          intent(inout) :: error  ! Logical error flag
  !
  real(8), parameter :: eps=1d-7
  !
  if (abs(yval-zval).ne.0d0) then  ! They differ
    write(6,*) axis, yval, zval
    if (abs(yval-zval).gt.eps*abs(yval+zval)) then 
    ! They differ by more  than eps
      call gagout('F-CORRELATE,  Input cubes have '//  &
          'incompatible conversion formula') 
      error = .true.
      return
    endif
  endif
  !
end subroutine do_check
!
subroutine do_correl_1d(nx,ny,nz, &
  in1,bval1,eval1, in2,bval2,eval2, out,nout,work)
  use gildas_def
  integer(kind=index_length), intent(in)  :: nx              !
  integer(kind=index_length), intent(in)  :: ny              !
  integer(kind=index_length), intent(in)  :: nz              !
  real(kind=4),               intent(in)  :: in1(nx,ny,nz)   !
  real(kind=4),               intent(in)  :: bval1              !
  real(kind=4),               intent(in)  :: eval1              !
  real(kind=4),               intent(in)  :: in2(nx,ny,nz)   !
  real(kind=4),               intent(in)  :: bval2              !
  real(kind=4),               intent(in)  :: eval2              !
  integer(kind=index_length), intent(in)  :: nout              !
  real(kind=4),               intent(out) :: out(nout)    !
  real(kind=4),               intent(out) :: work(nout)  !
  ! Local
  integer(kind=index_length) :: i,j,k,l,m,n
  !
  ! Reset cross correlation to zero
  out = 0.0
  work = 0.0
  !
  ! Compute
  n = nout/2
  do k = 1, nz
    do l = 1, nz
      m = k-l+n
      if (m.ge.1 .and. m.le.nout) then
        do j=1,ny
          do i=1,nx
            if (abs(in2(i,j,l)-bval2).gt.eval2) then
              if (abs(in1(i,j,k)-bval1).gt.eval1) then
                out(m) = out(m)+in1(i,j,k)*in2(i,j,l)
                work(m) = work(m)+1.0
              endif
            endif
          enddo
        enddo
      endif
    enddo
  enddo
  !
  ! Normalise
  do m=1,nout
    if (work(m).ne.0) out(m) = out(m)/work(m) 
  enddo
end subroutine do_correl_1d
