LCOV - code coverage report
Current view: top level - dos - nstm3.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 53 0.0 %
Date: 2019-09-08 04:53:50 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             :     USE m_types_lapw
      18             :     USE m_types_kpts
      19             :     IMPLICIT NONE
      20             : 
      21             :     TYPE(t_input),INTENT(IN)    :: input
      22             :     TYPE(t_vacuum),INTENT(IN)   :: vacuum
      23             :     TYPE(t_sym),INTENT(IN)      :: sym
      24             :     TYPE(t_stars),INTENT(IN)    :: stars
      25             :     TYPE(t_lapw),INTENT(IN)     :: lapw
      26             :     TYPE(t_cell),INTENT(IN)     :: cell
      27             :     TYPE(t_kpts),INTENT(IN)     :: kpts
      28             :     TYPE(t_atoms),INTENT(IN)    :: atoms
      29             :     !     ..
      30             :     !     .. Scalar Arguments ..
      31             :     INTEGER, INTENT (IN) :: ikpt   
      32             :     INTEGER, INTENT (IN) :: jspin      
      33             :     !     ..
      34             :     !     .. Array  Arguments ..
      35             :     REAL,    INTENT (IN) :: evac(2)
      36             :     REAL,    INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2)
      37             :     INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d)
      38             :     !     ..
      39             :     !     .. Local Scalars
      40             :     INTEGER n2,k,j,i,ivac
      41             :     REAL    dz0
      42             :     !     ..
      43             :     !     .. Local Arrays ..
      44           0 :     INTEGER gvac1(SIZE(gvac1d)),gvac2(SIZE(gvac1d)),gindex(SIZE(gvac1d))
      45           0 :     REAL gvacl(SIZE(gvac1d)),gvac(2)
      46             :     !     ..
      47             :     !
      48           0 :     IF (ikpt.EQ.1) THEN
      49           0 :        n2 = 0
      50           0 :        k_loop: DO  k = 1,lapw%nv(jspin)
      51           0 :           DO j = 1,n2
      52           0 :              IF (lapw%k1(k,jspin).EQ.gvac1(j).AND.lapw%k2(k,jspin).EQ.gvac2(j)) THEN
      53             :                 CYCLE k_loop
      54             :              END IF
      55             :           ENDDO
      56           0 :           n2 = n2 + 1
      57           0 :           gvac1(n2) = lapw%k1(k,jspin)
      58           0 :           gvac2(n2) = lapw%k2(k,jspin)
      59           0 :           DO i=1,2
      60           0 :              gvac(i)=lapw%k1(k,jspin)*cell%bmat(1,i)+lapw%k2(k,jspin)*cell%bmat(2,i)
      61             :           END DO
      62           0 :           gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2))
      63             :        ENDDO k_loop
      64           0 :        CALL sort(gindex(:n2),gvacl)
      65           0 :        DO j = 1,n2
      66             :           !  gvac1d, gvac2d are now ordered by increasing length
      67           0 :           gvac1d(j)=gvac1(gindex(j))
      68           0 :           gvac2d(j)=gvac2(gindex(j))
      69             :        END DO
      70             :        ! 
      71           0 :        IF (jspin.EQ.1) THEN
      72           0 :           WRITE (87,'(f10.6,1x,i1,1x,f10.6)') vacuum%tworkf,input%jspins,cell%area
      73           0 :           WRITE (87,'(2(f10.6,1x))') cell%amat(1,1), cell%amat(2,1)
      74           0 :           WRITE (87,'(2(f10.6,1x))') cell%amat(1,2), cell%amat(2,2)
      75           0 :           WRITE (87,'(2(f10.6,1x))') cell%bmat(1,1), cell%bmat(2,1)
      76           0 :           WRITE (87,'(2(f10.6,1x))') cell%bmat(1,2), cell%bmat(2,2)
      77           0 :           WRITE (87,'(i2)') sym%nop2
      78           0 :           DO j = 1, sym%nop2
      79           0 :              WRITE (87,'(i2,1x,i2)') sym%mrot(1,1,j), sym%mrot(1,2,j)
      80           0 :              WRITE (87,'(i2,1x,i2)') sym%mrot(2,1,j), sym%mrot(2,2,j)
      81             :           END DO
      82           0 :           WRITE (87,'(i3)') n2
      83           0 :           DO j = 1,n2
      84           0 :              WRITE (87,'(3(i3,1x),f10.6)') j, gvac1(gindex(j)), &
      85           0 :                   &              gvac2(gindex(j)),gvacl(gindex(j))
      86             :           END DO
      87             :           !
      88             :           !     Write info on 2D-starfunctions
      89             : 
      90           0 :           WRITE (87,'(i2,1x,i2,1x,i2)') stars%mx1,stars%mx2, stars%ng2
      91           0 :           DO i=1, stars%ng2
      92           0 :              WRITE (87,'(i2)') stars%nstr2(i)
      93             :           END DO
      94           0 :           DO i=-stars%mx1, stars%mx1
      95           0 :              DO j=-stars%mx2,stars%mx2
      96           0 :                 WRITE (87,'(i2,1x,e12.4)') stars%ig2(stars%ig(i,j,0)),stars%rgphs(i,j,0)
      97             :              END DO
      98             :           END DO
      99             :        END IF
     100           0 :        WRITE (87,'(i1,1x,i1)') jspin, vacuum%nvac
     101           0 :        WRITE (87,'(2(e16.8,1x))') (evac(i), i=1,vacuum%nvac)
     102           0 :        WRITE (87,'(2(e16.8,1x))') (vz(vacuum%nmz,i), i=1,vacuum%nvac)
     103           0 :        dz0=0.0
     104           0 :        DO i=1, atoms%nat
     105           0 :           IF (ABS(atoms%taual(3,i)).GT.dz0) dz0=ABS(atoms%taual(3,i))
     106             :        END DO
     107           0 :        dz0=cell%z1-dz0*cell%amat(3,3)
     108           0 :        WRITE (87,'(i3,1x,f6.4,1x,f12.6)') vacuum%nmz,vacuum%delz,dz0   
     109           0 :        DO ivac=1,vacuum%nvac
     110           0 :           DO i=1, vacuum%nmz
     111           0 :              WRITE (87,'(e16.8)') vz(i,ivac)
     112             :           END DO
     113             :        END DO
     114           0 :        WRITE (87,'(i4)') kpts%nkpt
     115             :     END IF
     116             : 
     117             :     !  only write here if not on T3E
     118             : 
     119             : 
     120           0 :     WRITE (87,'(i3,1x,f12.6)') ikpt,kpts%wtkpt(ikpt)
     121             : 
     122           0 :   END SUBROUTINE nstm3
     123             : END MODULE m_nstm3

Generated by: LCOV version 1.13