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,& & 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) 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 WRITE (87,'(i2,1x,i2,1x,i2)') stars%mx1,stars%mx2, stars%ng2 DO i=1, stars%ng2 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))') (vz(vacuum%nmz,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