scales_ppm_base.f90 1.04 KB
Newer Older
1
2
MODULE scales_ppm_base
  IMPLICIT NONE
3
#ifdef USE_MPI
4
  INCLUDE 'mpif.h'
5
6
7
#else
  INTEGER, PARAMETER :: mpi_comm_world = 0
#endif
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
  PRIVATE
  PUBLIC :: abort_ppm, assertion
CONTAINS
  SUBROUTINE abort_ppm(msg, source, line, comm)
    CHARACTER(len=*), INTENT(in) :: source, msg
    INTEGER, INTENT(in) :: line
    INTEGER, OPTIONAL, INTENT(in) :: comm
    INTEGER :: comm_dummy
    comm_dummy = MERGE(comm, mpi_comm_world, PRESENT(comm))
    CALL abort_ppm_f(comm_dummy, msg, source, line)
  END SUBROUTINE abort_ppm

  SUBROUTINE assertion(cond, origfile, origline)
    LOGICAL, INTENT(in) :: cond
    CHARACTER(len=*), OPTIONAL, INTENT(in) :: origfile
    INTEGER, OPTIONAL, INTENT(in) :: origline
    CHARACTER(len=255) :: file
    INTEGER :: line

    IF (PRESENT(origfile)) THEN
      file = origfile
    ELSE
      file = 'unknown'
    ENDIF
    IF (PRESENT(origline)) THEN
      line = origline
    ELSE
      line = -1
    ENDIF
    IF (.NOT. cond) CALL abort_ppm('assertion failed', TRIM(file), line)
  END SUBROUTINE assertion

END MODULE scales_ppm_base