1
2
3
4
5
6
7
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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
C
C This file is part of MUMPS 5.8.1, released
C on Wed Jul 30 16:49:18 UTC 2025
C
PROGRAM MUMPS_MULTIPLE_ARITHMETICS_TEST
IMPLICIT NONE
INCLUDE 'mpif.h'
INCLUDE 'smumps_struc.h'
INCLUDE 'dmumps_struc.h'
INCLUDE 'cmumps_struc.h'
INCLUDE 'zmumps_struc.h'
TYPE (SMUMPS_STRUC) smumps_par
TYPE (DMUMPS_STRUC) dmumps_par
TYPE (CMUMPS_STRUC) cmumps_par
TYPE (ZMUMPS_STRUC) zmumps_par
INTEGER IERR
CALL MPI_INIT(IERR)
C Define a communicator for the packages.
smumps_par%COMM = MPI_COMM_WORLD
dmumps_par%COMM = smumps_par%COMM
cmumps_par%COMM = smumps_par%COMM
zmumps_par%COMM = smumps_par%COMM
C Initialize all instances of the package
C for L U factorization (sym = 0, with working host)
smumps_par%JOB = -1
smumps_par%SYM = 0
smumps_par%PAR = 1
CALL SMUMPS(smumps_par)
IF (smumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " smumps_par%INFOG(1)= ", smumps_par%INFOG(1),
& " smumps_par%INFOG(2)= ", smumps_par%INFOG(2)
GOTO 500
END IF
dmumps_par%JOB = smumps_par%JOB
dmumps_par%SYM = smumps_par%SYM
dmumps_par%PAR = smumps_par%PAR
cmumps_par%JOB = smumps_par%JOB
cmumps_par%SYM = smumps_par%SYM
cmumps_par%PAR = smumps_par%PAR
zmumps_par%JOB = smumps_par%JOB
zmumps_par%SYM = smumps_par%SYM
zmumps_par%PAR = smumps_par%PAR
CALL DMUMPS(dmumps_par)
IF (dmumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " dmumps_par%INFOG(1)= ", dmumps_par%INFOG(1),
& " dmumps_par%INFOG(2)= ", dmumps_par%INFOG(2)
GOTO 500
END IF
CALL CMUMPS(cmumps_par)
IF (cmumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " cmumps_par%INFOG(1)= ", cmumps_par%INFOG(1),
& " cmumps_par%INFOG(2)= ", cmumps_par%INFOG(2)
GOTO 500
END IF
CALL ZMUMPS(zmumps_par)
IF (zmumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " zmumps_par%INFOG(1)= ", zmumps_par%INFOG(1),
& " zmumps_par%INFOG(2)= ", zmumps_par%INFOG(2)
GOTO 500
END IF
IF ( smumps_par%MYID .eq. 0 )THEN
write(6,'(A)') "Creation of all instances went well"
ENDIF
C Destroy the instances (deallocate internal data structures)
smumps_par%JOB = -2
CALL SMUMPS(smumps_par)
IF (smumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " smumps_par%INFOG(1)= ", smumps_par%INFOG(1),
& " smumps_par%INFOG(2)= ", smumps_par%INFOG(2)
GOTO 500
END IF
dmumps_par%JOB = smumps_par%JOB
cmumps_par%JOB = smumps_par%JOB
zmumps_par%JOB = smumps_par%JOB
CALL DMUMPS(dmumps_par)
IF (dmumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " dmumps_par%INFOG(1)= ", dmumps_par%INFOG(1),
& " dmumps_par%INFOG(2)= ", dmumps_par%INFOG(2)
GOTO 500
END IF
CALL CMUMPS(cmumps_par)
IF (cmumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " cmumps_par%INFOG(1)= ", cmumps_par%INFOG(1),
& " cmumps_par%INFOG(2)= ", cmumps_par%INFOG(2)
GOTO 500
END IF
CALL ZMUMPS(zmumps_par)
IF (zmumps_par%INFOG(1).LT.0) THEN
WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
& " zmumps_par%INFOG(1)= ", zmumps_par%INFOG(1),
& " zmumps_par%INFOG(2)= ", zmumps_par%INFOG(2)
GOTO 500
END IF
500 CALL MPI_FINALIZE(IERR)
STOP
END PROGRAM MUMPS_MULTIPLE_ARITHMETICS_TEST
|
