program flow_main
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! GILDAS
  !	A dedicated routine to produce bipolar outflow maps
  !	Input : a VLM cube (N by NX by NY)
  !	Output : a cube (3 by NX by NY) containing the maps of the
  !		width and of the red and blue lobes
  !	Method :
  !		For each spectrum, determines the peak channel,
  !	then determines on each side of this channel the velocity
  !	at a given threshold. From this velocity, integrates out
  !	to a second threshold. The area found is the contribution
  !	to the blue (or red) lobe of the flow.
  ! S.Guilloteau 12-Nov-1986
  !---------------------------------------------------------------------
  ! Local
  character(len=filename_length) :: namex,namey
  logical :: error
  real(kind=4) :: ratio,threshold
  real(kind=8) :: vinc
  integer(kind=4) :: n
  type(gildas) :: x,y
  !
  call gildas_open
  call gildas_char('IN$',namey)
  call gildas_char('OUT$',namex)
  call gildas_real('RATIO$',ratio,1)
  call gildas_real('THRESHOLD$',threshold,1)
  call gildas_close
  !
  ! Open first input map, the one to be placed in Y place
  n = lenc(namey)
  if (n.eq.0) goto 100
  call gildas_null(y)
  call gdf_read_gildas(y, namey, '.vlm', error)
  if (error) then
    write(6,*) 'F-FLOW,  Cannot read input file'
    goto 100
  endif
  !
  ! Same as above for X image
  n = lenc(namex)
  if (n.eq.0) goto 100
  call gildas_null(x)
  call gdf_copy_header(y,x,error)
  call sic_parsef(namex(1:n),x%file,' ','.gdf')
  !
  ! Modify the requested part of the X Header
  x%gil%dim(1) = y%gil%dim(2)
  x%gil%dim(2) = y%gil%dim(3)
  x%gil%dim(3) = 3
  x%gil%convert(:,1) =   y%gil%convert(:,2)
  x%gil%convert(:,2) =   y%gil%convert(:,3)
  x%gil%convert(:,3) =   1
  vinc = y%gil%convert(3,1) 
  if (x%gil%proj_words.ne.0) then
    x%gil%xaxi = x%gil%xaxi-1
    x%gil%yaxi = x%gil%yaxi-1
  endif
  !
  ! Create the image (with write access of course)
  call gdf_create_image (x,error)
  if (error) then
    write(6,*) 'F-FLOW,  Cannot create output image'
    goto 100
  endif
  call gdf_allocate(x,error)
  if (error) goto 100
  !
  ! Do some useful job
  call sub_flow(x%r3d,            &  ! Address of the X image
                x%r3d(:,:,2),     &
                x%r3d(:,:,3),     &
                y%r3d,            &  ! Address of the Z image
                x%gil%dim(1),     &  ! Dimension of images
                x%gil%dim(2),     &
                y%gil%dim(1),     &
                vinc,             &
                ratio,threshold,  &
                x%gil%bval,x%gil%eval)
  !
  call gdf_write_data (x,x%r3d,error)
  if (error) goto 100
  !
  call gagout('S-FLOW,  Successful completion')
  call sysexi(1)
  !
  ! and exit with an error status
100 call sysexi (fatale)

contains
!
subroutine sub_flow(width,blue,red,vlm,nx,ny,nv,vinc,ratio,threshold,bval,eval)
  integer(kind=index_length), intent(in)  :: nx             !
  integer(kind=index_length), intent(in)  :: ny             !
  real(kind=4),               intent(out) :: width(nx,ny)   !
  real(kind=4),               intent(out) :: blue(nx,ny)    !
  real(kind=4),               intent(out) :: red(nx,ny)     !
  integer(kind=index_length), intent(in)  :: nv             !
  real(kind=4),               intent(in)  :: vlm(nv,nx,ny)  !
  real(kind=8),               intent(in)  :: vinc           !
  real(kind=4),               intent(in)  :: ratio          !
  real(kind=4),               intent(in)  :: threshold      !
  real(kind=4),               intent(in)  :: bval           !
  real(kind=4),               intent(in)  :: eval           !
  ! Local
  integer(kind=index_length) :: j,k,nvm
  !
  ! Loop over all spectra
  nvm = nv/2
  do k=1,ny
    do j=1,nx
      if (abs(vlm(nvm,j,k)-bval).gt.eval) then
        call spectre(nv,vlm(:,j,k),blue(j,k),red(j,k),   &
                     ratio,threshold,width(j,k),vinc)
      else
        blue(j,k) = bval
        red(j,k) = bval
        width(j,k) = bval
      endif
    enddo
  enddo
end subroutine sub_flow
!
subroutine spectre(nv,array,blue,red,ratio,threshold,width,vinc)
  integer(kind=index_length), intent(in)  :: nv         !
  real(kind=4),               intent(in)  :: array(nv)  !
  real(kind=4),               intent(out) :: blue       !
  real(kind=4),               intent(out) :: red        !
  real(kind=4),               intent(in)  :: ratio      !
  real(kind=4),               intent(in)  :: threshold  !
  real(kind=4),               intent(out) :: width      !
  real(kind=8),               intent(in)  :: vinc       !
  ! Local
  integer(kind=index_length) :: i,imin,imax
  real(kind=4) :: rmax
  !
  imax = 1
  rmax = array(1)
  do i=2,nv
    if (array(i).gt.rmax) then
      imax = i
      rmax = array(i)
    endif
  enddo
  !
  blue = 0.0
  red  = 0.0
  if (ratio*rmax.le.threshold) return
  i = imax
  do while (i.gt.1 .and. array(i).gt.ratio*rmax)
    i = i-1
  enddo
  do while (i.gt.1 .and. array(i).ge.threshold)
    blue = blue+array(i)
    i = i-1
  enddo
  imin = i
  i = imax
  do while (i.lt.nv .and. array(i).gt.ratio*rmax)
    i = i+1
  enddo
  do while (i.lt.nv .and. array(i).ge.threshold)
    red = red+array(i)
    i = i+1
  enddo
  imax = i
  width = (imax-imin+1)*vinc
  if (width.ge.0.0) return
  rmax = blue
  blue = red
  red = rmax
  width = -width
end subroutine spectre
!
end program flow_main
