libtetrabz_dbldelta_mod Module Reference

Functions/Subroutines
subroutine, public	libtetrabz_dbldelta (ltetra, bvec, nb, nge, eig1, eig2, ngw, wght, comm)
subroutine	libtetrabz_dbldelta_main (wlsm, nt_local, ik_global, ik_local, nb, nkBZ, eig1, eig2, nk_local, dbldelta)
subroutine	libtetrabz_dbldelta2 (nb, ej, w)

Function/Subroutine Documentation

libtetrabz_dbldelta()

subroutine, public libtetrabz_dbldelta_mod::libtetrabz_dbldelta	(	integer(c_int), intent(in)	ltetra,
		real(c_double), dimension(9), intent(in)	bvec,
		integer(c_int), intent(in)	nb,
		integer(c_int), dimension(3), intent(in)	nge,
		real(c_double), dimension(nb,product(nge(1:3))), intent(in)	eig1,
		real(c_double), dimension(nb,product(nge(1:3))), intent(in)	eig2,
		integer(c_int), dimension(3), intent(in)	ngw,
		real(c_double), dimension(nb*nb,product(ngw(1:3))), intent(out)	wght,
		integer(c_int), intent(in), optional	comm
	)

Definition at line 35 of file libtetrabz_dbldelta_mod.F90.

  !
  USE iso_c_binding
  USE libtetrabz_common, ONLY : libtetrabz_initialize, libtetrabz_interpol_indx, libtetrabz_mpisum_dv
  IMPLICIT NONE
  !
  INTEGER(C_INT),INTENT(IN) :: ltetra, nb, nge(3), ngw(3)
  REAL(C_DOUBLE),INTENT(IN) :: bvec(9), eig1(nb,PRODUCT(nge(1:3))), eig2(nb,PRODUCT(nge(1:3)))
  REAL(C_DOUBLE),INTENT(OUT) :: wght(nb*nb,PRODUCT(ngw(1:3)))
  INTEGER(C_INT),INTENT(IN),OPTIONAL :: comm
  !
  LOGICAL :: linterpol
  INTEGER :: nt_local, nk_local, nkBZ, ik, kintp(8)
  INTEGER,ALLOCATABLE :: ik_global(:,:), ik_local(:,:)
  REAL(8) :: wlsm(4,20), wintp(1,8)
  REAL(8),ALLOCATABLE :: wghtd(:,:,:), kvec(:,:)
  !
  IF(PRESENT(comm)) THEN
     CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
     &                          nt_local,nkbz,ik_global,ik_local,kvec,comm)
  ELSE
     CALL libtetrabz_initialize(ltetra,nge,ngw,bvec,linterpol,wlsm,nk_local,&
     &                          nt_local,nkbz,ik_global,ik_local,kvec)
  END IF
  !
  IF(linterpol) THEN
     !
     ALLOCATE(wghtd(nb*nb,1,nk_local))
     CALL libtetrabz_dbldelta_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig1,eig2,nk_local,wghtd)
     !
     ! Interpolation
     !
     wght(1:nb*nb,1:product(ngw(1:3))) = 0d0
     DO ik = 1, nk_local
        CALL libtetrabz_interpol_indx(ngw,kvec(1:3,ik),kintp,wintp)
        wght(1:nb*nb,kintp(1:8)) = wght(1:nb*nb,             kintp(1:8)) &
        &                + matmul(wghtd(1:nb*nb,1:1,ik), wintp(1:1,1:8))
     END DO ! ik = 1, nk_local
     DEALLOCATE(wghtd, kvec)
     !
     IF(PRESENT(comm)) CALL libtetrabz_mpisum_dv(comm, nb*nb*product(ngw(1:3)), wght)
     !
  ELSE
     CALL libtetrabz_dbldelta_main(wlsm,nt_local,ik_global,ik_local,nb,nkbz,eig1,eig2,nk_local,wght)
  END IF
  !
  DEALLOCATE(ik_global, ik_local)
  !

References libtetrabz_dbldelta_main(), libtetrabz_common::libtetrabz_initialize(), libtetrabz_common::libtetrabz_interpol_indx(), and libtetrabz_common::libtetrabz_mpisum_dv().

Here is the call graph for this function:

libtetrabz_dbldelta_main()

