223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

fixed MPI_reduce hiccup 

see http://stackoverflow.com/questions/17741574/in-place-mpi-reduce-crashes-with-openmpi
This commit is contained in:
Philip Eisenlohr 2016-08-31 22:54:00 -04:00
parent 22e7d6d4e1
commit d529eae4a4
1 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
code/spectral_utilities.f90
View File

@ -237,7 +237,7 @@ subroutine utilities_init()
grid1Red = grid(1)/2_pInt + 1_pInt grid1Red = grid(1)/2_pInt + 1_pInt
wgt = 1.0/real(product(grid),pReal) wgt = 1.0/real(product(grid),pReal)
if (worldrank == 0) then if (worldrank == 0_pInt) then
write(6,'(a,3(i12 ))') ' grid a b c: ', grid write(6,'(a,3(i12 ))') ' grid a b c: ', grid
write(6,'(a,3(es12.5))') ' size x y z: ', geomSize write(6,'(a,3(es12.5))') ' size x y z: ', geomSize
endif endif
@ -1015,10 +1015,19 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, &
defgradDetMax = max(defgradDetMax,defgradDet) defgradDetMax = max(defgradDetMax,defgradDet)
defgradDetMin = min(defgradDetMin,defgradDet) defgradDetMin = min(defgradDetMin,defgradDet)
end do end do
call MPI_reduce(MPI_IN_PLACE,defgradDetMax,1,MPI_DOUBLE,MPI_MAX,0,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce max') if (worldrank == 0_pInt) then
call MPI_reduce(MPI_IN_PLACE,defgradDetMin,1,MPI_DOUBLE,MPI_MIN,0,PETSC_COMM_WORLD,ierr) call MPI_reduce(MPI_IN_PLACE,defgradDetMax,1,MPI_DOUBLE,MPI_MAX,0,PETSC_COMM_WORLD,ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce min') else
call MPI_reduce(defgradDetMax,defgradDetMax,1,MPI_DOUBLE,MPI_MAX,0,PETSC_COMM_WORLD,ierr)
endif
if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce max')
if (worldrank == 0_pInt) then
call MPI_reduce(MPI_IN_PLACE,defgradDetMin,1,MPI_DOUBLE,MPI_MIN,0,PETSC_COMM_WORLD,ierr)
else
call MPI_reduce(defgradDetMin,defgradDetMin,1,MPI_DOUBLE,MPI_MIN,0,PETSC_COMM_WORLD,ierr)
endif
if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce min')
if (worldrank == 0_pInt) then if (worldrank == 0_pInt) then
write(6,'(a,1x,es11.4)') ' max determinant of deformation =', defgradDetMax write(6,'(a,1x,es11.4)') ' max determinant of deformation =', defgradDetMax
write(6,'(a,1x,es11.4)') ' min determinant of deformation =', defgradDetMin write(6,'(a,1x,es11.4)') ' min determinant of deformation =', defgradDetMin