nstm3.f90 4.31 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
MODULE m_nstm3
  USE m_juDFT
  !***********************************************************************
  !     included writing to vacwave!
  !     set up mapping array to general G_parallel(j)=(gvac1(j),gvac2(j))
  !             for vacuum density in order to write out information
  !             on electronic structure for calculation of tunneling current    
  !                            change by shz, Jan.99
  !
  !***********************************************************************
CONTAINS
  SUBROUTINE nstm3(&
       &                 sym,atoms,vacuum,stars,ikpt,nv,&
       &                 input,jspin,kpts,&
       &                 cell,wk,k1,k2,&
       &                 evac,vz,vz0,&
       &                 gvac1d,gvac2d)
    !
    USE m_sort
    USE m_types
    IMPLICIT NONE

    TYPE(t_input),INTENT(IN)    :: input
    TYPE(t_vacuum),INTENT(IN)   :: vacuum
    TYPE(t_sym),INTENT(IN)      :: sym
    TYPE(t_stars),INTENT(IN)    :: stars
    TYPE(t_cell),INTENT(IN)     :: cell
    TYPE(t_kpts),INTENT(IN)     :: kpts
    TYPE(t_atoms),INTENT(IN)    :: atoms
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: ikpt,nv      
    INTEGER, INTENT (IN) :: jspin      
    REAL,    INTENT (IN) :: wk 
    !     ..
    !     .. Array  Arguments ..
    INTEGER, INTENT (IN) :: k1(:),k2(:)
    REAL,    INTENT (IN) :: evac(2)
    REAL,    INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2)
    REAL,    INTENT (IN) :: vz0(2) 
    INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d)
    !     ..
    !     .. Local Scalars
    INTEGER n2,k,j,i,ivac
    REAL    dz0
    !     ..
    !     .. Local Arrays ..
    INTEGER gvac1(SIZE(gvac1d)),gvac2(SIZE(gvac1d)),gindex(SIZE(gvac1d))
    REAL gvacl(SIZE(gvac1d)),gvac(2)
    !     ..
    !
    IF (ikpt.EQ.1) THEN
       n2 = 0
       k_loop: DO  k = 1,nv
          DO j = 1,n2
             IF (k1(k).EQ.gvac1(j).AND.k2(k).EQ.gvac2(j)) THEN
                CYCLE k_loop
             END IF
          ENDDO
          n2 = n2 + 1
          gvac1(n2) = k1(k)
          gvac2(n2) = k2(k)
          DO i=1,2
             gvac(i)=k1(k)*cell%bmat(1,i)+k2(k)*cell%bmat(2,i)
          END DO
          gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2))
       ENDDO k_loop
       CALL sort(n2,gvacl,gindex)
       DO j = 1,n2
          !  gvac1d, gvac2d are now ordered by increasing length
          gvac1d(j)=gvac1(gindex(j))
          gvac2d(j)=gvac2(gindex(j))
       END DO
       ! 
       IF (jspin.EQ.1) THEN
          WRITE (87,'(f10.6,1x,i1,1x,f10.6)') vacuum%tworkf,input%jspins,cell%area
          WRITE (87,'(2(f10.6,1x))') cell%amat(1,1), cell%amat(2,1)
          WRITE (87,'(2(f10.6,1x))') cell%amat(1,2), cell%amat(2,2)
          WRITE (87,'(2(f10.6,1x))') cell%bmat(1,1), cell%bmat(2,1)
          WRITE (87,'(2(f10.6,1x))') cell%bmat(1,2), cell%bmat(2,2)
          WRITE (87,'(i2)') sym%nop2
          DO j = 1, sym%nop2
             WRITE (87,'(i2,1x,i2)') sym%mrot(1,1,j), sym%mrot(1,2,j)
             WRITE (87,'(i2,1x,i2)') sym%mrot(2,1,j), sym%mrot(2,2,j)
          END DO
          WRITE (87,'(i3)') n2
          DO j = 1,n2
             WRITE (87,'(3(i3,1x),f10.6)') j, gvac1(gindex(j)), &
                  &              gvac2(gindex(j)),gvacl(gindex(j))
          END DO
          !
          !     Write info on 2D-starfunctions

94 95
          WRITE (87,'(i2,1x,i2,1x,i2)') stars%mx1,stars%mx2, stars%ng2
          DO i=1, stars%ng2
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
             WRITE (87,'(i2)') stars%nstr2(i)
          END DO
          DO i=-stars%mx1, stars%mx1
             DO j=-stars%mx2,stars%mx2
                WRITE (87,'(i2,1x,e12.4)') stars%ig2(stars%ig(i,j,0)),stars%rgphs(i,j,0)
             END DO
          END DO
       END IF
       WRITE (87,'(i1,1x,i1)') jspin, vacuum%nvac
       WRITE (87,'(2(e16.8,1x))') (evac(i), i=1,vacuum%nvac)
       WRITE (87,'(2(e16.8,1x))') (vz0(i), i=1,vacuum%nvac)
       dz0=0.0
       DO i=1, atoms%nat
          IF (ABS(atoms%taual(3,i)).GT.dz0) dz0=ABS(atoms%taual(3,i))
       END DO
       dz0=cell%z1-dz0*cell%amat(3,3)
       WRITE (87,'(i3,1x,f6.4,1x,f12.6)') vacuum%nmz,vacuum%delz,dz0   
       DO ivac=1,vacuum%nvac
          DO i=1, vacuum%nmz
             WRITE (87,'(e16.8)') vz(i,ivac)
          END DO
       END DO
       WRITE (87,'(i4)') kpts%nkpt
    END IF

    !  only write here if not on T3E


    WRITE (87,'(i3,1x,f12.6)') ikpt,wk

  END SUBROUTINE nstm3
END MODULE m_nstm3