Commit b95ec6b1 authored by Matthias Redies's avatar Matthias Redies

replace array of type with type of array

parent ac1c5cc0
......@@ -187,8 +187,18 @@ CONTAINS
IF (ok /= 0) call judft_error('eigen_hf: failure allocation basprod')
ALLOCATE (hybdat%prodm(hybrid%maxindxm1, hybrid%maxindxp1, 0:hybrid%maxlcutm1, atoms%ntype), stat=ok)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%prodm')
ALLOCATE (hybdat%prod(hybrid%maxindxp1, 0:hybrid%maxlcutm1, atoms%ntype), stat=ok)
IF (ok /= 0) call judft_error('eigen_hf: failure allocation hybdat%prod')
! allocate prod arrays
ALLOCATE (hybdat%prod%l1(hybrid%maxindxp1, 0:hybrid%maxlcutm1, atoms%ntype), stat=ok)
IF (ok /= 0) call judft_error('hf_setup: failure allocation hybdat%prod%l1')
ALLOCATE (hybdat%prod%l2, mold=hybdat%prod%l1, stat=ok)
IF (ok /= 0) call judft_error('hf_setup: failure allocation hybdat%prod%l2')
ALLOCATE (hybdat%prod%n1, mold=hybdat%prod%l1, stat=ok)
IF (ok /= 0) call judft_error('hf_setup: failure allocation hybdat%prod%n1')
ALLOCATE (hybdat%prod%n2, mold=hybdat%prod%l1, stat=ok)
IF (ok /= 0) call judft_error('hf_setup: failure allocation hybdat%prod%n2')
basprod = 0; hybdat%prodm = 0; hybdat%prod%l1 = 0; hybdat%prod%l2 = 0
hybdat%prod%n1 = 0; hybdat%prod%n2 = 0
ALLOCATE (hybdat%nindxp1(0:hybrid%maxlcutm1, atoms%ntype))
......@@ -211,10 +221,10 @@ CONTAINS
IF (MOD(l1 + l2 + l, 2) == 0) THEN
hybdat%nindxp1(l, itype) = hybdat%nindxp1(l, itype) + 1
n = hybdat%nindxp1(l, itype)
hybdat%prod(n, l, itype)%l1 = l1
hybdat%prod(n, l, itype)%l2 = l2
hybdat%prod(n, l, itype)%n1 = n1
hybdat%prod(n, l, itype)%n2 = n2
hybdat%prod%l1(n,l,itype) = l1
hybdat%prod%l2(n,l,itype) = l2
hybdat%prod%n1(n,l,itype) = n1
hybdat%prod%n2(n,l,itype) = n2
DO i = 1, hybrid%nindxm1(l, itype)
hybdat%prodm(i, n, l, itype) = intgrf(basprod(:ng)*hybrid%basm1(:ng, i, l, itype), atoms%jri, &
atoms%jmtd, atoms%rmsh, atoms%dx, atoms%ntype, itype, hybdat%gridf)
......
......@@ -390,10 +390,10 @@ CONTAINS
DO n = 1, hybdat%nindxp1(l, itype)
! determine l1,p1 and l2,p2 for the basis functions, which can generate l
l1 = hybdat%prod(n, l, itype)%l1
l2 = hybdat%prod(n, l, itype)%l2
p1 = hybdat%prod(n, l, itype)%n1
p2 = hybdat%prod(n, l, itype)%n2
l1 = hybdat%prod%l1(n,l,itype)
l2 = hybdat%prod%l2(n,l,itype)
p1 = hybdat%prod%n1(n,l,itype)
p2 = hybdat%prod%n2(n,l,itype)
! condition for Gaunt coefficients
IF (mod(l + l1 + l2, 2) /= 0) CYCLE
......@@ -511,10 +511,10 @@ CONTAINS
DO n = 1, hybdat%nindxp1(l, itype)
! determine l1,p1 and l2,p2 for the basis functions, which can generate l
l1 = hybdat%prod(n, l, itype)%l1
l2 = hybdat%prod(n, l, itype)%l2
p1 = hybdat%prod(n, l, itype)%n1
p2 = hybdat%prod(n, l, itype)%n2
l1 = hybdat%prod%l1(n,l,itype)
l2 = hybdat%prod%l2(n,l,itype)
p1 = hybdat%prod%n1(n,l,itype)
p2 = hybdat%prod%n2(n,l,itype)
! condition for Gaunt coefficients
IF (mod(l + l1 + l2, 2) /= 0) CYCLE
......
......@@ -263,10 +263,10 @@ CONTAINS
DO l = 0, hybrid%lcutm1(itype)
DO n = 1, hybdat%nindxp1(l, itype) ! loop over basis-function products
l1 = hybdat%prod(n, l, itype)%l1 !
l2 = hybdat%prod(n, l, itype)%l2 ! current basis-function product
n1 = hybdat%prod(n, l, itype)%n1 ! = bas(:,n1,l1,itype)*bas(:,n2,l2,itype) = b1*b2
n2 = hybdat%prod(n, l, itype)%n2 !
l1 = hybdat%prod%l1(n,l,itype) !
l2 = hybdat%prod%l2(n,l,itype) ! current basis-function product
n1 = hybdat%prod%n1(n,l,itype) ! = bas(:,n1,l1,itype)*bas(:,n2,l2,itype) = b1*b2
n2 = hybdat%prod%n2(n,l,itype) !
IF (mod(l1 + l2 + l, 2) == 0) THEN
offdiag = (l1 /= l2) .or. (n1 /= n2) ! offdiag=true means that b1*b2 and b2*b1 are different combinations
......
......@@ -452,7 +452,12 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,sliceplot,cell,atoms,enpara,stars
IF(ALLOCATED(hybdat%pntgptd)) DEALLOCATE (hybdat%pntgptd)
IF(ALLOCATED(hybdat%pntgpt)) DEALLOCATE (hybdat%pntgpt)
IF(ALLOCATED(hybdat%prodm)) DEALLOCATE (hybdat%prodm)
IF(ALLOCATED(hybdat%prod)) DEALLOCATE (hybdat%prod)
IF(ALLOCATED(hybdat%prod%l1)) DEALLOCATE (hybdat%prod%l1)
IF(ALLOCATED(hybdat%prod%l2)) DEALLOCATE (hybdat%prod%l2)
IF(ALLOCATED(hybdat%prod%n1)) DEALLOCATE (hybdat%prod%n1)
IF(ALLOCATED(hybdat%prod%n2)) DEALLOCATE (hybdat%prod%n2)
IF(ALLOCATED(hybdat%nindxp1)) DEALLOCATE (hybdat%nindxp1)
results%neig(:,:) = neigTemp(:,:)
......
......@@ -41,7 +41,10 @@ MODULE m_types_hybrid
END TYPE t_hybrid
TYPE t_prodtype
INTEGER :: l1, l2, n1, n2
INTEGER, ALLOCATABLE :: l1(:, :, :)
INTEGER, ALLOCATABLE :: l2(:, :, :)
INTEGER, ALLOCATABLE :: n1(:, :, :)
INTEGER, ALLOCATABLE :: n2(:, :, :)
END TYPE t_prodtype
TYPE t_hybdat
......@@ -58,7 +61,7 @@ MODULE m_types_hybrid
REAL, ALLOCATABLE :: bas1(:, :, :, :), bas2(:, :, :, :) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: bas1_MT(:, :, :), drbas1_MT(:, :, :) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: prodm(:, :, :, :) !alloc in eigen_HF_setup
TYPE(t_PRODTYPE), ALLOCATABLE :: prod(:, :, :) !alloc in eigen_HF_setup
TYPE(t_PRODTYPE) :: prod !alloc in eigen_HF_setup
INTEGER, ALLOCATABLE :: pntgptd(:) !alloc in eigen_HF_setup
INTEGER, ALLOCATABLE :: pntgpt(:, :, :, :) !alloc in eigen_HF_setup
INTEGER, ALLOCATABLE :: nindxp1(:, :)
......
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