! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.40)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine trans(w,iw_do,px,py,qx,qy,ispin,kt)

  use hamiltonian_sgf
  use hamiltonian_c
  use gf_se_c
  use constant
  use condition_ini
  use mod_mpi

  implicit none
  include 'mpif.h'
  integer, intent(in) :: iw_do
  integer, intent(in) :: px,py,qx,qy,ispin,kt
  complex(8), intent(in) :: w

  integer :: i1_do,i2_do,ier
  complex(8), allocatable :: amat_temp5(:,:),amat_temp6(:,:)
  complex(8), allocatable :: bmat_temp5(:,:),bmat_temp6(:,:)

  character(50) :: nfile_strans

  if( iw_do > iw_max_gs ) then
     go to 100
  end if

  call alo_hami_c3
  if( ham_model_ini == 'input' .or. ham_model_ini == 'scf_accel' ) then
     if( ham_model_ini == 'input' ) then
        call set_hami_c_cc_input(ispin)
     else
        call set_hami_c_cc_scf(ispin)
     end if
  else
     call set_hami_c_cc(px,py,qx,qy)
  end if
  allocate(amat_temp6(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: trans 1'
     stop
  end if
  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)                                                  &
             =(w*scc_mat(i1_do,i2_do)-hcc_mat(i1_do,i2_do))
     end do
  end do
  call unset_hami_c31

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)                                                  &
             =amat_temp6(i1_do,i2_do)                                           &
             -se_l_mat_per(i1_do,i2_do,px,py)-se_r_mat_per(i1_do,i2_do,qx,qy)
     end do
  end do

  allocate(bmat_temp6(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: trans 2'
     stop
  end if

  call inverse_mat1(m_mat_max_c,amat_temp6,bmat_temp6)

  call mat_mul(m_mat_max_c,bmat_temp6,scc_mat,amat_temp6)
  call unset_hami_c32

  call cal_print_text2(iw_do,amat_temp6,ispin,kt)

100 continue

  do i1_do=1,nprocs
     call MPI_BARRIER(mpi_comm_world,ierr)
     if( iw_do > iw_max_gs ) then
        cycle
     end if
     if( i1_do == myrank+1 ) then
        if( iw_do /= 1 ) then
           if( spin_switch_cc /= 2 ) then
              if( switch_out_gf /= 'off' ) then
                 nfile_strans='gfc'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=50,file=nfile_strans,position='append')
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='ftg'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=46,file=nfile_strans,position='append')
              end if
           else
              if( switch_out_gf /= 'off' ) then
                 nfile_strans='gfc_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=50,file=nfile_strans,position='append')
                 nfile_strans='gfc_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=52,file=nfile_strans,position='append')
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='ftg_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=46,file=nfile_strans,position='append')
                 nfile_strans='ftg_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=47,file=nfile_strans,position='append')
              end if
           end if
        else
           if( spin_switch_cc /= 2 ) then
              if( switch_out_gf /= 'off' ) then
                 nfile_strans='gfc'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=50,file=nfile_strans)
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='ftg'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=46,file=nfile_strans)
              end if
           else
              if( switch_out_gf /= 'off' ) then
                 nfile_strans='gfc_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=50,file=nfile_strans)
                 nfile_strans='gfc_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=52,file=nfile_strans)
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='ftg_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=46,file=nfile_strans)
                 nfile_strans='ftg_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=47,file=nfile_strans)
              end if
           end if
        end if
        call print_site_sel(w,amat_temp6,bmat_temp6,ispin)
        if( spin_switch_cc /= 2 ) then
           if( switch_out_gf /= 'off' ) then
              close(50)
           end if
           if( switch_out_tr == 'all' ) then
              close(46)
           end if
        else
           if( switch_out_gf /= 'off' ) then
              close(50)
              close(52)
           end if
           if( switch_out_tr == 'all' ) then
              close(46)
              close(47)
           end if
        end if
     end if
  end do

  if( iw_do > iw_max_gs ) then
     go to 110
  end if

  allocate(amat_temp5(m_mat_max_c,m_mat_max_c)                                 &
       ,bmat_temp5(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: trans 3'
     stop
  end if

  !                       ------------------------------------                       !

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp5(i1_do,i2_do)                                                  &
             =dcmplx(0.d0,1.d0)*(se_r_mat_per(i1_do,i2_do,qx,qy)            &
             -dconjg(se_r_mat_per(i2_do,i1_do,qx,qy)))
     end do
  end do
  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        bmat_temp5(i1_do,i2_do)=dconjg(bmat_temp6(i2_do,i1_do))
     end do
  end do
  call mat_mul(m_mat_max_c,amat_temp5,bmat_temp5,amat_temp6)

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp5(i1_do,i2_do)                                                  &
             =dcmplx(0.d0,1.d0)*(se_l_mat_per(i1_do,i2_do,px,py)            &
             -dconjg(se_l_mat_per(i2_do,i1_do,px,py)))
     end do
  end do
  call mat_mul(m_mat_max_c,amat_temp5,bmat_temp6,bmat_temp5)

  call mat_mul(m_mat_max_c,bmat_temp5,amat_temp6,amat_temp5)

  call cal_print_text3(iw_do,amat_temp5,ispin,kt)

110 continue

  do i1_do=1,nprocs
     call MPI_BARRIER(mpi_comm_world,ierr)
     if( iw_do > iw_max_gs ) then
        cycle
     end if
     if( i1_do == myrank+1 ) then
        if( iw_do /= 1 ) then
           if( spin_switch_cc /= 2 ) then
              if( switch_out_tr /= 'off' ) then
                 nfile_strans='tra'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=51,file=nfile_strans,position='append')
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='gam'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=48,file=nfile_strans,position='append')
              end if
              open(unit=55,file='sf_gf.dat',position='append')
           else
              if( switch_out_tr /= 'off' ) then
                 nfile_strans='tra_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=51,file=nfile_strans,position='append')
                 nfile_strans='tra_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=53,file=nfile_strans,position='append')
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='gam_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=48,file=nfile_strans,position='append')
                 nfile_strans='gam_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=49,file=nfile_strans,position='append')
              end if
              open(unit=55,file='sf_gf_up.dat',position='append')
              open(unit=56,file='sf_gf_do.dat',position='append')
           end if
           open(unit=57,file='em_gf.dat',position='append')
           open(unit=58,file='trans.dat',position='append')
        else
           if( spin_switch_cc /= 2 ) then
              if( switch_out_tr /= 'off' ) then
                 nfile_strans='tra'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=51,file=nfile_strans)
              end if
              if( kt /= 1 ) then
                 open(unit=55,file='sf_gf.dat',position='append')
              else
                 open(unit=55,file='sf_gf.dat')
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='gam'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=48,file=nfile_strans)
              end if
           else
              if( switch_out_tr /= 'off' ) then
                 nfile_strans='tra_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=51,file=nfile_strans)
                 nfile_strans='tra_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=53,file=nfile_strans)
              end if
              if( switch_out_tr == 'all' ) then
                 nfile_strans='gam_up'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=48,file=nfile_strans)
                 nfile_strans='gam_do'
                 call makefilename_strans(kt,nfile_strans)
                 open(unit=49,file=nfile_strans)
              end if
              if( kt /= 1 ) then
                 open(unit=55,file='sf_gf_up.dat',position='append')
                 open(unit=56,file='sf_gf_do.dat',position='append')
              else
                 open(unit=55,file='sf_gf_up.dat')
                 open(unit=56,file='sf_gf_do.dat')
              end if
           end if
           if( kt /= 1 ) then
              open(unit=57,file='em_gf.dat',position='append')
              open(unit=58,file='trans.dat',position='append')
           else
              open(unit=57,file='em_gf.dat')
              open(unit=58,file='trans.dat')
           end if
        end if
        call print_site_tra(w,amat_temp5,ispin)
        call print_text_t(w,iw_do,ispin,kt)
        if( spin_switch_cc /= 2 ) then
           if( switch_out_tr /= 'off' ) then
              close(51)
           end if
           close(55)
           close(57)
           close(58)
           if( switch_out_tr == 'all' ) then
              close(48)
           end if
        else
           if( switch_out_tr /= 'off' ) then
              close(51)
              close(53)
           end if
           close(55)
           close(56)
           close(57)
           close(58)
           if( switch_out_tr == 'all' ) then
              close(48)
              close(49)
           end if
        end if
     end if
  end do

  if( iw_do > iw_max_gs ) then
     go to 120
  end if

  deallocate(amat_temp5,amat_temp6,bmat_temp5,bmat_temp6,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: trans'
     stop
  end if

120 continue

  return
end subroutine trans

subroutine makefilename_strans(kt,nfile_strans)

  implicit none
  integer, intent(in) :: kt
  character(50), intent(inout) :: nfile_strans

  character(1) :: character_temk(4),a(10)
  integer :: i1,i2,k1,i_temp1,i_temp2

  a(1)='0'
  a(2)='1'
  a(3)='2'
  a(4)='3'
  a(5)='4'
  a(6)='5'
  a(7)='6'
  a(8)='7'
  a(9)='8'
  a(10)='9'

  i_temp1=kt
  do i2=1,4
     i_temp2=i_temp1/(10**(4-i2))
     character_temk(i2)=a(i_temp2+1)
     i_temp1=i_temp1-(10**(4-i2))*i_temp2
  end do
  nfile_strans=trim(nfile_strans)                                         &
       //'_'//character_temk(1)//character_temk(2)                &
       //character_temk(3)//character_temk(4)//'.data'

  return
end subroutine makefilename_strans
