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