Homec4science
Diffusion GYACOMO (OBSOLETE: LATEST VERSION ON gitlab.epfl.ch) (gather_output) Browse

gyacomo/src/utility_mod.F90
b4318b505ff7gather_output

Last Change
Raw File

utility_mod.F90
View Options

MODULE utility
USE basic
use prec_const
IMPLICIT NONE
PUBLIC :: manual_0D_bcast, manual_2D_bcast, manual_3D_bcast
CONTAINS
FUNCTION is_nan(x,str) RESULT(isn)
USE time_integration
use prec_const
IMPLICIT NONE
real(dp), INTENT(IN) :: x
CHARACTER(LEN=*), INTENT(IN) :: str
LOGICAL :: isn
isn=.FALSE.
IF(x .NE. x) THEN
isn=.TRUE.
END IF
IF((isn).AND.(str.NE.'')) THEN
WRITE(*,'(a20,a25,i6.6,a20,i1)') str,' = NaN at timestep',cstep, ' and substep',updatetlevel
CALL FLUSH(stdout)
END IF
END FUNCTION is_nan
FUNCTION is_inf(x,str) RESULT(isi)
USE time_integration
use prec_const
IMPLICIT NONE
real(dp), INTENT(IN) :: x
CHARACTER(LEN=*), INTENT(IN) :: str
LOGICAL :: isi
isi=.FALSE.
IF(x+1.0== x) THEN
isi=.TRUE.
END IF
IF((isi).AND.(str.NE.'')) THEN
!WRITE(*,'(a20,a25,i6.6,a20,i1)') str,' = Inf at timestep',cstep, ' and substep',updatetlevel
CALL FLUSH(stdout)
END IF
END FUNCTION is_inf
FUNCTION checkfield(field,str) RESULT(mlend)
USE grid
use prec_const
IMPLICIT NONE
COMPLEX(dp), DIMENSION(ikys:ikye,ikxs:ikxe), INTENT(IN) :: field
CHARACTER(LEN=*), INTENT(IN) :: str
LOGICAL :: mlend
COMPLEX(dp) :: sumfield
sumfield=SUM(field)
mlend= is_nan( REAL(sumfield),str).OR.is_inf( REAL(sumfield),str) &
.OR. is_nan(AIMAG(sumfield),str).OR.is_inf(AIMAG(sumfield),str)
END FUNCTION checkfield
!!!!! This is a manual way to do MPI_BCAST !!!!!!!!!!!
SUBROUTINE manual_2D_bcast(field_)
USE grid
IMPLICIT NONE
COMPLEX(dp), INTENT(INOUT) :: field_(ikys:ikye,ikxs:ikxe)
COMPLEX(dp) :: buffer(ikys:ikye,ikxs:ikxe)
INTEGER :: i_, root, world_rank, world_size
root = 0;
CALL MPI_COMM_RANK(comm_p,world_rank,ierr)
CALL MPI_COMM_SIZE(comm_p,world_size,ierr)
IF (world_size .GT. 1) THEN
!! Broadcast phi to the other processes on the same k range (communicator along p)
IF (world_rank .EQ. root) THEN
! Fill the buffer
DO ikx = ikxs,ikxe
DO iky = ikys,ikye
buffer(iky,ikx) = field_(iky,ikx)
ENDDO
ENDDO
! Send it to all the other processes
DO i_ = 0,num_procs_p-1
IF (i_ .NE. world_rank) &
CALL MPI_SEND(buffer, local_nky * Nkx , MPI_DOUBLE_COMPLEX, i_, 0, comm_p, ierr)
ENDDO
ELSE
! Recieve buffer from root
CALL MPI_RECV(buffer, local_nky * Nkx , MPI_DOUBLE_COMPLEX, root, 0, comm_p, MPI_STATUS_IGNORE, ierr)
! Write it in phi
DO ikx = ikxs,ikxe
DO iky = ikys,ikye
field_(iky,ikx) = buffer(iky,ikx)
ENDDO
ENDDO
ENDIF
ENDIF
END SUBROUTINE manual_2D_bcast
!!!!! This is a manual way to do MPI_BCAST !!!!!!!!!!!
SUBROUTINE manual_3D_bcast(field_)
USE grid
IMPLICIT NONE
COMPLEX(dp), INTENT(INOUT) :: field_(ikys:ikye,ikxs:ikxe,izs:ize)
COMPLEX(dp) :: buffer(ikys:ikye,ikxs:ikxe,izs:ize)
INTEGER :: i_, root, world_rank, world_size, count
root = 0;
count = (ikye-ikys+1) * (ikxe-ikxs+1) * (ize-izs+1);
CALL MPI_COMM_RANK(comm_p,world_rank,ierr)
CALL MPI_COMM_SIZE(comm_p,world_size,ierr)
IF (world_size .GT. 1) THEN
!! Broadcast phi to the other processes on the same k range (communicator along p)
IF (world_rank .EQ. root) THEN
! Fill the buffer
DO iz = izs,ize
DO ikx = ikxs,ikxe
DO iky = ikys,ikye
buffer(iky,ikx,iz) = field_(iky,ikx,iz)
ENDDO
ENDDO
ENDDO
! Send it to all the other processes
DO i_ = 0,num_procs_p-1
IF (i_ .NE. world_rank) &
CALL MPI_SEND(buffer, count, MPI_DOUBLE_COMPLEX, i_, 0, comm_p, ierr)
ENDDO
ELSE
! Recieve buffer from root
CALL MPI_RECV(buffer, count, MPI_DOUBLE_COMPLEX, root, 0, comm_p, MPI_STATUS_IGNORE, ierr)
! Write it in phi
DO iz = izs,ize
DO ikx = ikxs,ikxe
DO iky = ikys,ikye
field_(iky,ikx,iz) = buffer(iky,ikx,iz)
ENDDO
ENDDO
ENDDO
ENDIF
ENDIF
END SUBROUTINE manual_3D_bcast
!!!!! This is a manual way to do MPI_BCAST !!!!!!!!!!!
SUBROUTINE manual_0D_bcast(v)
USE grid
IMPLICIT NONE
COMPLEX(dp), INTENT(INOUT) :: v
COMPLEX(dp) :: buffer
INTEGER :: i_, root, world_rank, world_size, count
root = 0;
count = 1;
CALL MPI_COMM_RANK(comm_z,world_rank,ierr)
CALL MPI_COMM_SIZE(comm_z,world_size,ierr)
IF (world_size .GT. 1) THEN
!! Broadcast phi to the other processes on the same k range (communicator along p)
IF (world_rank .EQ. root) THEN
! Fill the buffer
buffer = v
! Send it to all the other processes
DO i_ = 0,num_procs_z-1
IF (i_ .NE. world_rank) &
CALL MPI_SEND(buffer, count, MPI_DOUBLE_COMPLEX, i_, 0, comm_z, ierr)
ENDDO
ELSE
! Recieve buffer from root
CALL MPI_RECV(buffer, count, MPI_DOUBLE_COMPLEX, root, 0, comm_z, MPI_STATUS_IGNORE, ierr)
! Write it in phi
v = buffer
ENDIF
ENDIF
END SUBROUTINE manual_0D_bcast
END MODULE utility
c4science · Help