Methods clear_data and clone_settings for MUMPS solver

mlprec/mld_c_mumps_solver.F90

@@ -88,6 +88,8 @@ module mld_c_mumps_solver
     procedure, pass(sv) :: build   => c_mumps_solver_bld
     procedure, pass(sv) :: apply_a => c_mumps_solver_apply
     procedure, pass(sv) :: apply_v => c_mumps_solver_apply_vect
+    procedure, pass(sv) :: clone_settings  => c_mumps_solver_clone_settings
+    procedure, pass(sv) :: clear_data  => c_mumps_solver_clear_data
     procedure, pass(sv) :: free    => c_mumps_solver_free
     procedure, pass(sv) :: descr   => c_mumps_solver_descr
     procedure, pass(sv) :: sizeof  => c_mumps_solver_sizeof
@@ -108,8 +110,9 @@ module mld_c_mumps_solver
        &  c_mumps_solver_free,   c_mumps_solver_descr, &
        &  c_mumps_solver_sizeof, c_mumps_solver_apply_vect,&
        &  c_mumps_solver_cseti, c_mumps_solver_csetr,   &
-       &  c_mumps_solver_csetc, &
+       &  c_mumps_solver_csetc,  c_mumps_solver_clear_data,  &
        &  c_mumps_solver_default, c_mumps_solver_get_fmt, &
+       &  c_mumps_solver_clone_settings, &
        &  c_mumps_solver_get_id, c_mumps_solver_is_global
 #if defined(HAVE_FINAL) 
   private :: c_mumps_solver_finalize
@@ -176,7 +179,59 @@ module mld_c_mumps_solver
 
 contains
 
