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)
      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 instaces 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