module ooio
  ! object-oriented input-output
  ! This version eliminated writeaxis bug, ooi2 still has it
  use sep

  type axis
     integer :: n
     real    :: o, d, v !v=for the value of the variable (typical:v=(i-1)*d+o)
     real, dimension(:), allocatable:: all
  end type axis

  private
  public :: axis, readaxis, chk_dim_corresp, writeaxis, readcharpar

contains
!---------------------------------------------------------------
  subroutine chk_dim_corresp(filetag,dimarray)
    !call chk_dim_corresp('vel',(/z, x/)) in same order as dims of velfile
    character(len=*)        , intent(in):: filetag
    type(axis), dimension(:), intent(in):: dimarray

    integer                     :: n, i
    real                        :: r
    character(len=9):: stringbank,test,tn,td,to
    stringbank = '123456789'

    if     (axisnr .eq. 1) then
       tn="n1"; to="o1"; td="d1"
    elseif (axisnr .eq. 2) then
       tn="n2"; to="o2"; td="d2"
    elseif (axisnr .eq. 3) then
       tn="n3"; to="o3"; td="d3"
    elseif (axisnr .eq. 4) then
       tn="n4"; to="o4"; td="d4"
    elseif (axisnr .eq. 5) then
       tn="n5"; to="o5"; td="d5"
    end if

    if(.not.exist_file(filetag)) call seperr('aux file does not exist')

    !    do i=1, size(dimarray)
    write(0,*) 'Checking dimension 1 correspondence between ', &
    filetag,' file and input seismic file'

    test='n1' !'n'//stringbank(i:i)
    call from_aux(filetag,test,n)
    if(n/=dimarray(1)%n) call seperr("velfile needs have same n's as inp")

    test='o1' !'o'//stringbank(i:i)
    call from_aux(filetag,test,r)
    if(r/=dimarray(1)%o) call seperr("velfile needs have same o's as inp")

    test='d1' !'d'//stringbank(i:i)
    call from_aux(filetag,test,r)
    if(r/=dimarray(1)%d) call seperr("velfile needs have same d's as inp")
    write(0,*) 'OK'
    !    end do
    write(0,*) 'Checking dimension 2 correspondence between ', &
    filetag,' file and input seismic file'

    test='n2' !'n'//stringbank(i:i)
    call from_aux(filetag,test,n)
    if(n/=dimarray(2)%n) call seperr("velfile needs have same n's as inp")

    test='o2' !'o'//stringbank(i:i)
    call from_aux(filetag,test,r)
    if(r/=dimarray(2)%o) call seperr("velfile needs have same o's as inp")

    test='d2' !'d'//stringbank(i:i)
    call from_aux(filetag,test,r)
    if(r/=dimarray(2)%d) call seperr("velfile needs have same d's as inp")

  end subroutine chk_dim_corresp
!----------------------------------------------------------
  function readaxis(axisnr, axisname, from, ndefault, odefault, ddefault, chk_even)
    integer         , intent(in):: axisnr
    integer         , intent(in):: ndefault
    character(len=*), intent(in):: axisname
    character(len=*), intent(in):: from
    real            , intent(in):: odefault, ddefault
    logical         , intent(in):: chk_even
    optional                    :: axisnr,axisname,from,ndefault,odefault,ddefault,chk_even

    type(axis)                             :: readaxis

    integer                                :: n
    real                                   :: o, d
    character(len=9)                       :: stringbank 
    !   character(len=max(1,len(axisname)))    :: axhandle 
    character(len=5)                      :: axhandle,tn,td,to,test

    if(present(axisnr)) then
       if(present(axisname)) call seperr('readaxis: not both axis name and #')
       if(axisnr<1.or.axisnr>9) call seperr('readaxis: axis# must be from 1-9')
       stringbank = '123456789'
       axhandle   = stringbank(axisnr:axisnr)
    else if(present(axisname)) then
       axhandle   = axisname
    else
       call seperr('readaxis: specify an axis name or number')
    end if

    !    write(0,*) readaxis%n,readaxis%o,readaxis%d

    if     (axisnr .eq. 1) then
       tn="n1"; to="o1"; td="d1"
    elseif (axisnr .eq. 2) then
       tn="n2"; to="o2"; td="d2"
    elseif (axisnr .eq. 3) then
       tn="n3"; to="o3"; td="d3"
    elseif (axisnr .eq. 4) then
       tn="n4"; to="o4"; td="d4"
    elseif (axisnr .eq. 5) then
       tn="n5"; to="o5"; td="d5"
    end if

    if_from:if(present(from)) then
       if_par:if(from=='par') then
          if(present(ndefault)) then
!             test='n'//axhandle
             call from_param(tn, readaxis%n, ndefault)
          else
!             test='n'//axhandle
             call from_param(tn, readaxis%n)
          end if
          if(present(odefault)) then
!             test='o'//axhandle
             call from_param(to, readaxis%o, odefault)
          else
             test='o'//axhandle
!             call from_param(to, readaxis%o)
          end if
          if(present(ddefault)) then
!             test='d'//axhandle
             call from_param(td, readaxis%d, ddefault)
          else
