Commit 46513357 authored by Daniel Wortmann's avatar Daniel Wortmann

Fixes for PGI compiler

parent 6944db54
...@@ -18,7 +18,7 @@ set(fleur_F90 ${fleur_F90} ...@@ -18,7 +18,7 @@ set(fleur_F90 ${fleur_F90}
hybrid/add_Vnonlocal.F90 hybrid/add_Vnonlocal.F90
hybrid/hf_setup.F90 hybrid/hf_setup.F90
hybrid/kp_perturbation.f90 hybrid/kp_perturbation.f90
hybrid/symm_hf.f90 hybrid/symm_hf.F90
hybrid/trafo.F90 hybrid/trafo.F90
hybrid/exponential_integral.f90 hybrid/exponential_integral.f90
hybrid/hsefunctional.F90 hybrid/hsefunctional.F90
......
module m_omp_checker module m_omp_checker
contains contains
subroutine omp_checker() subroutine omp_checker()
use omp_lib use omp_lib
use m_judft use m_judft
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
implicit none implicit none
#ifndef __PGI
interface interface
function findmycpu() bind(c) function findmycpu() bind(c)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer(kind=c_int) :: findmycpu integer(kind=c_int) :: findmycpu
...@@ -33,13 +33,14 @@ contains ...@@ -33,13 +33,14 @@ contains
do i = 1,size(cpu) do i = 1,size(cpu)
if(count(cpu(i) == cpu) /= 1) then if(count(cpu(i) == cpu) /= 1) then
WRITE(*,*) "The OMP parallelism seems to be weird" WRITE(*,*) "The OMP parallelism seems to be weird"
WRITE(*,*) "Multiple OMPs on one core: There are " // int2str(count(cpu(i) == cpu)) // & WRITE(*,*) "Multiple OMPs on one core: There are " // int2str(count(cpu(i) == cpu)) // &
" on cpu " // int2str(cpu(i)) " on cpu " // int2str(cpu(i))
WRITE(6,*) "The OMP parallelism seems to be weird" WRITE(6,*) "The OMP parallelism seems to be weird"
WRITE(6,*) "Multiple OMPs on one core: There are " // int2str(count(cpu(i) == cpu)) // & WRITE(6,*) "Multiple OMPs on one core: There are " // int2str(count(cpu(i) == cpu)) // &
" on cpu " // int2str(cpu(i)) " on cpu " // int2str(cpu(i))
exit exit
endif endif
enddo enddo
#endif
end subroutine omp_checker end subroutine omp_checker
end module m_omp_checker end module m_omp_checker
#include <sched.h> #include <sched.h>
#ifndef __PGI
int sched_getcpu(); int sched_getcpu();
int findmycpu() int findmycpu()
...@@ -7,3 +7,4 @@ int findmycpu() ...@@ -7,3 +7,4 @@ int findmycpu()
int cpu = sched_getcpu(); int cpu = sched_getcpu();
return cpu; return cpu;
} }
#endif
...@@ -12,7 +12,7 @@ types/types_xcpot_inbuild_nofunction.F90 ...@@ -12,7 +12,7 @@ types/types_xcpot_inbuild_nofunction.F90
types/types_xcpot_data.F90 types/types_xcpot_data.F90
types/types_xcpot_libxc.F90 types/types_xcpot_libxc.F90
types/types_mpi.F90 types/types_mpi.F90
types/types_hybmpi.f90 types/types_hybmpi.F90
types/types_lapw.F90 types/types_lapw.F90
types/types_enpara.F90 types/types_enpara.F90
types/types_tlmplm.F90 types/types_tlmplm.F90
......
...@@ -8,7 +8,7 @@ MODULE m_types_hybmpi ...@@ -8,7 +8,7 @@ MODULE m_types_hybmpi
INTEGER :: comm INTEGER :: comm
INTEGER :: rank INTEGER :: rank
INTEGER :: size INTEGER :: size
type(t_hybmpi), allocatable :: subcomm type(t_hybmpi), pointer :: subcomm
contains contains
procedure :: copy_mpi => t_hybmpi_copy_mpi procedure :: copy_mpi => t_hybmpi_copy_mpi
procedure :: barrier => t_hybmpi_barrier procedure :: barrier => t_hybmpi_barrier
...@@ -33,7 +33,7 @@ contains ...@@ -33,7 +33,7 @@ contains
integer, intent(in) :: color integer, intent(in) :: color
integer, intent(in), optional :: key integer, intent(in), optional :: key
integer :: ierr, use_key integer :: ierr, use_key
#ifdef CPP_MPI
use_key = MERGE(key, hybmpi%rank, present(key)) use_key = MERGE(key, hybmpi%rank, present(key))
allocate(hybmpi%subcomm) allocate(hybmpi%subcomm)
call MPI_Comm_split(hybmpi%comm, color, use_key, hybmpi%subcomm, ierr) call MPI_Comm_split(hybmpi%comm, color, use_key, hybmpi%subcomm, ierr)
...@@ -44,6 +44,7 @@ contains ...@@ -44,6 +44,7 @@ contains
call MPI_comm_size(hybmpi%subcomm, hybmpi%subcomm%size, ierr) call MPI_comm_size(hybmpi%subcomm, hybmpi%subcomm%size, ierr)
if(ierr /= 0) call judft_error("MPI sizing failed") if(ierr /= 0) call judft_error("MPI sizing failed")
#endif
end subroutine t_hybmpi_split end subroutine t_hybmpi_split
subroutine t_hybmpi_barrier(hybmpi) subroutine t_hybmpi_barrier(hybmpi)
...@@ -51,9 +52,10 @@ contains ...@@ -51,9 +52,10 @@ contains
implicit none implicit none
class(t_hybmpi), intent(inout) :: hybmpi class(t_hybmpi), intent(inout) :: hybmpi
integer :: ierr integer :: ierr
#ifdef CPP_MPI
call MPI_Barrier(hybmpi%comm, ierr) call MPI_Barrier(hybmpi%comm, ierr)
if(ierr /= 0) call juDFT_error("barrier failed on process: " // & if(ierr /= 0) call juDFT_error("barrier failed on process: " // &
int2str(hybmpi%rank)) int2str(hybmpi%rank))
#endif
end subroutine t_hybmpi_barrier end subroutine t_hybmpi_barrier
END MODULE m_types_hybmpi END MODULE m_types_hybmpi
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