module wemva_fileio_mod
  use  wemva_struct_mod
  use  sep
  implicit none

  integer, external, private :: sreed_window, srite_window, getch

contains
!-------------------------------------------------------------------------------------
  subroutine wemva_fio_imag_init(igrid, filetag)
    character(len=*)                :: filetag
    type(img_grid)                  :: igrid

    real, allocatable, dimension(:) :: tmp
    integer                         :: ioffs, nmodl, noffs
    nmodl = igrid%ax%n*igrid%ay%n*igrid%az%n
    noffs = igrid%ahx%n*igrid%ahy%n
    allocate(tmp(nmodl))
    tmp = 0.
    call sseek(filetag, 0, 0)
    do ioffs=1, noffs
       call sep_write(tmp, filetag, esize=4)
    end do
    deallocate(tmp)
    return
  end subroutine

!--------------------------------------------------------------------------------------
  subroutine wemva_fio_dslw_init(vgrid, filetag)
    character(len=*)                :: filetag
    type(vel_grid)                  :: vgrid
    real, allocatable, dimension(:) :: tmp
    allocate(tmp(vgrid%ax%n*vgrid%ay%n*vgrid%az%n))
    tmp = 0.
    call sseek(filetag, 0, 0)
    call sep_write(tmp, filetag, esize=4)
    deallocate(tmp)
    return
  end subroutine

!======================================================================================
! read one frequency block receiver wavefield
!--------------------------------------------------------------------------------------
  subroutine wemva_fio_crec(crec, dgrid, indw, nws, ish, filetag, flag)
    complex, dimension(:,:) :: crec
    type(dat_grid)          :: dgrid 
    integer                 :: indw, nws, ish
    character(len=*)        :: filetag
    character(len=4)        :: flag
    integer, dimension(3)   :: n_cube, j_wind, n_wind, f_wind
    integer                 :: n_dim_cube, err  

    n_dim_cube = 3
    n_cube = (/dgrid%ntrg, dgrid%aw%n, dgrid%nshg/)
    j_wind = (/1, 1, 1/)
    n_wind = (/dgrid%ntrg, nws, 1/)
    f_wind = (/0, indw-1, ish-1/)

    if (flag == "rite") then
       err = srite_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,8,crec)
       crec = 0. 
       if (err.lt.0) call seperr("wem_fio_crec: trouble writing receiver wavefield")
    else if(flag == "reed") then
       crec = 0.
       err = sreed_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,8,crec)
       if (err.lt.0) call seperr("wem_fio_crec: trouble reading receiver wavefield")
    else
       call seperr("you have to specify the flag for wem_fio_crec()")
    end if
    return
  end subroutine

!=============================================================================
! read one frequency block receiver wavefield
!-----------------------------------------------------------------------------
   subroutine wemva_fio_csou(csou, dgrid, indw, nws, ish, filetag, flag)
     complex, dimension(:,:) :: csou
     type(dat_grid)          :: dgrid
     integer                 :: indw, nws, ish
     character(len=*)        :: filetag
     character(len=4)        :: flag
     integer, dimension(3)   :: n_cube, j_wind, n_wind, f_wind
     integer                 :: n_dim_cube, err

     n_dim_cube = 3
     n_cube = (/dgrid%ntrs, dgrid%aw%n, dgrid%nshs/)
     j_wind = (/1, 1, 1/)
     n_wind = (/dgrid%ntrs, nws, 1/)
     if (dgrid%comsou) then 
        f_wind = (/0, indw-1, ish-1/)
     else
        f_wind = (/0, indw-1, 0/)
     end if   
     if (flag == "rite") then
        err = srite_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,8,csou)
        csou = 0.
        if (err.lt.0) call seperr("wem_fio_csou: trouble writing receiver wavefield")
     else if(flag == "reed") then
        csou = 0.
        err = sreed_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,8,csou)
        if (err.lt.0) call seperr("wem_fio_csou: trouble reading receiver wavefield")
     else
        call seperr("you have to specify the flag for wem_fio_csou()")
     end if
     return
   end subroutine
!==============================================================================
! read one depth block velocity model
!------------------------------------------------------------------------------
  subroutine wemva_fio_velo(vmod, vgrid, pgrid, indz, filetag, flag)
    real, dimension(:,:)  :: vmod
    type(vel_grid)        :: vgrid
    type(pro_grid)        :: pgrid
    integer               :: indz
    integer               :: nzs
    character(len=*)      :: filetag
    character(len=4)      :: flag
    integer, dimension(3) :: n_cube, j_wind, n_wind, f_wind
    integer               :: n_dim_cube, err
   
    n_dim_cube = 3
    n_cube = (/vgrid%ax%n, vgrid%ay%n, vgrid%az%n /)
    j_wind = (/1, 1, 1/)
    n_wind = (/pgrid%ax%n, pgrid%ay%n, 1/)
    f_wind = (/vgrid%index_provel_xmin-1, vgrid%index_provel_ymin-1, indz-1/)
    if (flag == "rite") then
       err = srite_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,4,vmod)
       vmod = 0.
    else if (flag == "reed") then
       vmod = 0.
       err = sreed_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,4,vmod)
    end if
    return
  end subroutine

!=====================================================================================
! read or write one depth block image
!-------------------------------------------------------------------------------------
  subroutine wemva_fio_imag(modl, igrid, ogrid, indz, filetag, flag)
    real, dimension(:,:,:,:) :: modl
    type(img_grid)           :: igrid
    type(out_grid)           :: ogrid
    integer                  :: indz
    character(len=*)         :: filetag
    character(len=4)         :: flag

    integer, dimension(5)    :: n_cube, j_wind, n_wind, f_wind
    integer                  :: n_dim_cube, err

    n_dim_cube = 5
    n_cube = (/igrid%ahx%n, igrid%ahy%n, igrid%ax%n, igrid%ay%n, igrid%az%n /)
    j_wind = (/1, 1, 1, 1, 1/)
    n_wind = (/ogrid%ahx%n, ogrid%ahy%n, ogrid%ax%n, ogrid%ay%n, 1/)
    f_wind = (/0,0,ogrid%index_outimg_xmin-1,ogrid%index_outimg_ymin-1,indz-1/)

    if (flag == "rite") then
       err = srite_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,4,modl)
       if (err .lt. 0) call seperr("wem_io_imag: trouble writing image file")
    else if(flag == "reed") then
       modl = 0.
       err = sreed_window(filetag,n_dim_cube,n_cube,n_wind,f_wind,j_wind,4,modl)
       if (err .lt. 0) call seperr("wem_io_imag: trouble reading image file")
    else
       call seperr("you have to specify the flag for wem_io_imag()")
    end if
    return
  end subroutine
end module