subroutine libtetrabz_dbldelta_mod::libtetrabz_dbldelta_main	(	real(8), dimension(4,20), intent(in)	wlsm,
		integer, intent(in)	nt_local,
		integer, dimension(20,nt_local), intent(in)	ik_global,
		integer, dimension(20,nt_local), intent(in)	ik_local,
		integer, intent(in)	nb,
		integer, intent(in)	nkBZ,
		real(8), dimension(nb,nkbz), intent(in)	eig1,
		real(8), dimension(nb,nkbz), intent(in)	eig2,
		integer, intent(in)	nk_local,
		real(8), dimension(nb,nb,nk_local), intent(out)	dbldelta
	)

Definition at line 87 of file libtetrabz_dbldelta_mod.F90.

  !
  USE libtetrabz_common, ONLY : libtetrabz_sort, &
  &                             libtetrabz_triangle_a1, libtetrabz_triangle_b1, &
  &                             libtetrabz_triangle_b2, libtetrabz_triangle_c1
  IMPLICIT NONE
  !
  INTEGER,INTENT(IN) :: nt_local, nb, nkBZ, nk_local, &
  &                     ik_global(20,nt_local), ik_local(20,nt_local)
  REAL(8),INTENT(IN) :: wlsm(4,20), eig1(nb,nkBZ), eig2(nb,nkBZ)
  REAL(8),INTENT(OUT) :: dbldelta(nb,nb,nk_local)
  !
  INTEGER :: ib, indx(4), it
  REAL(8) :: e(4), ei1(4,nb), ej1(4,nb), ej2(3,nb), V, thr = 1d-10, &
  &          tsmall(3,4), w1(nb,4), w2(nb,3)
  !
  dbldelta(1:nb,1:nb,1:nk_local) = 0d0
  !
  !$OMP PARALLEL DEFAULT(NONE) &
  !$OMP & SHARED(dbldelta,eig1,eig2,ik_global,ik_local,nb,nt_local,thr,wlsm) &
  !$OMP & PRIVATE(e,ei1,ej1,ej2,ib,indx,it,tsmall,V,w1,w2)
  !
  DO it = 1, nt_local
     !
     DO ib = 1, nb
        ei1(1:4,ib) = matmul(wlsm(1:4,1:20), eig1(ib, ik_global(1:20,it)))
        ej1(1:4,ib) = matmul(wlsm(1:4,1:20), eig2(ib, ik_global(1:20,it)))
     END DO
     !
     !$OMP DO
     DO ib = 1, nb
        !
        w1(1:nb,1:4) = 0d0
        e(1:4) = ei1(1:4, ib)
        CALL libtetrabz_sort(4,e,indx)
        !
        IF(e(1) < 0d0 .AND. 0d0 <= e(2)) THEN
           !
           CALL libtetrabz_triangle_a1(e,v,tsmall)
           !
           IF(v > thr) THEN
              !
              ej2(1:3,1:nb) = matmul(tsmall(1:3,1:4), ej1(indx(1:4),1:nb))
              CALL libtetrabz_dbldelta2(nb,ej2,w2)
              w1(1:nb,indx(1:4)) = w1(1:nb,            indx(1:4)) &
              &       + v * matmul(w2(1:nb,1:3), tsmall(1:3,1:4))
              !
           END IF
           !
        ELSE IF( e(2) < 0d0 .AND. 0d0 <= e(3)) THEN
           !
           CALL libtetrabz_triangle_b1(e,v,tsmall)
           !
           IF(v > thr) THEN
              !
              ej2(1:3,1:nb) = matmul(tsmall(1:3,1:4), ej1(indx(1:4),1:nb))
              CALL libtetrabz_dbldelta2(nb,ej2,w2)
              w1(1:nb,indx(1:4)) = w1(1:nb,            indx(1:4)) &
              &       + v * matmul(w2(1:nb,1:3), tsmall(1:3,1:4))
              !
           END IF
           !
           CALL libtetrabz_triangle_b2(e,v,tsmall)
           !
           IF(v > thr) THEN
              !
              ej2(1:3,1:nb) = matmul(tsmall(1:3,1:4), ej1(indx(1:4),1:nb))
              CALL libtetrabz_dbldelta2(nb,ej2,w2)
              w1(1:nb,indx(1:4)) = w1(1:nb,            indx(1:4)) &
              &       + v * matmul(w2(1:nb,1:3), tsmall(1:3,1:4))
              !
           END IF
           !
        ELSE IF(e(3) < 0d0 .AND. 0d0 < e(4)) THEN
           !
           CALL libtetrabz_triangle_c1(e,v,tsmall)
           !
           IF(v > thr) THEN
              !
              ej2(1:3,1:nb) = matmul(tsmall(1:3,1:4), ej1(indx(1:4),1:nb))
              CALL libtetrabz_dbldelta2(nb,ej2,w2)
              w1(1:nb,indx(1:4)) = w1(1:nb,            indx(1:4)) &
              &       + v * matmul(w2(1:nb,1:3), tsmall(1:3,1:4))
              !
           END IF
           !
        END IF
        !
        dbldelta(1:nb,ib,ik_local(1:20,it)) = dbldelta(1:nb,ib,   ik_local(1:20,it)) &
        &                                  + matmul(w1(1:nb,1:4), wlsm(1:4,1:20))
        !
     END DO ! ib
     !$OMP END DO NOWAIT
     !
  END DO ! it
  !
  !$OMP END PARALLEL
  !
  dbldelta(1:nb,1:nb,1:nk_local) = dbldelta(1:nb,1:nb,1:nk_local) / dble(6 * nkbz)
  !

