1C
2C  This file is part of MUMPS 5.1.2, released
3C  on Mon Oct  2 07:37:01 UTC 2017
4C
5      PROGRAM MUMPS_MULTIPLE_ARITHMETICS_TEST
6      IMPLICIT NONE
7      INCLUDE 'mpif.h'
8      INCLUDE 'smumps_struc.h'
9      INCLUDE 'dmumps_struc.h'
10      INCLUDE 'cmumps_struc.h'
11      INCLUDE 'zmumps_struc.h'
12      TYPE (SMUMPS_STRUC) smumps_par
13      TYPE (DMUMPS_STRUC) dmumps_par
14      TYPE (CMUMPS_STRUC) cmumps_par
15      TYPE (ZMUMPS_STRUC) zmumps_par
16      INTEGER IERR
17      CALL MPI_INIT(IERR)
18C Define a communicator for the packages.
19      smumps_par%COMM = MPI_COMM_WORLD
20      dmumps_par%COMM = smumps_par%COMM
21      cmumps_par%COMM = smumps_par%COMM
22      zmumps_par%COMM = smumps_par%COMM
23C  Initialize all instances of the package
24C  for L U factorization (sym = 0, with working host)
25      smumps_par%JOB = -1
26      smumps_par%SYM = 0
27      smumps_par%PAR = 1
28      CALL SMUMPS(smumps_par)
29      IF (smumps_par%INFOG(1).LT.0) THEN
30       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
31     &            "  smumps_par%INFOG(1)= ", smumps_par%INFOG(1),
32     &            "  smumps_par%INFOG(2)= ", smumps_par%INFOG(2)
33       GOTO 500
34      END IF
35
36      dmumps_par%JOB = smumps_par%JOB
37      dmumps_par%SYM = smumps_par%SYM
38      dmumps_par%PAR = smumps_par%PAR
39      cmumps_par%JOB = smumps_par%JOB
40      cmumps_par%SYM = smumps_par%SYM
41      cmumps_par%PAR = smumps_par%PAR
42      zmumps_par%JOB = smumps_par%JOB
43      zmumps_par%SYM = smumps_par%SYM
44      zmumps_par%PAR = smumps_par%PAR
45
46      CALL DMUMPS(dmumps_par)
47      IF (dmumps_par%INFOG(1).LT.0) THEN
48       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
49     &            "  dmumps_par%INFOG(1)= ", dmumps_par%INFOG(1),
50     &            "  dmumps_par%INFOG(2)= ", dmumps_par%INFOG(2)
51       GOTO 500
52      END IF
53
54      CALL CMUMPS(cmumps_par)
55      IF (cmumps_par%INFOG(1).LT.0) THEN
56       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
57     &            "  cmumps_par%INFOG(1)= ", cmumps_par%INFOG(1),
58     &            "  cmumps_par%INFOG(2)= ", cmumps_par%INFOG(2)
59       GOTO 500
60      END IF
61
62      CALL ZMUMPS(zmumps_par)
63      IF (zmumps_par%INFOG(1).LT.0) THEN
64       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
65     &            "  zmumps_par%INFOG(1)= ", zmumps_par%INFOG(1),
66     &            "  zmumps_par%INFOG(2)= ", zmumps_par%INFOG(2)
67       GOTO 500
68      END IF
69
70      IF ( smumps_par%MYID .eq. 0 )THEN
71         write(6,'(A)') "Creation of all instaces went well"
72      ENDIF
73
74C     Destroy the instances (deallocate internal data structures)
75      smumps_par%JOB = -2
76      CALL SMUMPS(smumps_par)
77      IF (smumps_par%INFOG(1).LT.0) THEN
78       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
79     &            "  smumps_par%INFOG(1)= ", smumps_par%INFOG(1),
80     &            "  smumps_par%INFOG(2)= ", smumps_par%INFOG(2)
81       GOTO 500
82      END IF
83
84      dmumps_par%JOB = smumps_par%JOB
85      cmumps_par%JOB = smumps_par%JOB
86      zmumps_par%JOB = smumps_par%JOB
87
88      CALL DMUMPS(dmumps_par)
89      IF (dmumps_par%INFOG(1).LT.0) THEN
90       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
91     &            "  dmumps_par%INFOG(1)= ", dmumps_par%INFOG(1),
92     &            "  dmumps_par%INFOG(2)= ", dmumps_par%INFOG(2)
93       GOTO 500
94      END IF
95      CALL CMUMPS(cmumps_par)
96      IF (cmumps_par%INFOG(1).LT.0) THEN
97       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
98     &            "  cmumps_par%INFOG(1)= ", cmumps_par%INFOG(1),
99     &            "  cmumps_par%INFOG(2)= ", cmumps_par%INFOG(2)
100       GOTO 500
101      END IF
102      CALL ZMUMPS(zmumps_par)
103      IF (zmumps_par%INFOG(1).LT.0) THEN
104       WRITE(6,'(A,A,I6,A,I9)') " ERROR RETURN: ",
105     &            "  zmumps_par%INFOG(1)= ", zmumps_par%INFOG(1),
106     &            "  zmumps_par%INFOG(2)= ", zmumps_par%INFOG(2)
107       GOTO 500
108      END IF
109
110 500  CALL MPI_FINALIZE(IERR)
111      STOP
112      END PROGRAM MUMPS_MULTIPLE_ARITHMETICS_TEST
113
114