LCOV - code coverage report
Current view: top level - propcalc/dos - nstm3.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 0 51 0.0 %
Date: 2024-05-15 04:28:08 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_nstm3
       2             :   USE m_juDFT
       3             :   !***********************************************************************
       4             :   !     included writing to vacwave!
       5             :   !     set up mapping array to general G_parallel(j)=(gvac1(j),gvac2(j))
       6             :   !             for vacuum density in order to write out information
       7             :   !             on electronic structure for calculation of tunneling current
       8             :   !                            change by shz, Jan.99
       9             :   !
      10             :   !***********************************************************************
      11             : CONTAINS
      12           0 :   SUBROUTINE nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,&
      13           0 :                    cell,evac,vz,gvac1d,gvac2d)
      14             : 
      15             :     USE m_sort
      16             :     USE m_types_setup
      17             : 
      18             :     USE m_types_lapw
      19             :     USE m_types_kpts
      20             :     IMPLICIT NONE
      21             : 
      22             :     TYPE(t_input),INTENT(IN)    :: input
      23             :     TYPE(t_vacuum),INTENT(IN)   :: vacuum
      24             :     TYPE(t_sym),INTENT(IN)      :: sym
      25             :     TYPE(t_stars),INTENT(IN)    :: stars
      26             :     TYPE(t_lapw),INTENT(IN)     :: lapw
      27             :     TYPE(t_cell),INTENT(IN)     :: cell
      28             :     TYPE(t_kpts),INTENT(IN)     :: kpts
      29             :     TYPE(t_atoms),INTENT(IN)    :: atoms
      30             :     !     ..
      31             :     !     .. Scalar Arguments ..
      32             :     INTEGER, INTENT (IN) :: ikpt
      33             :     INTEGER, INTENT (IN) :: jspin
      34             :     !     ..
      35             :     !     .. Array  Arguments ..
      36             :     REAL,    INTENT (IN) :: evac(2)
      37             :     REAL,    INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2)
      38             :     INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(lapw%dim_nv2d())
      39             :     !     ..
      40             :     !     .. Local Scalars
      41             :     INTEGER n2,k,j,i,ivac
      42             :     REAL    dz0
      43             :     !     ..
      44             :     !     .. Local Arrays ..
      45           0 :     INTEGER gvac1(SIZE(gvac1d)),gvac2(SIZE(gvac1d)),gindex(SIZE(gvac1d))
      46           0 :     REAL gvacl(SIZE(gvac1d)),gvac(2)
      47             :     !     ..
      48             :     !
      49           0 :     IF (ikpt.EQ.1) THEN
      50           0 :        n2 = 0
      51           0 :        k_loop: DO  k = 1,lapw%nv(jspin)
      52           0 :           DO j = 1,n2
      53           0 :              IF (lapw%k1(k,jspin).EQ.gvac1(j).AND.lapw%k2(k,jspin).EQ.gvac2(j)) THEN
      54             :                 CYCLE k_loop
      55             :              END IF
      56             :           ENDDO
      57           0 :           n2 = n2 + 1
      58           0 :           gvac1(n2) = lapw%k1(k,jspin)
      59           0 :           gvac2(n2) = lapw%k2(k,jspin)
      60           0 :           DO i=1,2
      61           0 :              gvac(i)=lapw%k1(k,jspin)*cell%bmat(1,i)+lapw%k2(k,jspin)*cell%bmat(2,i)
      62             :           END DO
      63           0 :           gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2))
      64             :        ENDDO k_loop
      65           0 :        CALL sort(gindex(:n2),gvacl)
      66           0 :        DO j = 1,n2
      67             :           !  gvac1d, gvac2d are now ordered by increasing length
      68           0 :           gvac1d(j)=gvac1(gindex(j))
      69           0 :           gvac2d(j)=gvac2(gindex(j))
      70             :        END DO
      71             :        !
      72           0 :        IF (jspin.EQ.1) THEN
      73             : !          WRITE (87,'(f10.6,1x,i1,1x,f10.6)') banddos%tworkf,input%jspins,cell%area
      74           0 :           WRITE (87,'(2(f10.6,1x))') cell%amat(1,1), cell%amat(2,1)
      75           0 :           WRITE (87,'(2(f10.6,1x))') cell%amat(1,2), cell%amat(2,2)
      76           0 :           WRITE (87,'(2(f10.6,1x))') cell%bmat(1,1), cell%bmat(2,1)
      77           0 :           WRITE (87,'(2(f10.6,1x))') cell%bmat(1,2), cell%bmat(2,2)
      78           0 :           WRITE (87,'(i2)') sym%nop2
      79           0 :           DO j = 1, sym%nop2
      80           0 :              WRITE (87,'(i2,1x,i2)') sym%mrot(1,1,j), sym%mrot(1,2,j)
      81           0 :              WRITE (87,'(i2,1x,i2)') sym%mrot(2,1,j), sym%mrot(2,2,j)
      82             :           END DO
      83           0 :           WRITE (87,'(i3)') n2
      84           0 :           DO j = 1,n2
      85           0 :              WRITE (87,'(3(i3,1x),f10.6)') j, gvac1(gindex(j)), &
      86           0 :                   &              gvac2(gindex(j)),gvacl(gindex(j))
      87             :           END DO
      88             :           !
      89             :           !     Write info on 2D-starfunctions
      90             : 
      91           0 :           WRITE (87,'(i2,1x,i2,1x,i2)') stars%mx1,stars%mx2, stars%ng2
      92           0 :           DO i=1, stars%ng2
      93           0 :              WRITE (87,'(i2)') stars%nstr2(i)
      94             :           END DO
      95           0 :           DO i=-stars%mx1, stars%mx1
      96           0 :              DO j=-stars%mx2,stars%mx2
      97             :                 !WRITE (87,'(i2,1x,e12.4)') stars%ig2(stars%ig(i,j,0)),stars%rgphs(i,j,0)
      98             :              END DO
      99             :           END DO
     100             :        END IF
     101           0 :        WRITE (87,'(i1,1x,i1)') jspin, vacuum%nvac
     102           0 :        WRITE (87,'(2(e16.8,1x))') (evac(i), i=1,vacuum%nvac)
     103           0 :        WRITE (87,'(2(e16.8,1x))') (vz(vacuum%nmz,i), i=1,vacuum%nvac)
     104           0 :        dz0=0.0
     105           0 :        DO i=1, atoms%nat
     106           0 :           IF (ABS(atoms%taual(3,i)).GT.dz0) dz0=ABS(atoms%taual(3,i))
     107             :        END DO
     108           0 :        dz0=cell%z1-dz0*cell%amat(3,3)
     109           0 :        WRITE (87,'(i3,1x,f6.4,1x,f12.6)') vacuum%nmz,vacuum%delz,dz0
     110           0 :        DO ivac=1,vacuum%nvac
     111           0 :           DO i=1, vacuum%nmz
     112           0 :              WRITE (87,'(e16.8)') vz(i,ivac)
     113             :           END DO
     114             :        END DO
     115           0 :        WRITE (87,'(i4)') kpts%nkpt
     116             :     END IF
     117             : 
     118             :     !  only write here if not on T3E
     119             : 
     120             : 
     121           0 :     WRITE (87,'(i3,1x,f12.6)') ikpt,kpts%wtkpt(ikpt)
     122             : 
     123           0 :   END SUBROUTINE nstm3
     124             : END MODULE m_nstm3

Generated by: LCOV version 1.14