References libtetrabz_dbldelta2(), libtetrabz_common::libtetrabz_sort(), libtetrabz_common::libtetrabz_triangle_a1(), libtetrabz_common::libtetrabz_triangle_b1(), libtetrabz_common::libtetrabz_triangle_b2(), and libtetrabz_common::libtetrabz_triangle_c1().

Referenced by libtetrabz_dbldelta().

Here is the call graph for this function:

Here is the caller graph for this function:

libtetrabz_dbldelta2()

subroutine libtetrabz_dbldelta_mod::libtetrabz_dbldelta2	(	integer, intent(in)	nb,
		real(8), dimension(3,nb), intent(in)	ej,
		real(8), dimension(nb,3), intent(inout)	w
	)

Definition at line 191 of file libtetrabz_dbldelta_mod.F90.

  !
  USE libtetrabz_common, ONLY : libtetrabz_sort
  IMPLICIT NONE
  !
  INTEGER,INTENT(IN) :: nb
  REAL(8),INTENT(IN) :: ej(3,nb)
  REAL(8),INTENT(INOUT) :: w(nb,3)
  !
  INTEGER :: ib, ii, indx(3)
  REAL(8) :: a(3,3), e(3), V
  !
  DO ib = 1, nb
     !
     IF(maxval(abs(ej(1:3,ib))) < 1d-10) stop "Nesting !!"
     !
     w(ib,1:3) = 0d0
     e(1:3) = ej(1:3, ib)
     CALL libtetrabz_sort(3,e,indx)
     !
     DO ii = 1, 3
        a(1:3,ii) = (0d0 - e(ii)) / (e(1:3) - e(ii))
     END DO
     !
     IF((e(1) < 0d0 .AND. 0d0 <= e(2)) .OR. (e(1) <= 0d0 .AND. 0d0 < e(2))) THEN
        !
        !V = a(2,1) * a(3,1) / (0d0 - e(1)) 
        v = a(2,1)           / (e(3) - e(1)) 
        !
        w(ib,indx(1)) = v * (a(1,2) + a(1,3))
        w(ib,indx(2)) = v * a(2,1)
        w(ib,indx(3)) = v * a(3,1)
        !
     ELSE IF((e(2) <= 0d0 .AND. 0d0 < e(3)) .OR. (e(2) < 0d0 .AND. 0d0 <= e(3))) THEN
        !
        !V = a(1,3) * a(2,3) / (e(3) - 0d0) 
        v = a(2,3)           / (e(3) - e(1)) 
        !
        w(ib,indx(1)) = v * a(1,3)
        w(ib,indx(2)) = v * a(2,3)
        w(ib,indx(3)) = v * (a(3,1) + a(3,2))
        !
     END IF
     !
  END DO ! ib
  !

References libtetrabz_common::libtetrabz_sort().

Referenced by libtetrabz_dbldelta_main().

Here is the call graph for this function:

Here is the caller graph for this function: