! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
module para

  implicit none
     character(100) :: file_parameter
     character(100) :: file_parameter1
     character(100) :: file_parameter2
     character(10) :: switch
     character(10) :: switch_dr
     character(30) :: ba
     character(200) :: buf
     character(10) :: c_temp
     character(10) :: d_temp
     character(105) :: nfile_strans
     character(20) :: name_input_mol

     integer, parameter :: isi_l=0,ibo_l=2,isi_r=0,ibo_r=3

     integer :: mat_max
     integer :: mat_ini,level,m_mat_max_m

     integer :: iatomnum,iatomnum_c,iatomnum_l,iatomnum_r,iatom_total
     integer :: num_atom_l,num_atom_m,num_atom_r

     integer :: input_num,itemp_rot
     integer :: input_num_site,input_num_ch
     integer :: kp

     integer :: min_print_site,max_print_site
     integer :: num_h00_r1,num_h00_r2,num_s00_r !,num_h00_r
     integer :: i_sum_switch,i_sum_s,i_sum_e
     integer :: i_sumk_switch,i_sumk_s,i_sumk_e

     integer :: i_do,i1_do,i2_do,i3_do,i4_do,i5_do,iw_max_gs
     integer :: l1,l2,ier,itemp,l_con
     integer :: itemp1,itemp2,itemp3,itemp4,itemp5,itemp6,ispin

     real(8) :: pai
     real(8) :: tempp,tempr,tempi,dummy

     complex(8) :: temp_la

     integer, allocatable :: i_num(:)
     integer, allocatable :: i_orbital_temp(:),i_orbital(:),i_orb_jj(:),i_r_num(:)
     integer, allocatable :: level_temp(:),l_site_temp(:),l_sss(:),l_ch(:)

     real(8), allocatable :: den_temp(:,:),den_site(:,:),den(:,:),den_total_site(:)
     real(8), allocatable :: den_up_temp1(:,:),den_up_temp2(:,:),den_up_temp3(:)
     real(8), allocatable :: den_sumk_temp1(:,:,:),den_sumk_temp2(:,:,:)
     real(8), allocatable :: den_sumk_temp3(:,:),w_temp(:)
     real(8), allocatable :: d_eigen(:,:),eigen_la(:),w(:)
     real(8), allocatable :: rwork(:)

     complex(8), allocatable :: h00(:,:),s00(:,:)
     complex(8), allocatable :: hss(:,:),sss(:,:)
     complex(8), allocatable :: ev(:,:)
     complex(8), allocatable :: den_c(:,:),den2_c(:,:),temp_com(:),den_temp_c(:,:)
     complex(8), allocatable :: cwork(:)

!+++++++++++++++++++++

!     real(8), allocatable :: s_ev(:)
!     real(8), allocatable :: ev_vec(:,:)
!     real(8), allocatable :: ev_vec1(:,:),ev_vec2(:,:)
!     real(8), allocatable :: temp(:,:),temp_mat2(:),d(:)
!     real(8), allocatable :: den2(:,:)

end module para
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
program main
  use para
  implicit none
     integer :: iargc
! -------------------------------------------------------------------------------- !

      if( iargc() >= 1 ) then
        call getarg(1,file_parameter)
      else
        write(*,*) 'no file'
        stop
      end if

      switch=''
      name_input_mol='partial'
      file_parameter1=''
      file_parameter2=''
      switch_dr='accel'
      open(unit=60,file=file_parameter)
        do
          read(60,'(a)',end=121) buf
          if( buf == '' ) then
            cycle
          end if
          read(buf,*) ba
          select case(ba)
            case('#file_type')
              read(buf,*) ba,c_temp,switch
            case('#name_input_mol')
              read(buf,*) ba,c_temp,name_input_mol
            case('#input_junc_cond')
              read(buf,*) ba,c_temp,file_parameter1
            case('#input_mol')
              read(buf,*) ba,c_temp,file_parameter2
            case('#switch_dr')
              read(buf,*) ba,c_temp,switch_dr
            end select
        end do
  121   continue
      close(60)

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

      call set_orb

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

      itemp_rot=mat_max

      allocate(level_temp(itemp_rot),l_site_temp(itemp_rot),l_sss(itemp_rot)       &
              ,l_ch(itemp_rot),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2',itemp_rot
        stop
      end if

      input_num=0
      input_num_site=0
      input_num_ch=0
      i_sum_switch=0
      open(unit=60,file=file_parameter)
        do
          read(60,'(a)',end=120) buf
          if( buf == '' ) then
            cycle
          end if
          read(buf,*) ba
          if( ba(1:1) == '#' ) then
            cycle
          end if
          read(buf,*) ba
          select case(ba)
            case('ini')
              read(buf,*) ba,level
              mat_ini=level
            case('k')
              read(buf,*) ba,c_temp !,kp
              if( c_temp == 'sum' ) then
                read(buf,*) ba,c_temp,i_sumk_e
                i_sumk_s=1
                i_sumk_switch=1
              else
                read(buf,*) ba,c_temp,i_sumk_e
                i_sumk_s=i_sumk_e
                i_sumk_switch=0
              end if
             ! mat_ini=level
            case('b')
              read(buf,*) ba,level
              if( level > mat_max ) then
                write(*,*) 'error: level',level
                cycle
              end if
              input_num=input_num+1
              level_temp(input_num)=level
            case('a')
              read(buf,*) ba,level
              if( level > iatom_total ) then
                write(*,*) 'error: site',level
                cycle
              end if
              input_num_site=input_num_site+1
              l_sss(input_num_site)=level
            case('sum_a')
              read(buf,*) ba,i_sum_s,i_sum_e
              i_sum_switch=1
            case('c')
              read(buf,*) ba,level
              input_num_ch=input_num_ch+1
              l_ch(input_num_ch)=level
            end select
        end do
  120   continue
      close(60)

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

      call set_orb2

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

      do kp=i_sumk_s,i_sumk_e
        if( switch == 'all' ) then
          if( input_num /= 0 ) then
            call pldos
          else
            if( input_num_site /= 0 ) then
              call ldos_1
            end if
          end if
        end if
        if( switch == 'dia' .or. switch == 'diagonal' ) then
          if( input_num_site /= 0 ) then
            call ldos_2
          end if
        end if
      end do

! -------------------------------------------------------------------------------- !
  stop
end program main
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
subroutine set_orb
  use para
  implicit none
! -------------------------------------------------------------------------------- !

      if( switch_dr == 'accel' ) then
        open(unit=50,file=file_parameter1)
          read(50,*)
          read(50,*)
          read(50,*) d_temp,c_temp,ispin
          read(50,*)
          read(50,*)
          read(50,*)
          read(50,*)
          read(50,*)
          read(50,*)
          read(50,*) itemp2
          do i1_do=1, itemp2
            read(50,*)
          end do
          read(50,*)
          read(50,*)
          read(50,*)
          read(50,*)

          read(50,*)
          read(50,*) iatomnum, iatomnum_l, iatomnum_r
          iatomnum_c=iatomnum-iatomnum_l-iatomnum_r

          allocate(i_orbital_temp(iatomnum),stat=ier)
          if( ier /= 0 ) then
            write(*,*) 'error allocate-1'
            stop
          end if

          do i1_do=1,iatomnum
            read(50,*) itemp4,c_temp,tempr,tempi,tempp,dummy,i_orbital_temp(i1_do)
          end do
        close(50)

        itemp2=itemp4
        itemp4=itemp2

        iatom_total=iatomnum
        num_atom_l=iatomnum_l
        num_atom_m=iatom_total
        num_atom_r=iatomnum_r
!        write(*,*)  num_atom_l,num_atom_m,num_atom_r
      end if

      if( switch_dr == 'abred' ) then
        open(unit=50,file=file_parameter1)
        !  read(50,*)
          read(50,*) iatomnum
          read(50,*) iatomnum_c
          read(50,*) iatomnum_l
          read(50,*) iatomnum_r
          read(50,*) ispin

          allocate(i_orbital_temp(iatomnum),stat=ier)
          if( ier /= 0 ) then
            write(*,*) 'error allocate-1'
            stop
          end if

          do i1_do=1,ispin+1
            read(50,*)
            do i2_do=1,iatomnum
              read(50,*) itemp
              do i3_do=1,itemp+1
                read(50,*) itemp1
                read(50,*) itemp2
                read(50,*) itemp3
                read(50,*) itemp4
                read(50,*) itemp5,itemp6
                if( itemp1 == itemp3 ) then
                  i_orbital_temp(i2_do)=itemp5
                end if
                do i4_do=1,itemp5
                  do i5_do=1,itemp6
                    read(50,*) dummy
                  end do
                end do
              end do
            end do
          end do
        close(50)

        itemp2=itemp4
        itemp4=itemp2

        iatom_total=iatomnum_l*isi_l/ibo_l+iatomnum+iatomnum_r*isi_r/ibo_r
        num_atom_l=iatomnum_l
        num_atom_m=iatom_total
        num_atom_r=iatomnum_r
!        write(*,*)  num_atom_l,num_atom_m,num_atom_r
      end if

      if( file_parameter2 /= '' ) then
        mat_max=-100
        if( name_input_mol /= 'partial' ) then
          open(unit=18,file=file_parameter2) !,status='old')
        else
          nfile_strans=file_parameter2
          if( i_sumk_e > 0 ) then
            call makefilename_in(i_sumk_e,nfile_strans)
          else
            call makefilename_in(1,nfile_strans)
          end if
          open(unit=18,file=nfile_strans) !,status='old')
        end if
          read(18,*,end=100) i1_do,mat_max
  100     continue
        close(18)
        if( mat_max < 0 ) then
          mat_max=0
          do i1_do=1,iatomnum
            mat_max=mat_max+i_orbital_temp(i1_do)
          end do
        end if
      else
        mat_max=0
        do i1_do=1,iatomnum
          mat_max=mat_max+i_orbital_temp(i1_do)
        end do
      end if

