Commit 3dda18cc authored by Matthias Redies's avatar Matthias Redies

tests show run through like this

parent 790265bf
......@@ -80,9 +80,8 @@ CONTAINS
! COMPLEX :: a(nvd,0:lmd,natd,kpts%nkpt),b(nvd,0:lmd,natd,kpts%nkpt)
TYPE(t_lapw) :: lapw(kpts%nkptf)
TYPE(t_usdus) :: usdus
CALL usdus%init(atoms, input%jspins)
CALL hybdat%usdus%init(atoms, input%jspins)
CALL zhlp%alloc(zmat(1)%l_real, zmat(1)%matsize1, zmat(1)%matsize2)
! setup rotations in reciprocal space
......@@ -123,32 +122,32 @@ CONTAINS
ng = atoms%jri(itype)
DO l = 0, atoms%lmax(itype)
CALL radfun(l, itype, jsp, el_eig(l, itype), vr(:, itype, jsp), &
atoms, u(:, :, l), du(:, :, l), usdus, nodem, noded, wronk)
atoms, u(:, :, l), du(:, :, l), hybdat%usdus, nodem, noded, wronk)
IF (mpi%irank == 0) WRITE (6, FMT=8010) l, el_eig(l, itype), &
usdus%us(l, itype, jsp), usdus%dus(l, itype, jsp),&
nodem, usdus%uds(l, itype, jsp), usdus%duds(l, itype, jsp),&
noded, usdus%ddn(l, itype, jsp), wronk
hybdat%usdus%us(l, itype, jsp), hybdat%usdus%dus(l, itype, jsp),&
nodem, hybdat%usdus%uds(l, itype, jsp), hybdat%usdus%duds(l, itype, jsp),&
noded, hybdat%usdus%ddn(l, itype, jsp), wronk
hybdat%bas1(1:ng, 1, l, itype) = u(1:ng, 1, l)
hybdat%bas2(1:ng, 1, l, itype) = u(1:ng, 2, l)
hybdat%bas1(1:ng, 2, l, itype) = du(1:ng, 1, l)
hybdat%bas2(1:ng, 2, l, itype) = du(1:ng, 2, l)
hybdat%bas1_MT(1, l, itype) = usdus%us(l, itype, jsp)
hybdat%drbas1_MT(1, l, itype) = usdus%dus(l, itype, jsp)
hybdat%bas1_MT(2, l, itype) = usdus%uds(l, itype, jsp)
hybdat%drbas1_MT(2, l, itype) = usdus%duds(l, itype, jsp)
hybdat%bas1_MT(1, l, itype) = hybdat%usdus%us(l, itype, jsp)
hybdat%drbas1_MT(1, l, itype) = hybdat%usdus%dus(l, itype, jsp)
hybdat%bas1_MT(2, l, itype) = hybdat%usdus%uds(l, itype, jsp)
hybdat%drbas1_MT(2, l, itype) = hybdat%usdus%duds(l, itype, jsp)
END DO
IF (atoms%nlo(itype) >= 1) THEN
CALL radflo(atoms, itype, jsp, ello_eig, vr(:, itype, jsp), u, du, mpi, usdus, uuilon, duilon, ulouilopn, flo)
CALL radflo(atoms, itype, jsp, ello_eig, vr(:, itype, jsp), u, du, mpi, hybdat%usdus, uuilon, duilon, ulouilopn, flo)
DO ilo = 1, atoms%nlo(itype)
iarr(atoms%llo(ilo, itype), itype) = iarr(atoms%llo(ilo, itype), itype) + 1
hybdat%bas1(1:ng, iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = flo(1:ng, 1, ilo)
hybdat%bas2(1:ng, iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = flo(1:ng, 2, ilo)
hybdat%bas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = usdus%ulos(ilo, itype, jsp)
hybdat%drbas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = usdus%dulos(ilo, itype, jsp)
hybdat%bas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = hybdat%usdus%ulos(ilo, itype, jsp)
hybdat%drbas1_MT(iarr(atoms%llo(ilo, itype), itype), atoms%llo(ilo, itype), itype) = hybdat%usdus%dulos(ilo, itype, jsp)
END DO
END IF
END DO
......@@ -185,7 +184,7 @@ CONTAINS
! abcof calculates the wavefunction coefficients
! stored in acof,bcof,ccof
lapw(ikpt0)%nmat = lapw(ikpt0)%nv(jsp) + atoms%nlotot
CALL abcof(input, atoms, sym, cell, lapw(ikpt0), hybdat%nbands(ikpt0), usdus, noco, jsp, &!hybdat%kveclo_eig(:,ikpt0),&
CALL abcof(input, atoms, sym, cell, lapw(ikpt0), hybdat%nbands(ikpt0), hybdat%usdus, noco, jsp, &!hybdat%kveclo_eig(:,ikpt0),&
oneD, acof(:hybdat%nbands(ikpt0), :, :), bcof(:hybdat%nbands(ikpt0), :, :), &
ccof(:, :hybdat%nbands(ikpt0), :, :), zmat(ikpt0))
......
......@@ -5,53 +5,92 @@
!--------------------------------------------------------------------------------
MODULE m_types_usdus
TYPE t_usdus
REAL,ALLOCATABLE,DIMENSION(:,:,:) CPP_MANAGED :: us
REAL,ALLOCATABLE,DIMENSION(:,:,:) CPP_MANAGED :: dus
REAL,ALLOCATABLE,DIMENSION(:,:,:) CPP_MANAGED :: uds
REAL,ALLOCATABLE,DIMENSION(:,:,:) CPP_MANAGED :: duds !(0:lmaxd,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:) CPP_MANAGED :: ddn !(0:lmaxd,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ulos
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulos
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: uulon
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: dulon ! (nlod,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: uloulopn ! (nlod,nlod,ntypd,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: uuilon
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: duilon ! (nlod,ntype,jspd)
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: ulouilopn ! (nlod,nlod,ntypd,jspd)
TYPE t_usdus
REAL, ALLOCATABLE, DIMENSION(:, :, :) CPP_MANAGED :: us
REAL, ALLOCATABLE, DIMENSION(:, :, :) CPP_MANAGED :: dus
REAL, ALLOCATABLE, DIMENSION(:, :, :) CPP_MANAGED :: uds
REAL, ALLOCATABLE, DIMENSION(:, :, :) CPP_MANAGED :: duds !(0:lmaxd,ntype,jspd)
REAL, ALLOCATABLE, DIMENSION(:, :, :) CPP_MANAGED :: ddn !(0:lmaxd,ntype,jspd)
REAL, ALLOCATABLE, DIMENSION(:, :, :) :: ulos
REAL, ALLOCATABLE, DIMENSION(:, :, :) :: dulos
REAL, ALLOCATABLE, DIMENSION(:, :, :) :: uulon
REAL, ALLOCATABLE, DIMENSION(:, :, :) :: dulon ! (nlod,ntype,jspd)
REAL, ALLOCATABLE, DIMENSION(:, :, :, :) :: uloulopn ! (nlod,nlod,ntypd,jspd)
REAL, ALLOCATABLE, DIMENSION(:, :, :) :: uuilon
REAL, ALLOCATABLE, DIMENSION(:, :, :) :: duilon ! (nlod,ntype,jspd)
REAL, ALLOCATABLE, DIMENSION(:, :, :, :) :: ulouilopn ! (nlod,nlod,ntypd,jspd)
CONTAINS
PROCEDURE :: init => usdus_init
END TYPE t_usdus
PROCEDURE :: init => usdus_init
PROCEDURE :: free => usdus_free
END TYPE t_usdus
CONTAINS
SUBROUTINE usdus_init(ud,atoms,jsp)
USE m_judft
USE m_types_setup
IMPLICIT NONE
CLASS(t_usdus) :: ud
TYPE(t_atoms),INTENT(IN) :: atoms
INTEGER,INTENT(IN) :: jsp
INTEGER :: err(13)
ALLOCATE ( ud%uloulopn(atoms%nlod,atoms%nlod,atoms%ntype,jsp),stat=err(1) )
ALLOCATE ( ud%ddn(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(2) )
ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(3))
ALLOCATE ( ud%uds(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(4) )
ALLOCATE ( ud%dus(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(5))
ALLOCATE ( ud%duds(0:atoms%lmaxd,atoms%ntype,jsp),stat=err(6))
ALLOCATE ( ud%ulos(atoms%nlod,atoms%ntype,jsp ),stat=err(7))
ALLOCATE (ud%dulos(atoms%nlod,atoms%ntype,jsp ),stat=err(8) )
ALLOCATE (ud%uulon(atoms%nlod,atoms%ntype,jsp ),stat=err(9))
ALLOCATE (ud%dulon(atoms%nlod,atoms%ntype,jsp) ,stat=err(10))
ALLOCATE (ud%uuilon(atoms%nlod,atoms%ntype,jsp),stat=err(11))
ALLOCATE (ud%duilon(atoms%nlod,atoms%ntype,jsp),stat=err(12))
ALLOCATE (ud%ulouilopn(atoms%nlod,atoms%nlod,atoms%ntype,jsp),stat=err(13))
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating usdus datatype")
END SUBROUTINE usdus_init
SUBROUTINE usdus_init(ud, atoms, jsp)
USE m_judft
USE m_types_setup
IMPLICIT NONE
CLASS(t_usdus) :: ud
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT(IN) :: jsp
INTEGER :: err(13)
err = 0
if(.not. allocated(ud%uloulopn)) &
allocate(ud%uloulopn(atoms%nlod, atoms%nlod, atoms%ntype, jsp), stat=err(1))
if(.not. allocated(ud%ddn)) &
allocate(ud%ddn(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(2))
if(.not. allocated(ud%us)) &
allocate(ud%us(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(3))
if(.not. allocated(ud%uds)) &
allocate(ud%uds(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(4))
if(.not. allocated(ud%dus)) &
allocate(ud%dus(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(5))
if(.not. allocated(ud%duds)) &
allocate(ud%duds(0:atoms%lmaxd, atoms%ntype, jsp), stat=err(6))
if(.not. allocated(ud%ulos)) &
allocate(ud%ulos(atoms%nlod, atoms%ntype, jsp), stat=err(7))
if(.not. allocated(ud%dulos)) &
allocate(ud%dulos(atoms%nlod, atoms%ntype, jsp), stat=err(8))
if(.not. allocated(ud%uulon)) &
allocate(ud%uulon(atoms%nlod, atoms%ntype, jsp), stat=err(9))
if(.not. allocated(ud%dulon)) &
allocate(ud%dulon(atoms%nlod, atoms%ntype, jsp), stat=err(10))
if(.not. allocated(ud%uuilon)) &
allocate(ud%uuilon(atoms%nlod, atoms%ntype, jsp), stat=err(11))
if(.not. allocated(ud%duilon)) &
allocate(ud%duilon(atoms%nlod, atoms%ntype, jsp), stat=err(12))
if(.not. allocated(ud%ulouilopn)) &
allocate(ud%ulouilopn(atoms%nlod, atoms%nlod, atoms%ntype, jsp), stat=err(13))
write (*,*) "err array", err
IF(ANY(err > 0)) CALL judft_error("Not enough memory allocating usdus datatype")
ud%uloulopn = 0; ud%ddn = 0; ud%us = 0
ud%uds = 0; ud%dus = 0; ud%duds = 0
ud%ulos = 0; ud%dulos = 0; ud%uulon = 0
ud%dulon = 0; ud%uuilon = 0; ud%duilon = 0
ud%ulouilopn = 0
END SUBROUTINE usdus_init
SUBROUTINE usdus_free(ud)
IMPLICIT NONE
CLASS(t_usdus) :: ud
if(allocated(ud%uloulopn)) deallocate(ud%uloulopn)
if(allocated(ud%ddn)) deallocate(ud%ddn)
if(allocated(ud%us)) deallocate(ud%us)
if(allocated(ud%uds)) deallocate(ud%uds)
if(allocated(ud%dus)) deallocate(ud%dus)
if(allocated(ud%duds)) deallocate(ud%duds)
if(allocated(ud%ulos)) deallocate(ud%ulos)
if(allocated(ud%dulos)) deallocate(ud%dulos)
if(allocated(ud%uulon)) deallocate(ud%uulon)
if(allocated(ud%dulon)) deallocate(ud%dulon)
if(allocated(ud%uuilon)) deallocate(ud%uuilon)
if(allocated(ud%duilon)) deallocate(ud%duilon)
if(allocated(ud%ulouilopn)) deallocate(ud%ulouilopn)
END SUBROUTINE usdus_free
END MODULE m_types_usdus
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment