! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.40)                       @@ !
! @@     "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_misc_module

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

  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_misc_module

  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, ".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_misc_module

  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, ".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_misc_module

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

  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_misc_module

  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, ".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_misc_module

  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, ".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__save1Cube( v, fname )
  use ac_misc_module
  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(:)
  write(iunit,993) Param%Cell%Na, Param%Cell%dLa(:)
  write(iunit,993) Param%Cell%Nb, Param%Cell%dLb(:)
  write(iunit,993) Param%Cell%Nc, Param%Cell%dLc(:)
  do i=1, Param%Data%natom
     write(iunit,992) Param%Data%vatom(i)%number, Param%Data%vatom(i)%Q                  &
          , Param%Data%vatom(i)%Ro(:)
  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(6f17.10)
993 format(i4,3f17.10)
992 format(i4,4f17.10)

  return
end subroutine vector3d__save1Cube

subroutine vector3d__save2Cube( v, fname )
  use ac_misc_module

  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(:)*AU_TO_AA 

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

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

  write(iunit,'(i5,3f20.15)') Param%Cell%Nc, Param%Cell%dLc(:)*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__save4Cube( v, fname )
  use ac_misc_module

  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(:)*AU_TO_AA 

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

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

  write(iunit,'(i5,3f20.15)') Param%Cell%Nc, Param%Cell%dLc(:)*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__load1Cube( v, fname )
  use ac_misc_module

  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__load2Cube( v, fname )
  use ac_misc_module

  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__load4Cube( v, fname )
  use ac_misc_module

  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_misc_module

  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_misc_module

  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(:)
  write(iunit,993) Param%Cell%Na, Param%Cell%dLa(:)
  write(iunit,993) Param%Cell%Nb, Param%Cell%dLb(:)
  write(iunit,993) Param%Cell%Nc, Param%Cell%dLc(:)
  do i=1, Param%Data%natom
     write(iunit,992) Param%Data%vatom(i)%number, Param%Data%vatom(i)%Q                  &
          , Param%Data%vatom(i)%Ro(:)
  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