!             test='d'//axhandle
             call from_param(td, readaxis%d)
          end if
       else if(from=='in') then
          if(present(ndefault)) then
             test='n'//axhandle
             call from_history(tn, readaxis%n, ndefault)
          else
             test='n'//axhandle
             call from_history(tn, readaxis%n)
          end if
          if(present(odefault)) then
             test='o'//axhandle
             call from_history(to, readaxis%o, odefault)
          else
             test='o'//axhandle
             call from_history(to, readaxis%o)
          end if
          if(present(ddefault)) then
             test='d'//axhandle
             call from_history(td, readaxis%d, ddefault)
          else
             test='d'//axhandle
             call from_history(td, readaxis%d)
          end if
       else
          if(.not.exist_file(from)) call seperr('Aux file does not exist')
          if(present(ndefault)) then
             test='n'//axhandle
             call from_aux(from,tn, readaxis%n, ndefault)
          else
             test='n'//axhandle
             call from_aux(from,tn, readaxis%n)
          end if
          if(present(odefault)) then
             test='o'//axhandle
             call from_aux(from,to, readaxis%o, odefault)
          else
             test='o'//axhandle
             call from_aux(from,to, readaxis%o)
          end if
          if(present(ddefault)) then
             test='d'//axhandle
             call from_aux(from,td, readaxis%d, ddefault)
          else
             test='d'//axhandle
             call from_aux(from,td, readaxis%d)
          end if
       end if if_par
    else
       if(present(ndefault)) then
          test='n'//axhandle
          call from_history(tn, readaxis%n, ndefault)
       else
          test="n"//axhandle
          write(0,*) " TESTING ",axhandle, "n"//axhandle
          call from_history(tn, readaxis%n)
       end if
       if(present(odefault)) then
          test='o'//axhandle
          call from_history(to, readaxis%o, odefault)
       else
          test='o'//axhandle
          call from_history(to, readaxis%o)
       end if
       if(present(ddefault)) then
          test='d'//axhandle
          call from_history(td, readaxis%d, ddefault)
       else
          test='d'//axhandle
          call from_history(td, readaxis%d)
       end if
    end if if_from

    if(present(chk_even)) then
       if(mod(readaxis%n,2)/=0) call seperr('Axis length must be even')
    end if
  end function readaxis
!------------------------------------------------------------------------
  subroutine writeaxis(axisvar, axisnr, filetag, axisname)
    !Filetag is not the file name! Example: <in.H Prog.x out2=abc.H >def.H
    !Filetag is 'out2' in this case
    type(axis)      , intent(in)           :: axisvar
    integer         , intent(in)           :: axisnr
    character(len=*), intent(in), optional :: filetag, axisname

    character(len=9)                       :: stringbank 
    character(len=2)                       :: axhandle,test,ttn,ttd,tto

    if(axisnr<1.or.axisnr>9) call seperr('readaxis: axis# must be from 1-9')

    stringbank = '123456789'
    axhandle   = stringbank(axisnr:axisnr)

    write(0,*) 'N,O,D',axisnr
    write(0,*) axisvar%n,axisvar%o,axisvar%d

    if     (axisnr .eq. 1) then
       ttn="n1"; tto="o1"; ttd="d1"
    elseif (axisnr .eq. 2) then
       ttn="n2"; tto="o2"; ttd="d2"
    elseif (axisnr .eq. 3) then
       ttn="n3"; tto="o3"; ttd="d3"
    elseif (axisnr .eq. 4) then
       ttn="n4"; tto="o4"; ttd="d4"
    elseif (axisnr .eq. 5) then
       ttn="n5"; tto="o5"; ttd="d5"
    end if

    if(present(filetag)) then
       if(filetag=='in') then
          call seperr('Cannot write to input!')
       else if(filetag=='out') then
          write(0,*) 'writeaxis: Specify filetag only if is /= than "out"'
          test='n'//axhandle
          call to_history(ttn, axisvar%n)
          test='o'//axhandle
          call to_history(tto, axisvar%o)
          test='d'//axhandle
          call to_history(ttd, axisvar%d)
!          if(present(axisname)) then
!             test='label'//axhandle
!             call to_history(test, axisname)
!          end if
       else
          test='n'//axhandle
          call to_history(ttn, axisvar%n, filetag)
          test='o'//axhandle
          call to_history(tto, axisvar%o, filetag)
          test='d'//axhandle
          call to_history(ttd, axisvar%d, filetag)
!          if(present(axisname)) then
!             test='label'//axhandle
!             call to_history(test, axisname, filetag)
!          end if
       end if
    else
!          test='n'//axhandle
       write(0,*) "N",axhandle,ttn
       call to_history(ttn, axisvar%n)
!          test='o'//axhandle
       write(0,*) "O",axhandle,tto
       call to_history(tto, axisvar%o)
!          test='d'//axhandle
       write(0,*) "D",axhandle,ttd
       call to_history(ttd, axisvar%d)
!       if(present(axisname)) then
!          test='label'//axhandle
!          call to_history(test, axisname)
!      end if
    end if
    
  end subroutine writeaxis
!-----------------------------------------------------------------------
  function readcharpar(name,validvals,default)
    character(len=*)              , intent(in)::name
    character(len=*), dimension(:), intent(in)::validvals
    integer                       , intent(in)::default

    character(len=len(validvals))             ::readcharpar

    integer :: nv, i
    logical :: isfromlist
    
    nv = size(validvals,1)

    if(default<1.or.default>nv) &
    call seperr('pick the index of one of the elements in validvals')

    call from_param(name, readcharpar, validvals(default))

    isfromlist=.false.
    do i=1,nv
       if(readcharpar==validvals(i)) isfromlist=.true.
    end do
    if(.not.isfromlist) &
    call seperr('character parameter value not among the accepted choices')
  end function readcharpar
end module ooio
