! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Naoki WATANABE, Nobutaka NISHIKAWA (Mizuho I.R.)   @@ !
! @@             Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine vector3d__save1( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  if( index( fname, ".dx", .true. ) + 2 == len_trim(fname) ) then
     call vector3d__save1DX( v, fname )
  else if( index( fname, ".cube", .true. ) + 4 == len_trim(fname) ) then
     call vector3d__save1Cube( v, fname )
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::save1 : unknown format: ',a)
     close(16)
     stop
  end if

  return
end subroutine vector3d__save1

subroutine vector3d__save2( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  if( index( fname, ".dx", .true. ) + 2 == len_trim(fname) ) then
     call vector3d__save2DX( v, fname )
  else if( index( fname, ".cube", .true. ) + 4 == len_trim(fname) ) then
     call vector3d__save2Cube( v, fname )
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::save2 : unknown format: ',a)
     close(16)
     stop
  end if

  return
end subroutine vector3d__save2

subroutine vector3d__save4( v, fname )
  use ac_parameter

  implicit none
  complex(8), intent(in) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  if( index( fname, ".dx", .true. ) + 2 == len_trim(fname) ) then
     call vector3d__save4DX( v, fname )
  else if( index( fname, ".cube", .true. ) + 4 == len_trim(fname) ) then
     call vector3d__save4Cube( v, fname )
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::save4 : unknown format: ',a)
     close(16)
     stop
  end if

  return
end subroutine vector3d__save4

subroutine vector3d__load1( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(out) :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  if( index( fname, ".dx", .true. ) + 2 == len_trim(fname) ) then
     call vector3d__load2DX( v, fname )
  else if( index( fname, ".cube", .true. ) + 4 == len_trim(fname) ) then
     call vector3d__load2Cube( v, fname )
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::load1 : unknown format: ',a)
     close(16)
     stop
  end if

  return
end subroutine vector3d__load1

subroutine vector3d__load2( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(out) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  if( index( fname, ".dx", .true. ) + 2 == len_trim(fname) ) then
     call vector3d__load2DX( v, fname )
  else if( index( fname, ".cube", .true. ) + 4 == len_trim(fname) ) then
     call vector3d__load2Cube( v, fname )
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::load2 : unknown format: ',a)
     close(16)
     stop
  end if

  return
end subroutine vector3d__load2

subroutine vector3d__load4( v, fname )
  use ac_parameter

  implicit none
  complex(8), intent(out) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  if( index( fname, ".dx", .true. ) + 2 == len_trim(fname) ) then
     call vector3d__load4DX( v, fname )
  else if( index( fname, ".cube", .true. ) + 4 == len_trim(fname) ) then
     call vector3d__load4Cube( v, fname )
  else
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::load4 : unknown format: ',a)
     close(16)
     stop
  end if

  return
end subroutine vector3d__load4

subroutine vector3d__save1DX( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)

  write(iunit,'(a,3i5)') 'object 1 class gridpositions counts ', &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc
  write(iunit,'(a,3f20.15)') 'origin ', &
       Param%Cell%Lo(1)*AU_TO_AA, Param%Cell%Lo(2)*AU_TO_AA, Param%Cell%Lo(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLa(1)*AU_TO_AA, Param%Cell%dLa(2)*AU_TO_AA, Param%Cell%dLa(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLb(1)*AU_TO_AA, Param%Cell%dLb(2)*AU_TO_AA, Param%Cell%dLb(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLc(1)*AU_TO_AA, Param%Cell%dLc(2)*AU_TO_AA, Param%Cell%dLc(3)*AU_TO_AA 
  write(iunit,'(a,3i5)') 'object 2 class gridconnections counts', &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc
  write(iunit,'(a,i5,a)') 'object 3 class array type float category real rank 0 items', &
       Param%Cell%Na*Param%Cell%Nb*Param%Cell%Nc, ' data follows'

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           write(iunit,'(e25.15)') v(ia,ib,ic)
        end do
     end do
  end do

  write(iunit,'(a)') 'object "density" class field'
  write(iunit,'(a)') 'component "positions" value 1'
  write(iunit,'(a)') 'component "connections" value 2'
  write(iunit,'(a)') 'component "data" value 3'

  close(iunit)

  return
end subroutine vector3d__save1DX

subroutine vector3d__save1Cube( v, fname )
  use ac_parameter
  implicit none
  real(8), intent(in)  :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic, i
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)
  write(iunit,*) 'ACCEL'
  write(iunit,*) trim(fname)
  write(iunit,993) Param%Data%natom, Param%Cell%Lo(1), Param%Cell%Lo(2), Param%Cell%Lo(3)
  write(iunit,993) Param%Cell%Na, Param%Cell%dLa(1), Param%Cell%dLa(2), Param%Cell%dLa(3)
  write(iunit,993) Param%Cell%Nb, Param%Cell%dLb(1), Param%Cell%dLb(2), Param%Cell%dLb(3)
  write(iunit,993) Param%Cell%Nc, Param%Cell%dLc(1), Param%Cell%dLc(2), Param%Cell%dLc(3)
  do i=1, Param%Data%natom
     write(iunit,992) Param%Data%vatom(i)%number, Param%Data%vatom(i)%Q                  &
          , Param%Data%vatom(i)%Ro(1), Param%Data%vatom(i)%Ro(2), Param%Data%vatom(i)%Ro(3)
  end do
  do ia=1,Param%Cell%Na
     do ib=1,Param%Cell%Nb
        write(iunit,999) (v(ia,ib,ic),ic=0,Param%Cell%Nc-1)
     end do
  end do

  close(iunit)

999 format(6f17.10)
993 format(i4,3f17.10)
992 format(i4,4f17.10)

  return
end subroutine vector3d__save1Cube

subroutine vector3d__save2DX( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)

  write(iunit,'(a,3i5)') 'object 1 class gridpositions counts ', &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc
  write(iunit,'(a,3f20.15)') 'origin ', &
       Param%Cell%Lo(1)*AU_TO_AA, Param%Cell%Lo(2)*AU_TO_AA, Param%Cell%Lo(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLa(1)*AU_TO_AA, Param%Cell%dLa(2)*AU_TO_AA, Param%Cell%dLa(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLb(1)*AU_TO_AA, Param%Cell%dLb(2)*AU_TO_AA, Param%Cell%dLb(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLc(1)*AU_TO_AA, Param%Cell%dLc(2)*AU_TO_AA, Param%Cell%dLc(3)*AU_TO_AA 
  write(iunit,'(a,3i5)') 'object 2 class gridconnections counts', &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc
  write(iunit,'(a,i5,a)') 'object 3 class array type float category real rank 0 items', &
       Param%Cell%Na*Param%Cell%Nb*Param%Cell%Nc, ' data follows'

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           write(iunit,'(2e25.15)') v(:,ia,ib,ic)
        end do
     end do
  end do

  write(iunit,'(a)') 'object "density" class field'
  write(iunit,'(a)') 'component "positions" value 1'
  write(iunit,'(a)') 'component "connections" value 2'
  write(iunit,'(a)') 'component "data" value 3'

  close(iunit)

  return
end subroutine vector3d__save2DX

subroutine vector3d__save2Cube( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)

  write(iunit,'(a)') 'ACCEL'
  write(iunit,'(a)') trim(fname)
  write(iunit,'(i5,3f20.15)') 0, &
       Param%Cell%Lo(1)*AU_TO_AA, Param%Cell%Lo(2)*AU_TO_AA, Param%Cell%Lo(3)*AU_TO_AA 

  write(iunit,'(i5,3f20.15)') Param%Cell%Na, &
       Param%Cell%dLa(1)*AU_TO_AA, Param%Cell%dLa(2)*AU_TO_AA, Param%Cell%dLa(3)*AU_TO_AA 

  write(iunit,'(i5,3f20.15)') Param%Cell%Nb, &
       Param%Cell%dLb(1)*AU_TO_AA, Param%Cell%dLb(2)*AU_TO_AA, Param%Cell%dLb(3)*AU_TO_AA 

  write(iunit,'(i5,3f20.15)') Param%Cell%Nc, &
       Param%Cell%dLc(1)*AU_TO_AA, Param%Cell%dLc(2)*AU_TO_AA, Param%Cell%dLc(3)*AU_TO_AA 

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           write(iunit,'(2e25.15)') v(:,ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__save2Cube

subroutine vector3d__save4DX( v, fname )
  use ac_parameter

  implicit none
  complex(8), intent(in)  :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)

  write(iunit,'(a,3i5)') 'object 1 class gridpositions counts ', &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc
  write(iunit,'(a,3f20.15)') 'origin ', &
       Param%Cell%Lo(1)*AU_TO_AA, Param%Cell%Lo(2)*AU_TO_AA, Param%Cell%Lo(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLa(1)*AU_TO_AA, Param%Cell%dLa(2)*AU_TO_AA, Param%Cell%dLa(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLb(1)*AU_TO_AA, Param%Cell%dLb(2)*AU_TO_AA, Param%Cell%dLb(3)*AU_TO_AA 
  write(iunit,'(a,3f20.15)') 'delta ', &
       Param%Cell%dLc(1)*AU_TO_AA, Param%Cell%dLc(2)*AU_TO_AA, Param%Cell%dLc(3)*AU_TO_AA 
  write(iunit,'(a,3i5)') 'object 2 class gridconnections counts', &
       Param%Cell%Na, Param%Cell%Nb, Param%Cell%Nc
  write(iunit,'(a,i5,a)') 'object 3 class array type float category real rank 0 items', &
       Param%Cell%Na*Param%Cell%Nb*Param%Cell%Nc, ' data follows'

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           write(iunit,'(8e25.15)') v(:,ia,ib,ic)
        end do
     end do
  end do

  write(iunit,'(a)') 'object "density" class field'
  write(iunit,'(a)') 'component "positions" value 1'
  write(iunit,'(a)') 'component "connections" value 2'
  write(iunit,'(a)') 'component "data" value 3'

  close(iunit)

  return
end subroutine vector3d__save4DX

subroutine vector3d__save4Cube( v, fname )
  use ac_parameter

  implicit none
  complex(8), intent(in)  :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)

  write(iunit,'(a)') 'ACCEL'
  write(iunit,'(a)') trim(fname)
  write(iunit,'(i5,3f20.15)') 0, &
       Param%Cell%Lo(1)*AU_TO_AA, Param%Cell%Lo(2)*AU_TO_AA, Param%Cell%Lo(3)*AU_TO_AA 

  write(iunit,'(i5,3f20.15)') Param%Cell%Na, &
       Param%Cell%dLa(1)*AU_TO_AA, Param%Cell%dLa(2)*AU_TO_AA, Param%Cell%dLa(3)*AU_TO_AA 

  write(iunit,'(i5,3f20.15)') Param%Cell%Nb, &
       Param%Cell%dLb(1)*AU_TO_AA, Param%Cell%dLb(2)*AU_TO_AA, Param%Cell%dLb(3)*AU_TO_AA 

  write(iunit,'(i5,3f20.15)') Param%Cell%Nc, &
       Param%Cell%dLc(1)*AU_TO_AA, Param%Cell%dLc(2)*AU_TO_AA, Param%Cell%dLc(3)*AU_TO_AA 

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           write(iunit,'(8e25.15)') v(:,ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__save4Cube

subroutine vector3d__load1DX( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(out) :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname

  integer          :: nx, ny, nz
  integer          :: ia, ib, ic
  integer          :: iunit
  logical          :: ex
  character(128)   :: buf

  inquire( file=fname, exist = ex )
  if( .not. ex ) then
     write(*,'(a50,a20)') '# Error: vecter3d::loadDX : can not open file ', fname 
     stop
  end if
  iunit = 1
  open(iunit,file=fname)

  read(iunit,'(a)') buf

  if( buf(1:35) == 'object 1 class gridpositions counts' ) then
     read( buf(36:66),*) nx, ny, nz
  endif

  if( nx /= Param%Cell%Na .or. ny /= Param%Cell%Nb .or. nz /= Param%Cell%Nc ) then
     write(*,*) 'size mismatch in', fname
     close(iunit)
     stop
  end if

  do 
     read(iunit, '(a)', end=100) buf
     if( buf(1:20) == 'object 3 class array' ) exit
  end do
100 continue

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           read(iunit,'(a)') buf
           read(buf,*) v(ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__load1DX

subroutine vector3d__load1Cube( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(out) :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname

  integer          :: natom, n
  integer          :: nx, ny, nz
  integer          :: ia, ib, ic, i
  integer          :: iunit
  logical          :: ex
  character(128)   :: buf

  inquire( file=fname, exist = ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,899) trim(fname)
899  format('      +++++++ Error vecter3d::loadCube : can not open file: ',a)
     close(16)
     stop
  end if

  iunit = 1
  open(iunit,file=fname)
  read(iunit,*) 
  read(iunit,*) 
  read(iunit,*) natom
  read(iunit,*) nx
  read(iunit,*) ny
  read(iunit,*) nz
  if( natom < 0 ) natom = -natom
  if( nx < 0 ) nx = -nx
  if( ny < 0 ) ny = -ny
  if( nz < 0 ) nz = -nz

  if( nx /= Param%Cell%Na .or. ny /= Param%Cell%Nb .or. nz /= Param%Cell%Nc ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,888) trim(fname)
888  format('      +++++++ Error vecter3d::loadCube : size mismatch in: ',a)
     close(16)
     close(iunit)
     stop
  end if

  do i=1, natom
     read(iunit,*)
  end do

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        read(iunit,999) (v(ia,ib,ic),ic=1,Param%Cell%Nc)
     end do
  end do

  close(iunit)

999 format(6f17.10)

  return
end subroutine vector3d__load1Cube

subroutine vector3d__load2DX( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(out) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname

  integer          :: nx, ny, nz
  integer          :: ia, ib, ic
  integer          :: iunit
  logical          :: ex
  character(128)   :: buf

  inquire( file=fname, exist = ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::loadDX : can not open file: ',a)
     close(16)
     stop
  end if
  iunit = 1
  open(iunit,file=fname)

  read(iunit,'(a)') buf

  if( buf(1:35) == 'object 1 class gridpositions counts' ) then
     read( buf(36:66),*) nx, ny, nz
  endif

  if( nx /= Param%Cell%Na .or. ny /= Param%Cell%Nb .or. nz /= Param%Cell%Nc ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,998) trim(fname)
998  format('      +++++++ Error vecter3d::loadDX : size mismatch in: ',a)
     close(16)
     close(iunit)
     stop
  end if

  do 
     read(iunit, '(a)', end=100) buf
     if( buf(1:20) == 'object 3 class array' ) exit
  end do
100 continue

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           read(iunit,'(a)') buf
           read(buf,*) v(:,ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__load2DX

subroutine vector3d__load2Cube( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(out) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname

  integer          :: natom, n
  integer          :: nx, ny, nz
  integer          :: ia, ib, ic
  integer          :: iunit
  logical          :: ex
  character(128)   :: buf

  inquire( file=fname, exist = ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,899) trim(fname)
899  format('      +++++++ Error vecter3d::loadCube : can not open file: ',a)
     close(16)
     stop
  end if
  iunit = 1
  open(iunit,file=fname)

  read(iunit,'(a)') buf 
  read(iunit,'(a)') buf 

  read(iunit,'(a)') buf
  read(buf,*) natom
  if( natom < 0 ) natom = -natom

  read(iunit,'(a)') buf
  read(buf,*) nx
  if( nx < 0 ) nx = -nx

  read(iunit,'(a)') buf
  read(buf,*) ny
  if( ny < 0 ) ny = -ny

  read(iunit,'(a)') buf
  read(buf,*) nz
  if( nz < 0 ) nz = -nz

  if( nx /= Param%Cell%Na .or. ny /= Param%Cell%Nb .or. nz /= Param%Cell%Nc ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,888) trim(fname)
888  format('      +++++++ Error vecter3d::loadCube : size mismatch in: ',a)
     close(16)
     close(iunit)
     stop
  end if

  do n=1, natom
     read(iunit,'(a)') buf 
  end do

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           read(iunit,'(a)') buf
           read(buf,*) v(:,ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__load2Cube

subroutine vector3d__load4DX( v, fname )
  use ac_parameter

  implicit none
  complex(8), intent(out) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname

  integer          :: nx, ny, nz
  integer          :: ia, ib, ic
  integer          :: iunit
  logical          :: ex
  character(128)   :: buf

  inquire( file=fname, exist = ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,999) trim(fname)
999  format('      +++++++ Error vecter3d::loadDX : can not open file: ',a)
     close(16)
     stop
  end if
  iunit = 1
  open(iunit,file=fname)

  read(iunit,'(a)') buf

  if( buf(1:35) == 'object 1 class gridpositions counts' ) then
     read( buf(36:66),*) nx, ny, nz
  endif

  if( nx /= Param%Cell%Na .or. ny /= Param%Cell%Nb .or. nz /= Param%Cell%Nc ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,998) trim(fname)
998  format('      +++++++ Error vecter3d::loadDX : size mismatch in: ',a)
     close(16)
     close(iunit)
     stop
  end if

  do 
     read(iunit, '(a)', end=100) buf
     if( buf(1:20) == 'object 3 class array' ) exit
  end do
100 continue

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           read(iunit,'(a)') buf
           read(buf,*) v(:,ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__load4DX

subroutine vector3d__load4Cube( v, fname )
  use ac_parameter

  implicit none
  complex(8), intent(out) :: v(Param%Option%nspin,Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)

  character(len=*), intent(in) :: fname

  integer          :: natom, n
  integer          :: nx, ny, nz
  integer          :: ia, ib, ic
  integer          :: iunit
  logical          :: ex
  character(128)   :: buf

  inquire( file=fname, exist = ex )
  if( .not. ex ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,899) trim(fname)
899  format('      +++++++ Error vecter3d::loadCube : can not open file: ',a)
     close(16)
     stop
  end if
  iunit = 1
  open(iunit,file=fname)

  read(iunit,'(a)') buf 
  read(iunit,'(a)') buf 

  read(iunit,'(a)') buf
  read(buf,*) natom
  if( natom < 0 ) natom = -natom

  read(iunit,'(a)') buf
  read(buf,*) nx
  if( nx < 0 ) nx = -nx

  read(iunit,'(a)') buf
  read(buf,*) ny
  if( ny < 0 ) ny = -ny

  read(iunit,'(a)') buf
  read(buf,*) nz
  if( nz < 0 ) nz = -nz

  if( nx /= Param%Cell%Na .or. ny /= Param%Cell%Nb .or. nz /= Param%Cell%Nc ) then
     open(unit=16,file=Param%Option%file_ac_tempout,position='append')
     write(16,888) trim(fname)
888  format('      +++++++ Error vecter3d::loadCube : size mismatch in: ',a)
     close(16)
     close(iunit)
     stop
  end if

  do n=1, natom
     read(iunit,'(a)') buf 
  end do

  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        do ic=1, Param%Cell%Nc
           read(iunit,'(a)') buf
           read(buf,*) v(:,ia,ib,ic)
        end do
     end do
  end do

  close(iunit)

  return
end subroutine vector3d__load4Cube

subroutine vector3d__save_mo( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname

  call vector3d__saveCube_mo( v, fname )

  return
end subroutine vector3d__save_mo

subroutine vector3d__saveCube_mo( v, fname )
  use ac_parameter

  implicit none
  real(8), intent(in)  :: v(Param%Cell%Na,Param%Cell%Nb,Param%Cell%Nc)
  character(len=*), intent(in) :: fname
  integer :: ia, ib, ic, i, ii, i4
  integer :: iunit

  iunit = 1
  open(iunit,file=fname)
  write(iunit,*) 'SYS1'
  write(iunit,*) 'SYS1'
  write(iunit,993) Param%Data%natom, Param%Cell%Lo(1), Param%Cell%Lo(2), Param%Cell%Lo(3)
  write(iunit,993) Param%Cell%Na, Param%Cell%dLa(1), Param%Cell%dLa(2), Param%Cell%dLa(3)
  write(iunit,993) Param%Cell%Nb, Param%Cell%dLb(1), Param%Cell%dLb(2), Param%Cell%dLb(3)
  write(iunit,993) Param%Cell%Nc, Param%Cell%dLc(1), Param%Cell%dLc(2), Param%Cell%dLc(3)
  do i=1, Param%Data%natom
     write(iunit,992) Param%Data%vatom(i)%number, Param%Data%vatom(i)%Q                  &
          , Param%Data%vatom(i)%Ro(1), Param%Data%vatom(i)%Ro(2), Param%Data%vatom(i)%Ro(3)
  end do
  do ia=1, Param%Cell%Na
     do ib=1, Param%Cell%Nb
        write(iunit,999) (v(ia,ib,ic),ic=1,Param%Cell%Nc)
     end do
  end do

  close(iunit)

999 format(6f13.6)
993 format(i4,3f13.6)
992 format(i4,4f13.6)

  return
end subroutine vector3d__saveCube_mo