! -------------------------------------------------------------------------------- !
  return
end subroutine set_orb
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
subroutine set_orb2
  use para
  implicit none
! -------------------------------------------------------------------------------- !

      if( switch_dr == 'accel' ) then
       allocate(i_orbital(iatom_total),i_orb_jj(iatom_total+1),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate-1'
          stop
        end if

        ier=0
        i_orb_jj(1)=0
        do i1_do=1,iatom_total
          ier=ier+1
          i_orbital(ier)=i_orbital_temp(i1_do)
          i_orb_jj(ier+1)=i_orb_jj(ier)+i_orbital(ier)
        end do

        do i2_do=1,ier
          write(*,*) i2_do,i_orbital(i2_do)
        end do
        write(*,*)
        write(*,*) iatom_total,mat_max
        write(*,*)
      end if

      if( switch_dr == 'abred' ) then
        allocate(i_r_num(iatomnum),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate'
          stop
        end if

        do i1_do=1,iatomnum_l
          i_r_num(i1_do)=iatomnum_c+i1_do
        end do
        do i1_do=1,iatomnum_c
          i_r_num(i1_do+iatomnum_l)=i1_do
        end do
        do i1_do=1,iatomnum_r
          i_r_num(i1_do+iatomnum_l+iatomnum_c)=i1_do+iatomnum_l+iatomnum_c
        end do

        allocate(i_orbital(iatom_total),i_orb_jj(iatom_total+1),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate-1'
          stop
        end if

        ier=0
        i_orb_jj(1)=0
        do i1_do=1,iatomnum_l*isi_l/ibo_l
          ier=ier+1
          i_orbital(ier)                                                           &
                =i_orbital_temp(i_r_num(iatomnum-iatomnum_l*isi_l/ibo_l+i1_do))
          i_orb_jj(ier+1)=i_orb_jj(ier)+i_orbital(ier)
        end do
        do i1_do=1,iatomnum
          ier=ier+1
          i_orbital(ier)=i_orbital_temp(i_r_num(i1_do))
          i_orb_jj(ier+1)=i_orb_jj(ier)+i_orbital(ier)
        end do
        do i1_do=1,iatomnum_r*isi_r/ibo_r
          ier=ier+1
          i_orbital(ier)=i_orbital_temp(i_r_num(i1_do))
          i_orb_jj(ier+1)=i_orb_jj(ier)+i_orbital(ier)
        end do

        do i2_do=1,ier
          write(*,*) i2_do,i_orbital(i2_do)
        end do
        write(*,*)
        write(*,*) iatom_total,mat_max
        write(*,*)
      end if

! -------------------------------------------------------------------------------- !
  return
end subroutine set_orb2
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
subroutine pldos
  use para
  implicit none
! -------------------------------------------------------------------------------- !

      allocate(d_eigen(2,mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'pldos'
        stop
      end if

!                         ---------------------------------                        !
!                         ---------------------------------                        !
!                                        up                                        !
!                         ---------------------------------                        !
!                         ---------------------------------                        !

      if( name_input_mol /= 'partial' ) then
        open(unit=18,file=file_parameter2,status='old')
      else
        nfile_strans=file_parameter2
        call makefilename_in(kp,nfile_strans)
        open(unit=18,file=nfile_strans,status='old')
      end if

        read(18,*) i1_do,mat_max
        read(18,*) 
        read(18,*) num_h00_r1,num_h00_r2,num_s00_r
        read(18,*) 
        read(18,*) 

        allocate(h00(mat_max,mat_max),s00(mat_max,mat_max)                         &
                ,hss(mat_max,mat_max),sss(mat_max,mat_max),eigen_la(mat_max)       &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate1'
          stop
        end if
        h00=dcmplx(0.d0,0.d0)
        s00=dcmplx(0.d0,0.d0)

        read(18,*) 
        do i1_do=1,num_h00_r1
          read(18,999) itemp,l1,l2,tempr,tempi
          h00(l1,l2)=dcmplx(tempr,tempi)
        end do
        if( ispin == 1 ) then
          read(18,*) 
          do i1_do=1,num_h00_r2
            read(18,*) !itemp,l1,l2,tempr,tempi
          end do
        end if
        read(18,*) 
        do i1_do=1,num_s00_r
          read(18,999) itemp,l1,l2,tempr,tempi
          s00(l1,l2)=dcmplx(tempr,tempi)
        end do

      close(18)

!      num_h00_r=num_h00_r1

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

      allocate(cwork(4*mat_max),rwork(4*mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

      hss=h00
      sss=s00
      call zhegv(1,'V','L',mat_max,hss,mat_max,sss,mat_max,eigen_la                &
                ,cwork,4*mat_max,rwork,ier)

      deallocate(cwork,rwork,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

      allocate(i_num(mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate21'
        stop
      end if

      do i1_do=1,mat_max
        i_num(i1_do)=i1_do
      end do
      do i1_do=1,mat_max
        do i2_do=i1_do+1,mat_max
          if( eigen_la(i_num(i1_do)) > eigen_la(i_num(i2_do)) ) then
            i3_do=i_num(i1_do)
            i_num(i1_do)=i_num(i2_do)
            i_num(i2_do)=i3_do
          end if
        end do
      end do

      do i2_do=1,mat_max
        do i1_do=1,mat_max
          sss(i1_do,i2_do)=hss(i1_do,i_num(i2_do))
        end do
        d_eigen(1,i2_do)=eigen_la(i_num(i2_do))
      end do

      deallocate(i_num,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate21'
        stop
      end if

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

      allocate(cwork(mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

      do i2_do=1,mat_max
        do i3_do=1,mat_max
          cwork(i3_do)=dcmplx(0.d0,0.d0)
        end do
        do i4_do=1,mat_max
          do i3_do=1,mat_max
            cwork(i3_do)=cwork(i3_do)+h00(i3_do,i4_do)*sss(i4_do,i2_do)
          end do
        end do
        do i1_do=1,mat_max
          temp_la=dcmplx(0.d0,0.d0)
          do i3_do=1,mat_max
            temp_la=temp_la+dconjg(sss(i3_do,i1_do))*cwork(i3_do)
          end do
          if( cdabs(temp_la) > 1.d-10 ) then
            write(*,*) i1_do,i2_do,temp_la
          end if
        end do
      end do

      deallocate(cwork,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

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

   !   write(*,*) 'start calculation_up',input_num,input_num_site

      pai=datan(1.d0)*4.d0

      if( ispin == 0 ) then
        nfile_strans='gfc'
        call makefilename_in(kp,nfile_strans)
      else
        nfile_strans='gfc_up'
        call makefilename_in(kp,nfile_strans)
      end if
      open(unit=50,file=nfile_strans,status='old')

        read(50,*)
        read(50,*)
        read(50,'(a)') buf
        read(buf,*,end=120) iw_max_gs,m_mat_max_m,min_print_site,max_print_site
        go to 121
  120   continue
        read(buf,*) iw_max_gs,m_mat_max_m
        min_print_site=1
        max_print_site=m_mat_max_m
  121   continue

        write(*,*) 'start calculation_up',input_num,input_num_site                 &
                                ,min_print_site,max_print_site !,iw_max_gs,m_mat_max_m

        allocate(ev(m_mat_max_m,m_mat_max_m),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
        do i1_do=1,m_mat_max_m
          do i2_do=1,m_mat_max_m
            ev(i1_do,i2_do)=dcmplx(0.d0,0.d0)
          end do
          ev(i1_do,i1_do)=dcmplx(1.d0,0.d0)
        end do
        do i1_do=1,mat_max
          do i2_do=1,mat_max
            ev(i_orb_jj(mat_ini)+i1_do,i_orb_jj(mat_ini)+i2_do)=sss(i1_do,i2_do)
          end do
        end do

        allocate(den_c(m_mat_max_m,m_mat_max_m),w(iw_max_gs)                       &
                ,den2_c(m_mat_max_m,m_mat_max_m),temp_com(m_mat_max_m),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        allocate(den_temp(iw_max_gs,input_num),den_site(iw_max_gs,input_num_site)  &
                ,den_total_site(iw_max_gs),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        den_site=0.d0
    !    den_total_site=0.d0

        do i5_do=1,iw_max_gs
          write(6,*) 'now_w',i5_do,'(max=',iw_max_gs,')'

          den2_c=dcmplx(0.d0,0.d0)

          do i1_do=min_print_site,max_print_site !1,m_mat_max_m
            read(50,*) itemp,w(i5_do)
            do i2_do=min_print_site,max_print_site !1,m_mat_max_m
              read(50,*) itemp,tempr,tempi
!              read(50,*) itemp,tempi
              den_c(i1_do,i2_do)=dcmplx(tempr,tempi)
            end do
          end do

          do i3_do=1,input_num_site
            level=i_orb_jj(l_sss(i3_do))
            do i2_do=1,i_orbital(l_sss(i3_do))
              den_site(i5_do,i3_do)                                                &
                       =den_site(i5_do,i3_do)+dimag(den_c(level+i2_do,level+i2_do))
            end do
            den_site(i5_do,i3_do)=-den_site(i5_do,i3_do)/pai
          end do

          if( i_sum_switch == 1 ) then
            den_total_site(i5_do)=0.d0
            do i3_do=i_sum_s,i_sum_e
              level=i_orb_jj(i3_do)
              do i2_do=1,i_orbital(i3_do)
                den_total_site(i5_do)                                                &
                       =den_total_site(i5_do)+dimag(den_c(level+i2_do,level+i2_do))
              end do
            end do
            den_total_site(i5_do)=-den_total_site(i5_do)/pai
          end if

          do i_do=1,input_num
            i2_do=i_orb_jj(mat_ini)+level_temp(i_do)
            do i3_do=1,m_mat_max_m
              temp_com(i3_do)=dcmplx(0.d0,0.d0)
            end do
            do i4_do=i_orb_jj(mat_ini)+1,i_orb_jj(mat_ini)+mat_max+1
              do i3_do=i_orb_jj(mat_ini)+1,i_orb_jj(mat_ini)+mat_max+1
                temp_com(i3_do)=temp_com(i3_do)+den_c(i3_do,i4_do)*ev(i4_do,i2_do)
              end do
            end do
            i1_do=i_orb_jj(mat_ini)+level_temp(i_do)
            do i3_do=i_orb_jj(mat_ini)+1,i_orb_jj(mat_ini)+mat_max+1
              den2_c(i1_do,i2_do)=den2_c(i1_do,i2_do)                              &
                                 +dconjg(ev(i3_do,i1_do))*temp_com(i3_do)
            end do
          end do

          do i1_do=1,input_num
            level=level_temp(i1_do)
            den_temp(i5_do,i1_do)                                                  &
                =-dimag(den2_c(i_orb_jj(mat_ini)+level,i_orb_jj(mat_ini)+level))/pai
          end do

        end do

      close(50)

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

      if( ispin == 0 ) then
        nfile_strans='pdos'
        call makefilename_out(kp,nfile_strans)
        open(unit=54,file=nfile_strans)
          do i1_do=1,input_num
            level=level_temp(i1_do)
            write(54,*) '**************************************'
            write(54,*) 'level=',level
            write(54,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(54,*) w(i3_do),den_temp(i3_do,i1_do)
            end do
          end do
        close(54)
        if( input_num_site > 0 ) then
          nfile_strans='ldos'
          call makefilename_out(kp,nfile_strans)
          open(unit=55,file=nfile_strans)
            do i1_do=1,input_num_site
              level=l_sss(i1_do)
              write(55,*) '**************************************'
              write(55,*) 'level=',level
              write(55,*) '**************************************'
              do i3_do=1,iw_max_gs
                write(55,*) w(i3_do),den_site(i3_do,i1_do)
              end do
            end do
          close(55)
        end if
        if( i_sum_switch == 1 ) then
          nfile_strans='ldos_suma'
          call makefilename_out(kp,nfile_strans)
          open(unit=55,file=nfile_strans)
            write(55,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(55,*) w(i3_do),den_total_site(i3_do)
            end do
          close(55)
        end if
      else
        allocate(den_up_temp1(iw_max_gs,input_num)                                 &
                ,den_up_temp2(iw_max_gs,input_num_site),den_up_temp3(iw_max_gs)    &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
        do i1_do=1,input_num
          do i3_do=1,iw_max_gs
            den_up_temp1(i3_do,i1_do)=den_temp(i3_do,i1_do)
          end do
        end do
        if( input_num_site > 0 ) then
          do i1_do=1,input_num_site
            do i3_do=1,iw_max_gs
              den_up_temp2(i3_do,i1_do)=den_site(i3_do,i1_do)
            end do
          end do
        end if
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_up_temp3(i3_do)=den_total_site(i3_do)
          end do
        end if
      end if

      if( i_sumk_switch == 1 ) then
        if( kp == i_sumk_s ) then
          allocate(den_sumk_temp1(ispin+1,iw_max_gs,input_num)                     &
                  ,den_sumk_temp2(ispin+1,iw_max_gs,input_num_site)                &
                  ,den_sumk_temp3(ispin+1,iw_max_gs),w_temp(iw_max_gs),stat=ier)
          if( ier /= 0 ) then
            write(*,*) 'error allocate2'
            stop
          end if
          den_sumk_temp1=0.d0
          den_sumk_temp2=0.d0
          den_sumk_temp3=0.d0
          do i3_do=1,iw_max_gs
            w_temp(i3_do)=w(i3_do)
          end do
        end if
        do i1_do=1,input_num
          do i3_do=1,iw_max_gs
            den_sumk_temp1(1,i3_do,i1_do)                                          &
                                =den_sumk_temp1(1,i3_do,i1_do)+den_temp(i3_do,i1_do)
          end do
        end do
        if( input_num_site > 0 ) then
          do i1_do=1,input_num_site
            do i3_do=1,iw_max_gs
              den_sumk_temp2(1,i3_do,i1_do)                                        &
                                =den_sumk_temp2(1,i3_do,i1_do)+den_site(i3_do,i1_do)
            end do
          end do
        end if
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_sumk_temp3(1,i3_do)=den_sumk_temp3(1,i3_do)+den_total_site(i3_do)
          end do
        end if
      end if

      deallocate(h00,s00,hss,sss,eigen_la,ev,den_c,den2_c,temp_com                 &
                ,w,den_temp,den_site,den_total_site,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'de: error allocate2'
        stop
      end if

!                         ---------------------------------                        !
!                         ---------------------------------                        !
!                                       down                                       !
!                         ---------------------------------                        !
!                         ---------------------------------                        !

      if( ispin == 0 ) then
        do i2_do=1,mat_max
          d_eigen(2,i2_do)=d_eigen(1,i2_do)
        end do
        go to 100
      end if

      if( name_input_mol /= 'partial' ) then
        open(unit=18,file=file_parameter2,status='old')
      else
        nfile_strans=file_parameter2
        call makefilename_in(kp,nfile_strans)
        open(unit=18,file=nfile_strans,status='old')
      end if

        read(18,*) i1_do,mat_max
        read(18,*) 
        read(18,*) num_h00_r1,num_h00_r2,num_s00_r
        read(18,*) 
        read(18,*) 

        allocate(h00(mat_max,mat_max),s00(mat_max,mat_max)                         &
                ,hss(mat_max,mat_max),sss(mat_max,mat_max),eigen_la(mat_max)       &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate1'
          stop
        end if
        h00=dcmplx(0.d0,0.d0)
        s00=dcmplx(0.d0,0.d0)

        read(18,*) 
        do i1_do=1,num_h00_r1
          read(18,*) ! itemp,l1,l2,tempr,tempi
        end do
        if( ispin == 1 ) then
          read(18,*) 
          do i1_do=1,num_h00_r2
            read(18,999) itemp,l1,l2,tempr,tempi
          h00(l1,l2)=dcmplx(tempr,tempi)
          end do
        end if
        read(18,*) 
        do i1_do=1,num_s00_r
          read(18,999) itemp,l1,l2,tempr,tempi
          s00(l1,l2)=dcmplx(tempr,tempi)
        end do

      close(18)

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

      allocate(cwork(4*mat_max),rwork(4*mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

      hss=h00
      sss=s00
      call zhegv(1,'V','L',mat_max,hss,mat_max,sss,mat_max,eigen_la                &
                ,cwork,4*mat_max,rwork,ier)

      deallocate(cwork,rwork,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

      allocate(i_num(mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate21'
        stop
      end if

      do i1_do=1,mat_max
        i_num(i1_do)=i1_do
      end do
      do i1_do=1,mat_max
        do i2_do=i1_do+1,mat_max
          if( eigen_la(i_num(i1_do)) > eigen_la(i_num(i2_do)) ) then
            i3_do=i_num(i1_do)
            i_num(i1_do)=i_num(i2_do)
            i_num(i2_do)=i3_do
          end if
        end do
      end do

      do i2_do=1,mat_max
        do i1_do=1,mat_max
          sss(i1_do,i2_do)=hss(i1_do,i_num(i2_do))
        end do
        d_eigen(2,i2_do)=eigen_la(i_num(i2_do))
      end do

      deallocate(i_num,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate21'
        stop
      end if

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

      allocate(cwork(mat_max),stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

      do i2_do=1,mat_max
        do i3_do=1,mat_max
          cwork(i3_do)=dcmplx(0.d0,0.d0)
        end do
        do i4_do=1,mat_max
          do i3_do=1,mat_max
            cwork(i3_do)=cwork(i3_do)+h00(i3_do,i4_do)*sss(i4_do,i2_do)
          end do
        end do
        do i1_do=1,mat_max
          temp_la=dcmplx(0.d0,0.d0)
          do i3_do=1,mat_max
            temp_la=temp_la+dconjg(sss(i3_do,i1_do))*cwork(i3_do)
          end do
          if( cdabs(temp_la) > 1.d-10 ) then
            write(*,*) i1_do,i2_do,temp_la
          end if
        end do
      end do

      deallocate(cwork,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate1'
        stop
      end if

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

 !     write(*,*) 'start calculation_do',input_num,input_num_site

      pai=datan(1.d0)*4.d0

      nfile_strans='gfc_do'
      call makefilename_in(kp,nfile_strans)
      open(unit=50,file=nfile_strans,status='old')

        read(50,*)
        read(50,*)
        read(50,'(a)') buf
        read(buf,*,end=122) iw_max_gs,m_mat_max_m,min_print_site,max_print_site
        go to 123
  122   continue
        read(buf,*) iw_max_gs,m_mat_max_m
        min_print_site=1
        max_print_site=m_mat_max_m
  123   continue

        write(*,*) 'start calculation_do',input_num,input_num_site                 &
                                ,min_print_site,max_print_site !,iw_max_gs,m_mat_max_m

        allocate(ev(m_mat_max_m,m_mat_max_m),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
        do i1_do=1,m_mat_max_m
          do i2_do=1,m_mat_max_m
            ev(i1_do,i2_do)=dcmplx(0.d0,0.d0)
          end do
          ev(i1_do,i1_do)=dcmplx(1.d0,0.d0)
        end do
        do i1_do=1,mat_max
          do i2_do=1,mat_max
            ev(i_orb_jj(mat_ini)+i1_do,i_orb_jj(mat_ini)+i2_do)=sss(i1_do,i2_do)
          end do
        end do

        allocate(den_c(m_mat_max_m,m_mat_max_m),w(iw_max_gs)                       &
                ,den2_c(m_mat_max_m,m_mat_max_m),temp_com(m_mat_max_m),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        allocate(den_temp(iw_max_gs,input_num),den_site(iw_max_gs,input_num_site)  &
                ,den_total_site(iw_max_gs),stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        den_site=0.d0
     !   den_total_site=0.d0

        do i5_do=1,iw_max_gs
          write(6,*) 'now_w',i5_do,'(max=',iw_max_gs,')'

          den2_c=dcmplx(0.d0,0.d0)

          do i1_do=min_print_site,max_print_site !1,m_mat_max_m
            read(50,*) itemp,w(i5_do)
            do i2_do=min_print_site,max_print_site !1,m_mat_max_m
              read(50,*) itemp,tempr,tempi
!              read(50,*) itemp,tempi
              den_c(i1_do,i2_do)=dcmplx(tempr,tempi)
            end do
          end do

          do i3_do=1,input_num_site
            level=i_orb_jj(l_sss(i3_do))
            do i2_do=1,i_orbital(l_sss(i3_do))
              den_site(i5_do,i3_do)                                                &
                      =den_site(i5_do,i3_do)+dimag(den_c(level+i2_do,level+i2_do))
            end do
            den_site(i5_do,i3_do)=-den_site(i5_do,i3_do)/pai
          end do

          if( i_sum_switch == 1 ) then
            den_total_site(i5_do)=0.d0
            do i3_do=i_sum_s,i_sum_e
              level=i_orb_jj(i3_do)
              do i2_do=1,i_orbital(i3_do)
                den_total_site(i5_do)                                                &
                       =den_total_site(i5_do)+dimag(den_c(level+i2_do,level+i2_do))
              end do
            end do
            den_total_site(i5_do)=-den_total_site(i5_do)/pai
          end if

          do i_do=1,input_num
            i2_do=i_orb_jj(mat_ini)+level_temp(i_do)
            do i3_do=1,m_mat_max_m
              temp_com(i3_do)=dcmplx(0.d0,0.d0)
            end do
            do i4_do=i_orb_jj(mat_ini)+1,i_orb_jj(mat_ini)+mat_max+1
              do i3_do=i_orb_jj(mat_ini)+1,i_orb_jj(mat_ini)+mat_max+1
                temp_com(i3_do)=temp_com(i3_do)+den_c(i3_do,i4_do)*ev(i4_do,i2_do)
              end do
            end do
            i1_do=i_orb_jj(mat_ini)+level_temp(i_do)
            do i3_do=i_orb_jj(mat_ini)+1,i_orb_jj(mat_ini)+mat_max+1
              den2_c(i1_do,i2_do)=den2_c(i1_do,i2_do)                              &
                                 +dconjg(ev(i3_do,i1_do))*temp_com(i3_do)
            end do
          end do

          do i1_do=1,input_num
            level=level_temp(i1_do)
            den_temp(i5_do,i1_do)                                                  &
                =-dimag(den2_c(i_orb_jj(mat_ini)+level,i_orb_jj(mat_ini)+level))/pai
          end do

        end do

      close(50)

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

      nfile_strans='pdos'
      call makefilename_out(kp,nfile_strans)
      open(unit=56,file=nfile_strans)
        do i1_do=1,input_num
          level=level_temp(i1_do)
          write(56,*) '**************************************'
          write(56,*) 'level=',level
          write(56,*) '**************************************'
          do i3_do=1,iw_max_gs
            write(56,*) w(i3_do),den_up_temp1(i3_do,i1_do),den_temp(i3_do,i1_do)
          end do
        end do
      close(56)

      if( input_num_site > 0 ) then
        nfile_strans='ldos'
        call makefilename_out(kp,nfile_strans)
        open(unit=57,file=nfile_strans)
          do i1_do=1,input_num_site
            level=l_sss(i1_do)
            write(57,*) '**************************************'
            write(57,*) 'level=',level
            write(57,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(57,*) w(i3_do),den_up_temp2(i3_do,i1_do),den_site(i3_do,i1_do)
            end do
          end do
        close(57)
      end if

      if( i_sum_switch == 1 ) then
        nfile_strans='ldos_suma'
        call makefilename_out(kp,nfile_strans)
        open(unit=55,file=nfile_strans)
          write(55,*) '**************************************'
          do i3_do=1,iw_max_gs
            write(55,*) w(i3_do),den_up_temp3(i3_do),den_total_site(i3_do)
          end do
        close(55)
      end if

      deallocate(den_up_temp1,den_up_temp2,den_up_temp3,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

      if( i_sumk_switch == 1 ) then
        do i1_do=1,input_num
          do i3_do=1,iw_max_gs
            den_sumk_temp1(2,i3_do,i1_do)                                          &
                                =den_sumk_temp1(2,i3_do,i1_do)+den_temp(i3_do,i1_do)
          end do
        end do
        if( input_num_site > 0 ) then
          do i1_do=1,input_num_site
            do i3_do=1,iw_max_gs
              den_sumk_temp2(2,i3_do,i1_do)                                        &
                                =den_sumk_temp2(2,i3_do,i1_do)+den_site(i3_do,i1_do)
            end do
          end do
        end if
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_sumk_temp3(2,i3_do)=den_sumk_temp3(2,i3_do)+den_total_site(i3_do)
          end do
        end if
      end if

      deallocate(h00,s00,hss,sss,eigen_la,ev,den_c,den2_c,temp_com                 &
                ,w,den_temp,den_site,den_total_site,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'de: error allocate2'
        stop
      end if

  100 continue

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

      if( i_sumk_switch == 1 .and. kp == i_sumk_e ) then
        nfile_strans='pdos_sumk.dat'
        open(unit=56,file=nfile_strans)
          do i1_do=1,input_num
            level=level_temp(i1_do)
            write(56,*) '**************************************'
            write(56,*) 'level=',level
            write(56,*) '**************************************'
            if( ispin == 0 ) then
              do i3_do=1,iw_max_gs
                write(56,*) w_temp(i3_do)                                          &
                           ,den_sumk_temp1(1,i3_do,i1_do)/dfloat(i_sumk_e)
              end do
            else
              do i3_do=1,iw_max_gs
                write(56,*) w_temp(i3_do)                                          &
                           ,den_sumk_temp1(1,i3_do,i1_do)/dfloat(i_sumk_e)         &
                           ,den_sumk_temp1(2,i3_do,i1_do)/dfloat(i_sumk_e)
              end do
            end if
          end do
        close(56)

        if( input_num_site > 0 ) then
          nfile_strans='ldos_sumk.dat'
          open(unit=57,file=nfile_strans)
            do i1_do=1,input_num_site
              level=l_sss(i1_do)
              write(57,*) '**************************************'
              write(57,*) 'level=',level
              write(57,*) '**************************************'
              if( ispin == 0 ) then
                do i3_do=1,iw_max_gs
                  write(57,*) w_temp(i3_do)                                        &
                             ,den_sumk_temp2(1,i3_do,i1_do)/dfloat(i_sumk_e)
                end do
              else
                do i3_do=1,iw_max_gs
                  write(57,*) w_temp(i3_do)                                        &
                             ,den_sumk_temp2(1,i3_do,i1_do)/dfloat(i_sumk_e)       &
                             ,den_sumk_temp2(2,i3_do,i1_do)/dfloat(i_sumk_e)
                end do
              end if
            end do
          close(57)
        end if

        if( i_sum_switch == 1 ) then
          nfile_strans='ldos_suma_sumk.dat'
          open(unit=55,file=nfile_strans)
            write(55,*) '**************************************'
            if( ispin == 0 ) then
              do i3_do=1,iw_max_gs
                write(55,*) w_temp(i3_do),den_sumk_temp3(1,i3_do)/dfloat(i_sumk_e)
              end do
            else
              do i3_do=1,iw_max_gs
                write(55,*) w_temp(i3_do),den_sumk_temp3(1,i3_do)/dfloat(i_sumk_e) &
                                         ,den_sumk_temp3(2,i3_do)/dfloat(i_sumk_e)
              end do
            end if
          close(55)
        end if

        deallocate(den_sumk_temp1,den_sumk_temp2,den_sumk_temp3,w_temp,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
      end if

      nfile_strans='level'
      call makefilename_out(kp,nfile_strans)
      open(unit=56,file=nfile_strans)
        do i1_do=1,mat_max
          write(56,*) i1_do,d_eigen(1,i1_do),d_eigen(2,i1_do)
        end do
      close(56)

      deallocate(d_eigen,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'de: pldos'
        stop
      end if

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

  999 format(i10,i10,i10,d28.19,d28.19)

! -------------------------------------------------------------------------------- !
  return
end subroutine pldos
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
subroutine ldos_1
  use para
  implicit none
! -------------------------------------------------------------------------------- !

!                         ---------------------------------                        !
!                         ---------------------------------                        !
!                                        up                                        !
!                         ---------------------------------                        !
!                         ---------------------------------                        !

      write(*,*) 'start calculation_up',input_num,input_num_site

      pai=datan(1.d0)*4.d0

      if( ispin == 0 ) then
        nfile_strans='gfc'
        call makefilename_in(kp,nfile_strans)
      else
        nfile_strans='gfc_up'
        call makefilename_in(kp,nfile_strans)
      end if
      open(unit=50,file=nfile_strans,status='old')

        read(50,*)
        read(50,*)
        read(50,'(a)') buf
        read(buf,*,end=120) iw_max_gs,m_mat_max_m,min_print_site,max_print_site
        go to 121
  120   continue
        read(buf,*) iw_max_gs,m_mat_max_m
        min_print_site=1
        max_print_site=m_mat_max_m
  121   continue

        allocate(den(m_mat_max_m,m_mat_max_m),w(iw_max_gs)                         &
                ,den_site(iw_max_gs,input_num_site),den_total_site(iw_max_gs)      &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        do i3_do=1,input_num_site
          do i2_do=1,iw_max_gs
            den_site(i2_do,i3_do)=0.d0
          end do
        end do

        do i5_do=1,iw_max_gs
          write(6,*) 'now_w',i5_do,'(max=',iw_max_gs,')'

          do i1_do=min_print_site,max_print_site !1,m_mat_max_m
            read(50,*) itemp,w(i5_do)
            do i2_do=min_print_site,max_print_site !1,m_mat_max_m
              read(50,*) itemp,tempr,tempi
!              read(50,*) itemp,tempi
              den(i1_do,i2_do)=tempi
            end do
          end do

          do i3_do=1,input_num_site
            level=i_orb_jj(l_sss(i3_do))
            do i2_do=1,i_orbital(l_sss(i3_do))
              den_site(i5_do,i3_do)                                                &
                       =den_site(i5_do,i3_do)+den(level+i2_do,level+i2_do)
            end do
            den_site(i5_do,i3_do)=-den_site(i5_do,i3_do)/pai
          end do

          if( i_sum_switch == 1 ) then
            den_total_site(i5_do)=0.d0
            do i3_do=i_sum_s,i_sum_e
              level=i_orb_jj(i3_do)
              do i2_do=1,i_orbital(i3_do)
                den_total_site(i5_do)                                                &
                       =den_total_site(i5_do)+den(level+i2_do,level+i2_do)
              end do
            end do
            den_total_site(i5_do)=-den_total_site(i5_do)/pai
          end if

        end do

      close(50)

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

      if( ispin == 0 ) then
        nfile_strans='ldos'
        call makefilename_out(kp,nfile_strans)
        open(unit=55,file=nfile_strans)
          do i1_do=1,input_num_site
            level=l_sss(i1_do)
            write(55,*) '**************************************'
            write(55,*) 'level=',level
            write(55,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(55,*) w(i3_do),den_site(i3_do,i1_do)
            end do
          end do
        close(55)
        if( i_sum_switch == 1 ) then
          nfile_strans='ldos_suma'
          call makefilename_out(kp,nfile_strans)
          open(unit=55,file=nfile_strans)
            write(55,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(55,*) w(i3_do),den_total_site(i3_do)
            end do
          close(55)
        end if
      else
        allocate(den_up_temp2(iw_max_gs,input_num_site),den_up_temp3(iw_max_gs)    &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
        do i1_do=1,input_num_site
          do i3_do=1,iw_max_gs
            den_up_temp2(i3_do,i1_do)=den_site(i3_do,i1_do)
          end do
        end do
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_up_temp3(i3_do)=den_total_site(i3_do)
          end do
        end if
      end if

      if( i_sumk_switch == 1 ) then
        if( kp == i_sumk_s ) then
          allocate(den_sumk_temp2(ispin+1,iw_max_gs,input_num_site)                &
                  ,den_sumk_temp3(ispin+1,iw_max_gs),w_temp(iw_max_gs),stat=ier)
          if( ier /= 0 ) then
            write(*,*) 'error allocate2'
            stop
          end if
          den_sumk_temp2=0.d0
          den_sumk_temp3=0.d0
          do i3_do=1,iw_max_gs
            w_temp(i3_do)=w(i3_do)
          end do
        end if
        do i1_do=1,input_num_site
          do i3_do=1,iw_max_gs
            den_sumk_temp2(1,i3_do,i1_do)                                          &
                              =den_sumk_temp2(1,i3_do,i1_do)+den_site(i3_do,i1_do)
          end do
        end do
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_sumk_temp3(1,i3_do)=den_sumk_temp3(1,i3_do)+den_total_site(i3_do)
          end do
        end if
      end if

      deallocate(den,w,den_site,den_total_site,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

!                         ---------------------------------                        !
!                         ---------------------------------                        !
!                                       down                                       !
!                         ---------------------------------                        !
!                         ---------------------------------                        !

      if( ispin == 0 ) then
        go to 100
      end if

      write(*,*) 'start calculation_do',input_num,input_num_site

      pai=datan(1.d0)*4.d0

      nfile_strans='gfc_do'
      call makefilename_in(kp,nfile_strans)
      open(unit=50,file=nfile_strans,status='old')

        read(50,*)
        read(50,*)
        read(50,'(a)') buf
        read(buf,*,end=122) iw_max_gs,m_mat_max_m,min_print_site,max_print_site
        go to 123
  122   continue
        read(buf,*) iw_max_gs,m_mat_max_m
        min_print_site=1
        max_print_site=m_mat_max_m
  123   continue

        allocate(den(m_mat_max_m,m_mat_max_m),w(iw_max_gs)                         &
                ,den_site(iw_max_gs,input_num_site),den_total_site(iw_max_gs)      &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        do i3_do=1,input_num_site
          do i2_do=1,iw_max_gs
            den_site(i2_do,i3_do)=0.d0
          end do
        end do

        do i5_do=1,iw_max_gs
          write(6,*) 'now_w',i5_do,'(max=',iw_max_gs,')'

          do i1_do=min_print_site,max_print_site !1,m_mat_max_m
            read(50,*) itemp,w(i5_do)
            do i2_do=min_print_site,max_print_site !1,m_mat_max_m
              read(50,*) itemp,tempr,tempi
!              read(50,*) itemp,tempi
              den(i1_do,i2_do)=tempi
            end do
          end do

          do i3_do=1,input_num_site
            level=i_orb_jj(l_sss(i3_do))
            do i2_do=1,i_orbital(l_sss(i3_do))
              den_site(i5_do,i3_do)                                                &
                      =den_site(i5_do,i3_do)+den(level+i2_do,level+i2_do)
            end do
            den_site(i5_do,i3_do)=-den_site(i5_do,i3_do)/pai
          end do

          if( i_sum_switch == 1 ) then
            den_total_site(i5_do)=0.d0
            do i3_do=i_sum_s,i_sum_e
              level=i_orb_jj(i3_do)
              do i2_do=1,i_orbital(i3_do)
                den_total_site(i5_do)                                                &
                       =den_total_site(i5_do)+den(level+i2_do,level+i2_do)
              end do
            end do
            den_total_site(i5_do)=-den_total_site(i5_do)/pai
          end if

        end do

      close(50)

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

      nfile_strans='ldos'
      call makefilename_out(kp,nfile_strans)
      open(unit=57,file=nfile_strans)
        do i1_do=1,input_num_site
          level=l_sss(i1_do)
          write(57,*) '**************************************'
          write(57,*) 'level=',level
          write(57,*) '**************************************'
          do i3_do=1,iw_max_gs
            write(57,*) w(i3_do),den_up_temp2(i3_do,i1_do),den_site(i3_do,i1_do)
          end do
        end do
      close(57)

      if( i_sum_switch == 1 ) then
        nfile_strans='ldos_suma'
        call makefilename_out(kp,nfile_strans)
        open(unit=55,file=nfile_strans)
          write(55,*) '**************************************'
          do i3_do=1,iw_max_gs
            write(55,*) w(i3_do),den_up_temp3(i3_do),den_total_site(i3_do)
          end do
        close(55)
      end if

      if( i_sumk_switch == 1 ) then
        do i1_do=1,input_num_site
          do i3_do=1,iw_max_gs
            den_sumk_temp2(2,i3_do,i1_do)                                          &
                              =den_sumk_temp2(2,i3_do,i1_do)+den_site(i3_do,i1_do)
          end do
        end do
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_sumk_temp3(2,i3_do)=den_sumk_temp3(2,i3_do)+den_total_site(i3_do)
          end do
        end if
      end if

      deallocate(den_up_temp2,den_up_temp3,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

      deallocate(den,w,den_site,den_total_site,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

  100 continue

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

      if( i_sumk_switch == 1 .and. kp == i_sumk_e ) then
        nfile_strans='ldos_sumk.dat'
        open(unit=57,file=nfile_strans)
          do i1_do=1,input_num_site
            level=l_sss(i1_do)
            write(57,*) '**************************************'
            write(57,*) 'level=',level
            write(57,*) '**************************************'
            if( ispin == 0 ) then
              do i3_do=1,iw_max_gs
                write(57,*) w_temp(i3_do)                                          &
                           ,den_sumk_temp2(1,i3_do,i1_do)/dfloat(i_sumk_e)
              end do
            else
              do i3_do=1,iw_max_gs
                write(57,*) w_temp(i3_do)                                          &
                           ,den_sumk_temp2(1,i3_do,i1_do)/dfloat(i_sumk_e)         &
                           ,den_sumk_temp2(2,i3_do,i1_do)/dfloat(i_sumk_e)
              end do
            end if
          end do
        close(57)

        if( i_sum_switch == 1 ) then
          nfile_strans='ldos_suma_sumk.dat'
          open(unit=55,file=nfile_strans)
            write(55,*) '**************************************'
            if( ispin == 0 ) then
              do i3_do=1,iw_max_gs
                write(55,*) w_temp(i3_do),den_sumk_temp3(1,i3_do)/dfloat(i_sumk_e)
              end do
            else
              do i3_do=1,iw_max_gs
                write(55,*) w_temp(i3_do),den_sumk_temp3(1,i3_do)/dfloat(i_sumk_e) &
                                         ,den_sumk_temp3(2,i3_do)/dfloat(i_sumk_e)
              end do
            end if
          close(55)
        end if

        deallocate(den_sumk_temp2,den_sumk_temp3,w_temp,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
      end if

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

  999 format(i10,i10,i10,d28.19,d28.19)

! -------------------------------------------------------------------------------- !
  return
end subroutine ldos_1
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
subroutine ldos_2
  use para
  implicit none
! -------------------------------------------------------------------------------- !

!                         ---------------------------------                        !
!                         ---------------------------------                        !
!                                        up                                        !
!                         ---------------------------------                        !
!                         ---------------------------------                        !

      write(*,*) 'start calculation_up',input_num_site

      pai=datan(1.d0)*4.d0

      if( ispin == 0 ) then
        nfile_strans='gfc'
        call makefilename_in(kp,nfile_strans)
      else
        nfile_strans='gfc_up'
        call makefilename_in(kp,nfile_strans)
      end if
      open(unit=50,file=nfile_strans,status='old')

        read(50,*)
        read(50,*)
        read(50,*) iw_max_gs,m_mat_max_m

        allocate(den(m_mat_max_m,1),w(iw_max_gs)                                   &
                ,den_site(iw_max_gs,input_num_site),den_total_site(iw_max_gs)      &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        den_site=0.d0

        do i5_do=1,iw_max_gs
          write(6,*) 'now_w',i5_do,'(max=',iw_max_gs,')'

          do i1_do=1,m_mat_max_m
            read(50,*) w(i5_do),itemp,tempr,tempi
            den(i1_do,1)=tempi
          end do

          do i3_do=1,input_num_site
            level=i_orb_jj(l_sss(i3_do))
            do i2_do=1,i_orbital(l_sss(i3_do))
              den_site(i5_do,i3_do)                                                &
                       =den_site(i5_do,i3_do)+den(level+i2_do,1)
            end do
            den_site(i5_do,i3_do)=-den_site(i5_do,i3_do)/pai
          end do

          if( i_sum_switch == 1 ) then
            den_total_site(i5_do)=0.d0
            do i3_do=i_sum_s,i_sum_e
              level=i_orb_jj(i3_do)
              do i2_do=1,i_orbital(i3_do)
                den_total_site(i5_do)                                                &
                       =den_total_site(i5_do)+den(level+i2_do,1)
              end do
            end do
            den_total_site(i5_do)=-den_total_site(i5_do)/pai
          end if

        end do

      close(50)

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

      if( ispin == 0 ) then
        nfile_strans='ldos'
        call makefilename_out(kp,nfile_strans)
        open(unit=55,file=nfile_strans)
          do i1_do=1,input_num_site
            level=l_sss(i1_do)
            write(55,*) '**************************************'
            write(55,*) 'level=',level
            write(55,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(55,*) w(i3_do),den_site(i3_do,i1_do)
            end do
          end do
        close(55)
        if( i_sum_switch == 1 ) then
          nfile_strans='ldos_suma'
          call makefilename_out(kp,nfile_strans)
          open(unit=55,file=nfile_strans)
            write(55,*) '**************************************'
            do i3_do=1,iw_max_gs
              write(55,*) w(i3_do),den_total_site(i3_do)
            end do
          close(55)
        end if
      else
        allocate(den_up_temp2(iw_max_gs,input_num_site),den_up_temp3(iw_max_gs)    &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
        do i1_do=1,input_num_site
          do i3_do=1,iw_max_gs
            den_up_temp2(i3_do,i1_do)=den_site(i3_do,i1_do)
          end do
        end do
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_up_temp3(i3_do)=den_total_site(i3_do)
          end do
        end if
      end if

      if( i_sumk_switch == 1 ) then
        if( kp == i_sumk_s ) then
          allocate(den_sumk_temp2(ispin+1,iw_max_gs,input_num_site)                &
                  ,den_sumk_temp3(ispin+1,iw_max_gs),w_temp(iw_max_gs),stat=ier)
          if( ier /= 0 ) then
            write(*,*) 'error allocate2'
            stop
          end if
          den_sumk_temp2=0.d0
          den_sumk_temp3=0.d0
          do i3_do=1,iw_max_gs
            w_temp(i3_do)=w(i3_do)
          end do
        end if
        do i1_do=1,input_num_site
          do i3_do=1,iw_max_gs
            den_sumk_temp2(1,i3_do,i1_do)                                          &
                              =den_sumk_temp2(1,i3_do,i1_do)+den_site(i3_do,i1_do)
          end do
        end do
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_sumk_temp3(1,i3_do)=den_sumk_temp3(1,i3_do)+den_total_site(i3_do)
          end do
        end if
      end if

      deallocate(den,w,den_site,den_total_site,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

!                         ---------------------------------                        !
!                         ---------------------------------                        !
!                                       down                                       !
!                         ---------------------------------                        !
!                         ---------------------------------                        !

      if( ispin == 0 ) then
        go to 100
      end if

      write(*,*) 'start calculation_do',input_num_site

      pai=datan(1.d0)*4.d0

      nfile_strans='gfc_do'
      call makefilename_in(kp,nfile_strans)
      open(unit=50,file=nfile_strans,status='old')

        read(50,*)
        read(50,*)
        read(50,*) iw_max_gs,m_mat_max_m

        allocate(den(m_mat_max_m,1),w(iw_max_gs)                                   &
                ,den_site(iw_max_gs,input_num_site),den_total_site(iw_max_gs)      &
                ,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if

        den_site=0.d0

        do i5_do=1,iw_max_gs
          write(6,*) 'now_w',i5_do,'(max=',iw_max_gs,')'

          do i1_do=1,m_mat_max_m
            read(50,*) w(i5_do),itemp,tempr,tempi
            den(i1_do,1)=tempi
          end do

          do i3_do=1,input_num_site
            level=i_orb_jj(l_sss(i3_do))
            do i2_do=1,i_orbital(l_sss(i3_do))
              den_site(i5_do,i3_do)                                                &
                      =den_site(i5_do,i3_do)+den(level+i2_do,1)
            end do
            den_site(i5_do,i3_do)=-den_site(i5_do,i3_do)/pai
          end do

          if( i_sum_switch == 1 ) then
            den_total_site(i5_do)=0.d0
            do i3_do=i_sum_s,i_sum_e
              level=i_orb_jj(i3_do)
              do i2_do=1,i_orbital(i3_do)
                den_total_site(i5_do)                                                &
                       =den_total_site(i5_do)+den(level+i2_do,1)
              end do
            end do
            den_total_site(i5_do)=-den_total_site(i5_do)/pai
          end if

        end do

      close(50)

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

      nfile_strans='ldos'
      call makefilename_out(kp,nfile_strans)
      open(unit=57,file=nfile_strans)
        do i1_do=1,input_num_site
          level=l_sss(i1_do)
          write(57,*) '**************************************'
          write(57,*) 'level=',level
          write(57,*) '**************************************'
          do i3_do=1,iw_max_gs
            write(57,*) w(i3_do),den_up_temp2(i3_do,i1_do),den_site(i3_do,i1_do)
          end do
        end do
      close(57)

      if( i_sum_switch == 1 ) then
        nfile_strans='ldos_suma'
        call makefilename_out(kp,nfile_strans)
        open(unit=55,file=nfile_strans)
          write(55,*) '**************************************'
          do i3_do=1,iw_max_gs
            write(55,*) w(i3_do),den_up_temp3(i3_do),den_total_site(i3_do)
          end do
        close(55)
      end if

      if( i_sumk_switch == 1 ) then
        do i1_do=1,input_num_site
          do i3_do=1,iw_max_gs
            den_sumk_temp2(2,i3_do,i1_do)                                          &
                              =den_sumk_temp2(2,i3_do,i1_do)+den_site(i3_do,i1_do)
          end do
        end do
        if( i_sum_switch == 1 ) then
          do i3_do=1,iw_max_gs
            den_sumk_temp3(2,i3_do)=den_sumk_temp3(2,i3_do)+den_total_site(i3_do)
          end do
        end if
      end if

      deallocate(den_up_temp2,den_up_temp3,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

      deallocate(den,w,den_site,den_total_site,stat=ier)
      if( ier /= 0 ) then
        write(*,*) 'error allocate2'
        stop
      end if

  100 continue

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

      if( i_sumk_switch == 1 .and. kp == i_sumk_e ) then
        nfile_strans='ldos_sumk.dat'
        open(unit=57,file=nfile_strans)
          do i1_do=1,input_num_site
            level=l_sss(i1_do)
            write(57,*) '**************************************'
            write(57,*) 'level=',level
            write(57,*) '**************************************'
            if( ispin == 0 ) then
              do i3_do=1,iw_max_gs
                write(57,*) w_temp(i3_do)                                          &
                           ,den_sumk_temp2(1,i3_do,i1_do)/dfloat(i_sumk_e)
              end do
            else
              do i3_do=1,iw_max_gs
                write(57,*) w_temp(i3_do)                                          &
                           ,den_sumk_temp2(1,i3_do,i1_do)/dfloat(i_sumk_e)         &
                           ,den_sumk_temp2(2,i3_do,i1_do)/dfloat(i_sumk_e)
              end do
            end if
          end do
        close(57)

        if( i_sum_switch == 1 ) then
          nfile_strans='ldos_suma_sumk.dat'
          open(unit=55,file=nfile_strans)
            write(55,*) '**************************************'
            if( ispin == 0 ) then
              do i3_do=1,iw_max_gs
                write(55,*) w_temp(i3_do),den_sumk_temp3(1,i3_do)/dfloat(i_sumk_e)
              end do
            else
              do i3_do=1,iw_max_gs
                write(55,*) w_temp(i3_do),den_sumk_temp3(1,i3_do)/dfloat(i_sumk_e) &
                                         ,den_sumk_temp3(2,i3_do)/dfloat(i_sumk_e)
              end do
            end if
          close(55)
        end if

        deallocate(den_sumk_temp2,den_sumk_temp3,w_temp,stat=ier)
        if( ier /= 0 ) then
          write(*,*) 'error allocate2'
          stop
        end if
      end if

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

  999 format(i10,i10,i10,d28.19,d28.19)

! -------------------------------------------------------------------------------- !
  return
end subroutine ldos_2
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
subroutine makefilename_in(kt,nfile_strans)

  implicit none
    integer, intent(in) :: kt
   ! character(50), intent(in) :: name
    character(105), 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_in
! ******************************************************************************** !
subroutine makefilename_out(kt,nfile_strans)

  implicit none
    integer, intent(in) :: kt
   ! character(50), intent(in) :: name
    character(105), 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)//'.dat'

! -------------------------------------------------------------------------------- !
    return
end subroutine makefilename_out
! ******************************************************************************** !
! ******************************************************************************** !
! ******************************************************************************** !
