Skip to content

GitLab

fleur
fleur
Commit 046cb70b authored by Matthias Redies's avatar Matthias Redies
Browse files
Options

merge develop

parents 81708430 73bbd502
Hide whitespace changes
Inline Side-by-side
Showing with 189 additions and 81 deletions
.gitlab-ci.yml
View file @ 046cb70b
......@@ -123,7 +123,7 @@ build-intel:
- build.intel.debug
script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -d -l intel INTEL_MPI ; cd build.intel.debug; make -j 4
- cd /builds/fleur/fleur; CC=gcc FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -d -l intel INTEL_MPI ; cd build.intel.debug; make -j 4
only:
- schedules
- triggers
......
io/cdnpot_io_hdf.F90
View file @ 046cb70b
......@@ -1946,9 +1946,10 @@ MODULE m_cdnpot_io_hdf
SUBROUTINE writePotentialHDF(input, fileID, archiveName, potentialType,&
starsIndex, latharmsIndex, structureIndex,stepfunctionIndex,&
iter,fr,fpw,fz,fzxy)
iter,pot,fpw)
TYPE(t_input), INTENT(IN) :: input
TYPE(t_potden), INTENT(IN) :: pot
INTEGER(HID_T), INTENT(IN) :: fileID
INTEGER, INTENT(IN) :: potentialType
INTEGER, INTENT(IN) :: starsIndex, latharmsIndex, structureIndex
......@@ -1957,10 +1958,7 @@ MODULE m_cdnpot_io_hdf
INTEGER, INTENT (IN) :: iter
REAL, INTENT (IN) :: fr(:,:,:,:)
REAL, INTENT (IN) :: fz(:,:,:)
COMPLEX, INTENT (IN) :: fpw(:,:)
COMPLEX, INTENT (IN) :: fzxy(:,:,:,:)
INTEGER :: ntype,jmtd,nmzd,nmzxyd,nlhd,ng3,ng2
INTEGER :: nmz, nvac, od_nq2, nmzxy
......@@ -2070,7 +2068,7 @@ MODULE m_cdnpot_io_hdf
dimsInt(:4)=(/jmtd,nlhd+1,ntype,input%jspins/)
CALL h5dopen_f(groupID, 'fr', frSetID, hdfError)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),fr)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),pot%mt)
CALL h5dclose_f(frSetID, hdfError)
dimsInt(:3)=(/2,ng3,input%jspins/)
......@@ -2081,12 +2079,12 @@ MODULE m_cdnpot_io_hdf
IF (l_film) THEN
dimsInt(:3)=(/nmzd,2,input%jspins/)
CALL h5dopen_f(groupID, 'fz', fzSetID, hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),fz)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),pot%vacz(:,:,:input%jspins))
CALL h5dclose_f(fzSetID, hdfError)
dimsInt(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
CALL h5dopen_f(groupID, 'fzxy', fzxySetID, hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxy)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),pot%vacxy(:,:,:,:input%jspins))
CALL h5dclose_f(fzxySetID, hdfError)
END IF
......@@ -2099,7 +2097,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(4,dims(:4),frSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fr", H5T_NATIVE_DOUBLE, frSpaceID, frSetID, hdfError)
CALL h5sclose_f(frSpaceID,hdfError)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),fr)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),pot%mt)
CALL h5dclose_f(frSetID, hdfError)
dims(:3)=(/2,ng3,input%jspins/)
......@@ -2116,7 +2114,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(3,dims(:3),fzSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fz", H5T_NATIVE_DOUBLE, fzSpaceID, fzSetID, hdfError)
CALL h5sclose_f(fzSpaceID,hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),fz)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),pot%vacz(:,:,:input%jspins))
CALL h5dclose_f(fzSetID, hdfError)
dims(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
......@@ -2124,7 +2122,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(5,dims(:5),fzxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "fzxy", H5T_NATIVE_DOUBLE, fzxySpaceID, fzxySetID, hdfError)
CALL h5sclose_f(fzxySpaceID,hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxy)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),pot%vacxy(:,:,:,:input%jspins))
CALL h5dclose_f(fzxySetID, hdfError)
END IF
......@@ -2149,7 +2147,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(4,dims(:4),frSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fr", H5T_NATIVE_DOUBLE, frSpaceID, frSetID, hdfError)
CALL h5sclose_f(frSpaceID,hdfError)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),fr)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),pot%mt)
CALL h5dclose_f(frSetID, hdfError)
dims(:3)=(/2,ng3,input%jspins/)
......@@ -2166,7 +2164,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(3,dims(:3),fzSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fz", H5T_NATIVE_DOUBLE, fzSpaceID, fzSetID, hdfError)
CALL h5sclose_f(fzSpaceID,hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),fz)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),pot%vacz(:,:,:input%jspins))
CALL h5dclose_f(fzSetID, hdfError)
dims(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
......@@ -2174,7 +2172,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(5,dims(:5),fzxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "fzxy", H5T_NATIVE_DOUBLE, fzxySpaceID, fzxySetID, hdfError)
CALL h5sclose_f(fzxySpaceID,hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxy)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),pot%vacxy(:,:,:,:input%jspins))
CALL h5dclose_f(fzxySetID, hdfError)
END IF
......
io/pot_io.F90
View file @ 046cb70b
......@@ -160,23 +160,23 @@ MODULE m_pot_io
END SUBROUTINE readPotential
SUBROUTINE writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
iter,fr,fpw,fz,fzxy)
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
iter,pot,fpw)
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_potden), INTENT(INOUT) :: pot
INTEGER, INTENT (IN) :: iter
INTEGER, INTENT (IN) :: archiveType
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: fpw(stars%ng3,input%jspins), fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (IN) :: fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins), fz(vacuum%nmzd,2,input%jspins)
COMPLEX, INTENT (IN) :: fpw(stars%ng3,input%jspins)
! local variables
INTEGER :: mode, iUnit
......@@ -191,9 +191,6 @@ MODULE m_pot_io
INTEGER :: potentialType
CHARACTER(LEN=30) :: archiveName
REAL :: fzTemp(vacuum%nmzd,2,input%jspins)
COMPLEX :: fzxyTemp(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
CALL getMode(mode)
IF(mode.EQ.POT_HDF5_MODE) THEN
......@@ -218,19 +215,17 @@ MODULE m_pot_io
potentialType = POTENTIAL_TYPE_IN_const
fzTemp(:,:,:) = fz(:,:,:)
fzxyTemp(:,:,:,:) = fzxy(:,:,:,:)
IF(vacuum%nvac.EQ.1) THEN
fzTemp(:,2,:)=fzTemp(:,1,:)
pot%vacz(:,2,:) = pot%vacz(:,1,:)
IF (sym%invs) THEN
fzxyTemp(:,:,2,:) = CONJG(fzxyTemp(:,:,1,:))
pot%vacxy(:,:,2,:) = CONJG(pot%vacxy(:,:,1,:))
ELSE
fzxyTemp(:,:,2,:) = fzxyTemp(:,:,1,:)
pot%vacxy(:,:,2,:) = pot%vacxy(:,:,1,:)
END IF
END IF
CALL writePotentialHDF(input, fileID, archiveName, potentialType,&
currentStarsIndex, currentLatharmsIndex, currentStructureIndex,&
currentStepfunctionIndex,iter,fr,fpw,fzTemp,fzxyTemp)
currentStepfunctionIndex,iter,pot,fpw)
IF(l_storeIndices) THEN
CALL writePOTHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
......@@ -258,7 +253,7 @@ MODULE m_pot_io
iUnit = 11
OPEN (iUnit,file=TRIM(ADJUSTL(filename)),form='unformatted',status='unknown')
CALL wrtdop(stars,vacuum,atoms,sphhar,input,sym,&
iUnit,iter,fr,fpw,fz,fzxy)
iUnit,iter,pot%mt,fpw,pot%vacz(:,:,:input%jspins),pot%vacxy(:,:,:,:input%jspins))
CLOSE(iUnit)
END IF
......
io/writeBasis.F90
View file @ 046cb70b
......@@ -38,9 +38,9 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI
TYPE(t_atoms),INTENT(INOUT) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_potden), INTENT(IN) :: vCoul
TYPE(t_potden), INTENT(IN) :: vx
TYPE(t_potden), INTENT(INOUT) :: vTot
TYPE(t_potden), INTENT(INOUT) :: vCoul
TYPE(t_potden), INTENT(INOUT) :: vx
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_results), INTENT(INOUT):: results
INTEGER, INTENT(IN) :: eig_id
......@@ -631,9 +631,9 @@ SUBROUTINE writeBasis(input,noco,kpts,atoms,sym,cell,enpara,vTot,vCoul,vx,mpi,DI
END DO
CALL h5fclose_f(fileID, hdfError)
!-------------------------write potential--------------------
CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_TOT_const,vTot%iter,vTot%mt,vTot%pw_w,vTot%vacz,vTot%vacxy)
CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_COUL_const,vCoul%iter,vCoul%mt,vCoul%pw_w,vCoul%vacz,vCoul%vacxy)
CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_X_const,vx%iter,vx%mt,vx%pw_w,vx%vacz,vx%vacxy)
CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_TOT_const,vTot%iter,vTot,vTot%pw_w)
CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_COUL_const,vCoul%iter,vCoul,vCoul%pw_w)
CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_X_const,vx%iter,vx,vx%pw_w)
END IF
......
juDFT/string.f90
View file @ 046cb70b
......@@ -44,4 +44,18 @@ contains
write (ret_str,*) num
ret_str = strip(ret_str)
end function int2str
function float2str(num) result(ret_str)
implicit none
real, intent(in) :: num
character(len=:), allocatable :: ret_str
allocate(character(100) :: ret_str)
if(num >= 1e-1 .and. num <= 1e4) then
write (ret_str,"(F10.5)") num
else
write (ret_str,"(ES10.4)") num
endif
ret_str = strip(ret_str)
end function float2str
end module m_juDFT_string
juDFT/time.F90
View file @ 046cb70b
......@@ -263,6 +263,71 @@ CONTAINS
END SUBROUTINE priv_writetimes
!<-- S:writetimes()
RECURSIVE SUBROUTINE priv_genjson(timer, level, outstr, opt_idstr)
use m_judft_string
IMPLICIT NONE
TYPE(t_timer), INTENT(IN) :: timer
INTEGER, INTENT(IN) :: level
CHARACTER(len=:), allocatable, INTENT(INOUT) :: outstr
CHARACTER(len=:), allocatable, optional :: opt_idstr
CHARACTER(len=1), PARAMETER :: nl=NEW_LINE("A")
INTEGER, PARAMETER :: indent_spaces=3
INTEGER :: n
REAL :: time
CHARACTER(LEN=30):: timername
CHARACTER(LEN=:), allocatable :: idstr
if(present(opt_idstr)) then
idstr = opt_idstr
else
idstr = ""
endif
IF (timer%starttime > 0) THEN
time = timer%time + cputime() - timer%starttime
timername = timer%name//" not term."
ELSE
time = timer%time
timername = timer%name
ENDIF
IF (time >= min_time*globaltimer%time) THEN
if(level > 1 ) outstr = outstr // nl
outstr = outstr // idstr // "{"
idstr = idstr // repeat(" ", indent_spaces)
outstr = outstr // nl // idstr // '"timername" : "' // trim(timername) // '",'
outstr = outstr // nl // idstr // '"totaltime" : ' // float2str(time)
if(level > 1) then
outstr = outstr // ","
outstr = outstr // nl // idstr // '"mintime" : ' // float2str(timer%mintime)// ','
outstr = outstr // nl // idstr // '"maxtime" : ' // float2str(timer%maxtime)// ','
outstr = outstr // nl // idstr // '"ncalls" : ' // int2str(timer%no_calls)
endif
time = 0
DO n = 1, timer%n_subtimers
time = time + timer%subtimer(n)%p%time
ENDDO
if(timer%n_subtimers > 0) then
!add comma behind ncalls
outstr = outstr // ","
outstr = outstr // nl // idstr // '"subtimers": ' // "["
idstr = idstr // repeat(" ", indent_spaces)
DO n = 1, timer%n_subtimers
CALL priv_genjson(timer%subtimer(n)%p, level + 1, outstr, idstr)
if(n /= timer%n_subtimers) outstr = outstr // ","
ENDDO
idstr = idstr(:len(idstr)-indent_spaces)
outstr = outstr // nl // idstr // ']'
endif
ENDIF
idstr = idstr(:len(idstr)-indent_spaces)
outstr = outstr // nl // idstr // "}"
END SUBROUTINE priv_genjson
RECURSIVE SUBROUTINE writelocation(location)
!writes the stack of current timers to std-out
......@@ -285,6 +350,7 @@ CONTAINS
LOGICAL, INTENT(IN), OPTIONAL::stdout
INTEGER :: fn, irank = 0
LOGICAL :: l_out
CHARACTER(len=:), allocatable :: json_str
#ifdef CPP_MPI
INCLUDE "mpif.h"
INTEGER::err, isize
......@@ -314,7 +380,6 @@ CONTAINS
WRITE (fn, *) "Program used ", isize, " PE"
#endif
CALL priv_writetimes(globaltimer, 1, fn)
WRITE (fn, *)
WRITE (fn, *) "-------------------------------------------------"
WRITE (fn, *)
......@@ -324,6 +389,11 @@ CONTAINS
FLUSH(fn)
IF (.NOT. l_out) CLOSE (2)
json_str = ""
call priv_genjson(globaltimer, 1, json_str)
open(32, file="juDFT_times.json")
write (32,"(A)") json_str
close(32)
END SUBROUTINE writetimes
! writes all times to out.xml file
......
main/fleur.F90
View file @ 046cb70b
......@@ -245,7 +245,7 @@ CONTAINS
CALL forcetheo%start(vtot,mpi%irank==0)
forcetheoloop:DO WHILE(forcetheo%next_job(iter==input%itmax,noco))
CALL timestart("generation of hamiltonian and diagonalization (total)")
CALL timestart("gen. of hamil. and diag. (total)")
CALL timestart("eigen")
vTemp = vTot
CALL timestart("Updating energy parameters")
......@@ -278,7 +278,7 @@ CONTAINS
IF (noco%l_soc.AND..NOT.noco%l_noco) &
CALL eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco,input,kpts, oneD,vTot,enpara,results)
CALL timestop("generation of hamiltonian and diagonalization (total)")
CALL timestop("gen. of hamil. and diag. (total)")
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ierr)
......
mix/kerker.F90
View file @ 046cb70b
......@@ -17,7 +17,9 @@ CONTAINS
USE m_types
USE m_types_mixvector
USE m_constants
#ifdef CPP_MPI
USE m_mpi_bc_potden
#endif
IMPLICIT NONE
TYPE(t_oneD), INTENT(in) :: oneD
TYPE(t_input), INTENT(in) :: input
......
mpi/CMakeLists.txt
View file @ 046cb70b
set(fleur_F90 ${fleur_F90}
mpi/mpi_bc_xcpot.F90
mpi/mpi_bc_tool.F90
mpi/setupMPI.F90)
if (${FLEUR_USE_MPI})
......@@ -14,6 +15,5 @@ if (${FLEUR_USE_MPI})
mpi/mpi_reduce_potden.F90
mpi/mpi_make_groups.F90
mpi/mpi_dist_forcetheorem.F90
mpi/mpi_bc_tool.F90
)
endif()
mpi/mpi_bc_tool.F90
View file @ 046cb70b
......@@ -8,7 +8,9 @@ MODULE m_mpi_bc_tool
USE m_judft
IMPLICIT NONE
PRIVATE
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
!This interface is used to broadcast data. On the recieving PE the data-array is first allocated to
!have the same shape as the one on irank
INTERFACE mpi_bc
......@@ -16,7 +18,6 @@ MODULE m_mpi_bc_tool
MODULE PROCEDURE mpi_bc_real,mpi_bc_real1,mpi_bc_real2,mpi_bc_real3,mpi_bc_real4,mpi_bc_real5
MODULE PROCEDURE mpi_bc_complex,mpi_bc_complex1,mpi_bc_complex2,mpi_bc_complex3,mpi_bc_complex4,mpi_bc_complex5
END INTERFACE mpi_bc
PUBLIC :: mpi_bc
CONTAINS
SUBROUTINE mpi_bc_int(i,irank,mpi_comm)
......@@ -26,8 +27,9 @@ CONTAINS
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(i,1,MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int
......@@ -35,9 +37,10 @@ CONTAINS
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -54,15 +57,17 @@ CONTAINS
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
#endif
END SUBROUTINE mpi_bc_int1
SUBROUTINE mpi_bc_int2(i,irank,mpi_comm)
SUBROUTINE mpi_bc_int2(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(2),iup(2),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -77,7 +82,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int2
......@@ -85,9 +90,10 @@ CONTAINS
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -102,17 +108,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int3
SUBROUTINE mpi_bc_int4(i,irank,mpi_comm)
SUBROUTINE mpi_bc_int4(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(4),iup(4),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -127,17 +134,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int4
SUBROUTINE mpi_bc_int5(i,irank,mpi_comm)
SUBROUTINE mpi_bc_int5(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(5),iup(5),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -152,7 +160,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int5
......@@ -160,16 +168,17 @@ CONTAINS
! now the same for reals
!
SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
IMPLICIT NONE
REAL,INTENT(INOUT) :: r
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(r,1,MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real
......@@ -177,10 +186,10 @@ CONTAINS
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
......@@ -194,17 +203,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real1
SUBROUTINE mpi_bc_real2(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real2(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(2),iup(2),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -219,6 +229,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real2
......@@ -227,9 +238,10 @@ CONTAINS
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -244,16 +256,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real3
SUBROUTINE mpi_bc_real4(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real4(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(4),iup(4),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -270,15 +284,17 @@ CONTAINS
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real4
SUBROUTINE mpi_bc_real5(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real5(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(5),iup(5),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -294,6 +310,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real5
......@@ -308,8 +325,10 @@ CONTAINS
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(c,1,MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex
......@@ -318,9 +337,10 @@ CONTAINS
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -335,16 +355,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex1
SUBROUTINE mpi_bc_complex2(c,irank,mpi_comm)
SUBROUTINE mpi_bc_complex2(c,irank,mpi_comm)
IMPLICIT <