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