-  subroutine c_mumps_solver_free(sv,info)
+  subroutine c_mumps_solver_clone_settings(sv,svout,info)
+
+    use psb_base_mod
+    Implicit None
+    ! Arguments
+    class(mld_c_mumps_solver_type), intent(inout) :: sv
+    class(mld_c_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)                 :: info
+    integer(psb_ipk_) :: k,err_act
+    character(len=20) :: name='c_mumps_solver_clone_settings'
+
+    info = 0
+
+#if defined(HAVE_MUMPS_)
+    
+    call psb_erractionsave(err_act)
+
+    select type(svout)
+    class is(mld_c_mumps_solver_type)
+      svout%ipar(:) = sv%ipar(:)
+      svout%built = .false.
+      if (allocated(svout%icntl)) deallocate(svout%icntl,stat=info)
+      if (info == 0) allocate(svout%icntl(mld_mumps_icntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_icntl_size
+          call psb_safe_ab_cpy(sv%icntl(k)%item,svout%icntl(k)%item,info)
+        end do
+      end if
+      
+      if (allocated(svout%rcntl)) deallocate(svout%rcntl,stat=info)
+      if (info == 0) allocate(svout%rcntl(mld_mumps_rcntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_rcntl_size
+          call psb_safe_ab_cpy(sv%rcntl(k)%item,svout%rcntl(k)%item,info)
+        end do
+      end if
+
+    class default    
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999 
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+
+    return
+#endif
+  end subroutine c_mumps_solver_clone_settings
+
+  subroutine c_mumps_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
@@ -184,10 +239,11 @@ contains
     class(mld_c_mumps_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     Integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='c_mumps_solver_free'
+    character(len=20)  :: name='c_mumps_solver_clear_data'
 
-    call psb_erractionsave(err_act)
+    info = 0
 #if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
     if (allocated(sv%id)) then      
       if (sv%built) then 
         sv%id%job = -2
@@ -195,19 +251,46 @@ contains
         info = sv%id%infog(1)
         if (info /= psb_success_) goto 9999
       end if
-      deallocate(sv%id, sv%icntl, sv%rcntl)
+      deallocate(sv%id, stat=info)
       if (allocated(sv%local_ictxt)) then
         call psb_exit(sv%local_ictxt,close=.false.)
         deallocate(sv%local_ictxt,stat=info)
       end if
-      if (allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
-      if (allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
-      
       sv%built=.false.
     end if
     call psb_erractionrestore(err_act)
     return
 
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+#endif
+  end subroutine c_mumps_solver_clear_data
+
+  subroutine c_mumps_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(mld_c_mumps_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    Integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='c_mumps_solver_free'
+
+    info = 0
+#if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
+    call sv%clear_data(info)
+    if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
+    if ((info == 0).and.allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
+
+    call psb_erractionrestore(err_act)
+    return
+    
 9999 continue
     call psb_erractionrestore(err_act)
     if (err_act == psb_act_abort_) then

mlprec/mld_d_mumps_solver.F90

@@ -88,6 +88,8 @@ module mld_d_mumps_solver
     procedure, pass(sv) :: build   => d_mumps_solver_bld
     procedure, pass(sv) :: apply_a => d_mumps_solver_apply
     procedure, pass(sv) :: apply_v => d_mumps_solver_apply_vect
+    procedure, pass(sv) :: clone_settings  => d_mumps_solver_clone_settings
+    procedure, pass(sv) :: clear_data  => d_mumps_solver_clear_data
     procedure, pass(sv) :: free    => d_mumps_solver_free
     procedure, pass(sv) :: descr   => d_mumps_solver_descr
     procedure, pass(sv) :: sizeof  => d_mumps_solver_sizeof
@@ -108,8 +110,9 @@ module mld_d_mumps_solver
        &  d_mumps_solver_free,   d_mumps_solver_descr, &
        &  d_mumps_solver_sizeof, d_mumps_solver_apply_vect,&
        &  d_mumps_solver_cseti, d_mumps_solver_csetr,   &
-       &  d_mumps_solver_csetc, &
+       &  d_mumps_solver_csetc,  d_mumps_solver_clear_data,  &
        &  d_mumps_solver_default, d_mumps_solver_get_fmt, &
+       &  d_mumps_solver_clone_settings, &
        &  d_mumps_solver_get_id, d_mumps_solver_is_global
 #if defined(HAVE_FINAL) 
   private :: d_mumps_solver_finalize
@@ -176,7 +179,59 @@ module mld_d_mumps_solver
 
 contains
 
-  subroutine d_mumps_solver_free(sv,info)
+  subroutine d_mumps_solver_clone_settings(sv,svout,info)
+
+    use psb_base_mod
+    Implicit None
+    ! Arguments
+    class(mld_d_mumps_solver_type), intent(inout) :: sv
+    class(mld_d_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)                 :: info
+    integer(psb_ipk_) :: k,err_act
+    character(len=20) :: name='d_mumps_solver_clone_settings'
+
+    info = 0
+
+#if defined(HAVE_MUMPS_)
+    
+    call psb_erractionsave(err_act)
+
+    select type(svout)
+    class is(mld_d_mumps_solver_type)
+      svout%ipar(:) = sv%ipar(:)
+      svout%built = .false.
+      if (allocated(svout%icntl)) deallocate(svout%icntl,stat=info)
+      if (info == 0) allocate(svout%icntl(mld_mumps_icntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_icntl_size
+          call psb_safe_ab_cpy(sv%icntl(k)%item,svout%icntl(k)%item,info)
+        end do
+      end if
+      
+      if (allocated(svout%rcntl)) deallocate(svout%rcntl,stat=info)
+      if (info == 0) allocate(svout%rcntl(mld_mumps_rcntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_rcntl_size
+          call psb_safe_ab_cpy(sv%rcntl(k)%item,svout%rcntl(k)%item,info)
+        end do
+      end if
+
+    class default    
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999 
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+
+    return
+#endif
+  end subroutine d_mumps_solver_clone_settings
+
+  subroutine d_mumps_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
@@ -184,10 +239,11 @@ contains
     class(mld_d_mumps_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     Integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='d_mumps_solver_free'
+    character(len=20)  :: name='d_mumps_solver_clear_data'
 
-    call psb_erractionsave(err_act)
+    info = 0
 #if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
     if (allocated(sv%id)) then      
       if (sv%built) then 
         sv%id%job = -2
@@ -195,19 +251,46 @@ contains
         info = sv%id%infog(1)
         if (info /= psb_success_) goto 9999
       end if
-      deallocate(sv%id, sv%icntl, sv%rcntl)
+      deallocate(sv%id, stat=info)
       if (allocated(sv%local_ictxt)) then
         call psb_exit(sv%local_ictxt,close=.false.)
         deallocate(sv%local_ictxt,stat=info)
       end if
-      if (allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
-      if (allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
-      
       sv%built=.false.
     end if
     call psb_erractionrestore(err_act)
     return
 
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+#endif
+  end subroutine d_mumps_solver_clear_data
+
+  subroutine d_mumps_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(mld_d_mumps_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    Integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='d_mumps_solver_free'
+
+    info = 0
+#if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
+    call sv%clear_data(info)
+    if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
+    if ((info == 0).and.allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
+
+    call psb_erractionrestore(err_act)
+    return
+    
 9999 continue
     call psb_erractionrestore(err_act)
     if (err_act == psb_act_abort_) then

mlprec/mld_s_mumps_solver.F90

@@ -88,6 +88,8 @@ module mld_s_mumps_solver
     procedure, pass(sv) :: build   => s_mumps_solver_bld
     procedure, pass(sv) :: apply_a => s_mumps_solver_apply
     procedure, pass(sv) :: apply_v => s_mumps_solver_apply_vect
+    procedure, pass(sv) :: clone_settings  => s_mumps_solver_clone_settings
+    procedure, pass(sv) :: clear_data  => s_mumps_solver_clear_data
     procedure, pass(sv) :: free    => s_mumps_solver_free
     procedure, pass(sv) :: descr   => s_mumps_solver_descr
     procedure, pass(sv) :: sizeof  => s_mumps_solver_sizeof
@@ -108,8 +110,9 @@ module mld_s_mumps_solver
        &  s_mumps_solver_free,   s_mumps_solver_descr, &
        &  s_mumps_solver_sizeof, s_mumps_solver_apply_vect,&
        &  s_mumps_solver_cseti, s_mumps_solver_csetr,   &
-       &  s_mumps_solver_csetc, &
+       &  s_mumps_solver_csetc,  s_mumps_solver_clear_data,  &
        &  s_mumps_solver_default, s_mumps_solver_get_fmt, &
+       &  s_mumps_solver_clone_settings, &
        &  s_mumps_solver_get_id, s_mumps_solver_is_global
 #if defined(HAVE_FINAL) 
   private :: s_mumps_solver_finalize
@@ -176,7 +179,59 @@ module mld_s_mumps_solver
 
 contains
 
-  subroutine s_mumps_solver_free(sv,info)
+  subroutine s_mumps_solver_clone_settings(sv,svout,info)
+
+    use psb_base_mod
+    Implicit None
+    ! Arguments
+    class(mld_s_mumps_solver_type), intent(inout) :: sv
+    class(mld_s_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)                 :: info
+    integer(psb_ipk_) :: k,err_act
+    character(len=20) :: name='s_mumps_solver_clone_settings'
+
+    info = 0
+
+#if defined(HAVE_MUMPS_)
+    
+    call psb_erractionsave(err_act)
+
+    select type(svout)
+    class is(mld_s_mumps_solver_type)
+      svout%ipar(:) = sv%ipar(:)
+      svout%built = .false.
+      if (allocated(svout%icntl)) deallocate(svout%icntl,stat=info)
+      if (info == 0) allocate(svout%icntl(mld_mumps_icntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_icntl_size
+          call psb_safe_ab_cpy(sv%icntl(k)%item,svout%icntl(k)%item,info)
+        end do
+      end if
+      
+      if (allocated(svout%rcntl)) deallocate(svout%rcntl,stat=info)
+      if (info == 0) allocate(svout%rcntl(mld_mumps_rcntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_rcntl_size
+          call psb_safe_ab_cpy(sv%rcntl(k)%item,svout%rcntl(k)%item,info)
+        end do
+      end if
+
+    class default    
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999 
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+
+    return
+#endif
+  end subroutine s_mumps_solver_clone_settings
+
+  subroutine s_mumps_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
@@ -184,10 +239,11 @@ contains
     class(mld_s_mumps_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     Integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='s_mumps_solver_free'
+    character(len=20)  :: name='s_mumps_solver_clear_data'
 
-    call psb_erractionsave(err_act)
+    info = 0
 #if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
     if (allocated(sv%id)) then      
       if (sv%built) then 
         sv%id%job = -2
@@ -195,19 +251,46 @@ contains
         info = sv%id%infog(1)
         if (info /= psb_success_) goto 9999
       end if
-      deallocate(sv%id, sv%icntl, sv%rcntl)
+      deallocate(sv%id, stat=info)
       if (allocated(sv%local_ictxt)) then
         call psb_exit(sv%local_ictxt,close=.false.)
         deallocate(sv%local_ictxt,stat=info)
       end if
-      if (allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
-      if (allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
-      
       sv%built=.false.
     end if
     call psb_erractionrestore(err_act)
     return
 
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+#endif
+  end subroutine s_mumps_solver_clear_data
+
+  subroutine s_mumps_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(mld_s_mumps_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    Integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='s_mumps_solver_free'
+
+    info = 0
+#if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
+    call sv%clear_data(info)
+    if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
+    if ((info == 0).and.allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
+
+    call psb_erractionrestore(err_act)
+    return
+    
 9999 continue
     call psb_erractionrestore(err_act)
     if (err_act == psb_act_abort_) then

mlprec/mld_z_mumps_solver.F90

@@ -88,6 +88,8 @@ module mld_z_mumps_solver
     procedure, pass(sv) :: build   => z_mumps_solver_bld
     procedure, pass(sv) :: apply_a => z_mumps_solver_apply
     procedure, pass(sv) :: apply_v => z_mumps_solver_apply_vect
+    procedure, pass(sv) :: clone_settings  => z_mumps_solver_clone_settings
+    procedure, pass(sv) :: clear_data  => z_mumps_solver_clear_data
     procedure, pass(sv) :: free    => z_mumps_solver_free
     procedure, pass(sv) :: descr   => z_mumps_solver_descr
     procedure, pass(sv) :: sizeof  => z_mumps_solver_sizeof
@@ -108,8 +110,9 @@ module mld_z_mumps_solver
        &  z_mumps_solver_free,   z_mumps_solver_descr, &
        &  z_mumps_solver_sizeof, z_mumps_solver_apply_vect,&
        &  z_mumps_solver_cseti, z_mumps_solver_csetr,   &
-       &  z_mumps_solver_csetc, &
+       &  z_mumps_solver_csetc,  z_mumps_solver_clear_data,  &
        &  z_mumps_solver_default, z_mumps_solver_get_fmt, &
+       &  z_mumps_solver_clone_settings, &
        &  z_mumps_solver_get_id, z_mumps_solver_is_global
 #if defined(HAVE_FINAL) 
   private :: z_mumps_solver_finalize
@@ -176,7 +179,59 @@ module mld_z_mumps_solver
 
 contains
 
-  subroutine z_mumps_solver_free(sv,info)
+  subroutine z_mumps_solver_clone_settings(sv,svout,info)
+
+    use psb_base_mod
+    Implicit None
+    ! Arguments
+    class(mld_z_mumps_solver_type), intent(inout) :: sv
+    class(mld_z_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)                 :: info
+    integer(psb_ipk_) :: k,err_act
+    character(len=20) :: name='z_mumps_solver_clone_settings'
+
+    info = 0
+
+#if defined(HAVE_MUMPS_)
+    
+    call psb_erractionsave(err_act)
+
+    select type(svout)
+    class is(mld_z_mumps_solver_type)
+      svout%ipar(:) = sv%ipar(:)
+      svout%built = .false.
+      if (allocated(svout%icntl)) deallocate(svout%icntl,stat=info)
+      if (info == 0) allocate(svout%icntl(mld_mumps_icntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_icntl_size
+          call psb_safe_ab_cpy(sv%icntl(k)%item,svout%icntl(k)%item,info)
+        end do
+      end if
+      
+      if (allocated(svout%rcntl)) deallocate(svout%rcntl,stat=info)
+      if (info == 0) allocate(svout%rcntl(mld_mumps_rcntl_size),stat=info)
+      if (info == 0) then
+        do k=1,mld_mumps_rcntl_size
+          call psb_safe_ab_cpy(sv%rcntl(k)%item,svout%rcntl(k)%item,info)
+        end do
+      end if
+
+    class default    
+      info = psb_err_internal_error_
+      call psb_errpush(info,name)
+      goto 9999 
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+
+    return
+#endif
+  end subroutine z_mumps_solver_clone_settings
+
+  subroutine z_mumps_solver_clear_data(sv,info)
     use psb_base_mod, only : psb_exit
     Implicit None
 
@@ -184,10 +239,11 @@ contains
     class(mld_z_mumps_solver_type), intent(inout) :: sv
     integer(psb_ipk_), intent(out)                :: info
     Integer(psb_ipk_) :: err_act
-    character(len=20)  :: name='z_mumps_solver_free'
+    character(len=20)  :: name='z_mumps_solver_clear_data'
 
-    call psb_erractionsave(err_act)
+    info = 0
 #if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
     if (allocated(sv%id)) then      
       if (sv%built) then 
         sv%id%job = -2
@@ -195,19 +251,46 @@ contains
         info = sv%id%infog(1)
         if (info /= psb_success_) goto 9999
       end if
-      deallocate(sv%id, sv%icntl, sv%rcntl)
+      deallocate(sv%id, stat=info)
       if (allocated(sv%local_ictxt)) then
         call psb_exit(sv%local_ictxt,close=.false.)
         deallocate(sv%local_ictxt,stat=info)
       end if
-      if (allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
-      if (allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
-      
       sv%built=.false.
     end if
     call psb_erractionrestore(err_act)
     return
 
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+#endif
+  end subroutine z_mumps_solver_clear_data
+
+  subroutine z_mumps_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(mld_z_mumps_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    Integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='z_mumps_solver_free'
+
+    info = 0
+#if defined(HAVE_MUMPS_)
+    call psb_erractionsave(err_act)
+    call sv%clear_data(info)
+    if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
+    if ((info == 0).and.allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
+
+    call psb_erractionrestore(err_act)
+    return
+    
 9999 continue
     call psb_erractionrestore(err_act)
     if (err_act == psb_act_abort_) then