multiple_arithmetics_example.F

Go to the documentation of this file.

C
C  This file is part of MUMPS 5.5.1, released
C  on Tue Jul 12 13:17:24 UTC 2022
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)
.LT.      IF (smumps_par%INFOG(1)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)
.LT.      IF (dmumps_par%INFOG(1)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)
.LT.      IF (cmumps_par%INFOG(1)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)
.LT.      IF (zmumps_par%INFOG(1)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
 
.eq.      IF ( smumps_par%MYID  0 )THEN
         write(6,'(a)') "Creation of all instaces went well"
      ENDIF
           
C     Destroy the instances (deallocate internal data structures)
      smumps_par%JOB = -2
      CALL SMUMPS(smumps_par)
.LT.      IF (smumps_par%INFOG(1)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)
.LT.      IF (dmumps_par%INFOG(1)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)
.LT.      IF (cmumps_par%INFOG(1)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)
.LT.      IF (zmumps_par%INFOG(1)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