mld2p4-2

mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_type.f90

Defined CLONE method in mld level/prec type.

mlprec/mld_c_onelev_mod.f90

@@ -127,6 +127,7 @@ module mld_c_onelev_mod
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_clinmap_type)           :: map
   contains
+    procedure, pass(lv) :: clone   => c_base_onelev_clone
     procedure, pass(lv) :: descr   => mld_c_base_onelev_descr
     procedure, pass(lv) :: default => c_base_onelev_default
     procedure, pass(lv) :: free    => mld_c_base_onelev_free
@@ -151,7 +152,8 @@ module mld_c_onelev_mod
   end type mld_c_onelev_node
 
   private :: c_base_onelev_default, c_base_onelev_sizeof, &
-       &  c_base_onelev_nullify, c_base_onelev_get_nzeros
+       & c_base_onelev_nullify, c_base_onelev_get_nzeros, &
+       & c_base_onelev_clone
 
 
 
@@ -376,6 +378,30 @@ contains
   end subroutine c_base_onelev_default
 
 
+
+  subroutine c_base_onelev_clone(lv,lvout,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_c_onelev_type), target, intent(inout) :: lv 
+    class(mld_c_onelev_type), intent(out)           :: lvout
+    integer(psb_ipk_), intent(out)                  :: info 
+
+    if (allocated(lv%sm)) &
+         &   call lv%sm%clone(lvout%sm,info)
+    if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
+    if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
+    if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    lvout%base_a    => lv%base_a
+    lvout%base_desc => lv%base_desc
+    
+    return
+
+  end subroutine c_base_onelev_clone
+
+
   subroutine mld_c_onelev_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_c_prec_type.f90

@@ -90,6 +90,7 @@ module mld_c_prec_type
     procedure, pass(prec)               :: psb_c_apply2v => mld_c_apply2v
     procedure, pass(prec)               :: psb_c_apply1v => mld_c_apply1v
     procedure, pass(prec)               :: dump           => mld_c_dump
+    procedure, pass(prec)               :: clone          => mld_c_clone
     procedure, pass(prec)               :: get_complexity => mld_c_get_compl
     procedure, pass(prec)               :: cmp_complexity => mld_c_cmp_compl
     procedure, pass(prec)               :: get_nzeros => mld_c_get_nzeros
@@ -722,6 +723,42 @@ contains
 
   end subroutine mld_c_dump
 
+
+  subroutine mld_c_clone(prec,precout,info)
+
+    implicit none 
+    class(mld_cprec_type), intent(inout) :: prec
+    class(mld_cprec_type), target, intent(out)           :: precout
+    integer(psb_ipk_), intent(out)               :: info
+    ! Local vars
+    integer(psb_ipk_)  :: i, j, il1, ln, lname, lev
+    integer(psb_ipk_)  :: icontxt,iam, np
+
+    info = psb_success_
+    precout%ictxt            = prec%ictxt
+    precout%coarse_aggr_size = prec%coarse_aggr_size
+    precout%op_complexity    = prec%op_complexity
+    if (allocated(prec%precv)) then 
+      ln = size(prec%precv) 
+      allocate(precout%precv(ln),stat=info)
+      if (info /= psb_success_) goto 9999
+      if (ln > 1) then 
+        call prec%precv(1)%clone(precout%precv(1),info)
+      end if
+      do lev=2, ln
+        if (info /= psb_success_) exit
+        call prec%precv(lev)%clone(precout%precv(lev),info)
+        if (info == psb_success_) then 
+          precout%precv(lev)%base_a       => precout%precv(lev)%ac
+          precout%precv(lev)%base_desc    => precout%precv(lev)%desc_ac
+          precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
+          precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+        end if
+      end do
+    end if
+9999 continue
+  end subroutine mld_c_clone
+
   subroutine mld_cprec_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_d_onelev_mod.f90

@@ -127,6 +127,7 @@ module mld_d_onelev_mod
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_dlinmap_type)           :: map
   contains
+    procedure, pass(lv) :: clone   => d_base_onelev_clone
     procedure, pass(lv) :: descr   => mld_d_base_onelev_descr
     procedure, pass(lv) :: default => d_base_onelev_default
     procedure, pass(lv) :: free    => mld_d_base_onelev_free
@@ -151,7 +152,8 @@ module mld_d_onelev_mod
   end type mld_d_onelev_node
 
   private :: d_base_onelev_default, d_base_onelev_sizeof, &
-       &  d_base_onelev_nullify, d_base_onelev_get_nzeros
+       & d_base_onelev_nullify, d_base_onelev_get_nzeros, &
+       & d_base_onelev_clone
 
 
 
@@ -376,6 +378,30 @@ contains
   end subroutine d_base_onelev_default
 
 
+
+  subroutine d_base_onelev_clone(lv,lvout,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_d_onelev_type), target, intent(inout) :: lv 
+    class(mld_d_onelev_type), intent(out)           :: lvout
+    integer(psb_ipk_), intent(out)                  :: info 
+
+    if (allocated(lv%sm)) &
+         &   call lv%sm%clone(lvout%sm,info)
+    if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
+    if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
+    if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    lvout%base_a    => lv%base_a
+    lvout%base_desc => lv%base_desc
+    
+    return
+
+  end subroutine d_base_onelev_clone
+
+
   subroutine mld_d_onelev_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_d_prec_type.f90

@@ -90,6 +90,7 @@ module mld_d_prec_type
     procedure, pass(prec)               :: psb_d_apply2v => mld_d_apply2v
     procedure, pass(prec)               :: psb_d_apply1v => mld_d_apply1v
     procedure, pass(prec)               :: dump           => mld_d_dump
+    procedure, pass(prec)               :: clone          => mld_d_clone
     procedure, pass(prec)               :: get_complexity => mld_d_get_compl
     procedure, pass(prec)               :: cmp_complexity => mld_d_cmp_compl
     procedure, pass(prec)               :: get_nzeros => mld_d_get_nzeros
@@ -722,6 +723,42 @@ contains
 
   end subroutine mld_d_dump
 
+
+  subroutine mld_d_clone(prec,precout,info)
+
+    implicit none 
+    class(mld_dprec_type), intent(inout) :: prec
+    class(mld_dprec_type), target, intent(out)           :: precout
+    integer(psb_ipk_), intent(out)               :: info
+    ! Local vars
+    integer(psb_ipk_)  :: i, j, il1, ln, lname, lev
+    integer(psb_ipk_)  :: icontxt,iam, np
+
+    info = psb_success_
+    precout%ictxt            = prec%ictxt
+    precout%coarse_aggr_size = prec%coarse_aggr_size
+    precout%op_complexity    = prec%op_complexity
+    if (allocated(prec%precv)) then 
+      ln = size(prec%precv) 
+      allocate(precout%precv(ln),stat=info)
+      if (info /= psb_success_) goto 9999
+      if (ln > 1) then 
+        call prec%precv(1)%clone(precout%precv(1),info)
+      end if
+      do lev=2, ln
+        if (info /= psb_success_) exit
+        call prec%precv(lev)%clone(precout%precv(lev),info)
+        if (info == psb_success_) then 
+          precout%precv(lev)%base_a       => precout%precv(lev)%ac
+          precout%precv(lev)%base_desc    => precout%precv(lev)%desc_ac
+          precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
+          precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+        end if
+      end do
+    end if
+9999 continue
+  end subroutine mld_d_clone
+
   subroutine mld_dprec_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_s_onelev_mod.f90

@@ -127,6 +127,7 @@ module mld_s_onelev_mod
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_slinmap_type)           :: map
   contains
+    procedure, pass(lv) :: clone   => s_base_onelev_clone
     procedure, pass(lv) :: descr   => mld_s_base_onelev_descr
     procedure, pass(lv) :: default => s_base_onelev_default
     procedure, pass(lv) :: free    => mld_s_base_onelev_free
@@ -151,7 +152,8 @@ module mld_s_onelev_mod
   end type mld_s_onelev_node
 
   private :: s_base_onelev_default, s_base_onelev_sizeof, &
-       &  s_base_onelev_nullify, s_base_onelev_get_nzeros
+       & s_base_onelev_nullify, s_base_onelev_get_nzeros, &
+       & s_base_onelev_clone
 
 
 
@@ -376,6 +378,30 @@ contains
   end subroutine s_base_onelev_default
 
 
+
+  subroutine s_base_onelev_clone(lv,lvout,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_s_onelev_type), target, intent(inout) :: lv 
+    class(mld_s_onelev_type), intent(out)           :: lvout
+    integer(psb_ipk_), intent(out)                  :: info 
+
+    if (allocated(lv%sm)) &
+         &   call lv%sm%clone(lvout%sm,info)
+    if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
+    if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
+    if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    lvout%base_a    => lv%base_a
+    lvout%base_desc => lv%base_desc
+    
+    return
+
+  end subroutine s_base_onelev_clone
+
+
   subroutine mld_s_onelev_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_s_prec_type.f90

@@ -90,6 +90,7 @@ module mld_s_prec_type
     procedure, pass(prec)               :: psb_s_apply2v => mld_s_apply2v
     procedure, pass(prec)               :: psb_s_apply1v => mld_s_apply1v
     procedure, pass(prec)               :: dump           => mld_s_dump
+    procedure, pass(prec)               :: clone          => mld_s_clone
     procedure, pass(prec)               :: get_complexity => mld_s_get_compl
     procedure, pass(prec)               :: cmp_complexity => mld_s_cmp_compl
     procedure, pass(prec)               :: get_nzeros => mld_s_get_nzeros
@@ -722,6 +723,42 @@ contains
 
   end subroutine mld_s_dump
 
+
+  subroutine mld_s_clone(prec,precout,info)
+
+    implicit none 
+    class(mld_sprec_type), intent(inout) :: prec
+    class(mld_sprec_type), target, intent(out)           :: precout
+    integer(psb_ipk_), intent(out)               :: info
+    ! Local vars
+    integer(psb_ipk_)  :: i, j, il1, ln, lname, lev
+    integer(psb_ipk_)  :: icontxt,iam, np
+
+    info = psb_success_
+    precout%ictxt            = prec%ictxt
+    precout%coarse_aggr_size = prec%coarse_aggr_size
+    precout%op_complexity    = prec%op_complexity
+    if (allocated(prec%precv)) then 
+      ln = size(prec%precv) 
+      allocate(precout%precv(ln),stat=info)
+      if (info /= psb_success_) goto 9999
+      if (ln > 1) then 
+        call prec%precv(1)%clone(precout%precv(1),info)
+      end if
+      do lev=2, ln
+        if (info /= psb_success_) exit
+        call prec%precv(lev)%clone(precout%precv(lev),info)
+        if (info == psb_success_) then 
+          precout%precv(lev)%base_a       => precout%precv(lev)%ac
+          precout%precv(lev)%base_desc    => precout%precv(lev)%desc_ac
+          precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
+          precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+        end if
+      end do
+    end if
+9999 continue
+  end subroutine mld_s_clone
+
   subroutine mld_sprec_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_z_onelev_mod.f90

@@ -127,6 +127,7 @@ module mld_z_onelev_mod
     type(psb_desc_type), pointer     :: base_desc => null() 
     type(psb_zlinmap_type)           :: map
   contains
+    procedure, pass(lv) :: clone   => z_base_onelev_clone
     procedure, pass(lv) :: descr   => mld_z_base_onelev_descr
     procedure, pass(lv) :: default => z_base_onelev_default
     procedure, pass(lv) :: free    => mld_z_base_onelev_free
@@ -151,7 +152,8 @@ module mld_z_onelev_mod
   end type mld_z_onelev_node
 
   private :: z_base_onelev_default, z_base_onelev_sizeof, &
-       &  z_base_onelev_nullify, z_base_onelev_get_nzeros
+       & z_base_onelev_nullify, z_base_onelev_get_nzeros, &
+       & z_base_onelev_clone
 
 
 
@@ -376,6 +378,30 @@ contains
   end subroutine z_base_onelev_default
 
 
+
+  subroutine z_base_onelev_clone(lv,lvout,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_z_onelev_type), target, intent(inout) :: lv 
+    class(mld_z_onelev_type), intent(out)           :: lvout
+    integer(psb_ipk_), intent(out)                  :: info 
+
+    if (allocated(lv%sm)) &
+         &   call lv%sm%clone(lvout%sm,info)
+    if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
+    if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
+    if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
+    if (info == psb_success_) call lv%map%clone(lvout%map,info)
+    lvout%base_a    => lv%base_a
+    lvout%base_desc => lv%base_desc
+    
+    return
+
+  end subroutine z_base_onelev_clone
+
+
   subroutine mld_z_onelev_move_alloc(a, b,info)
     use psb_base_mod
     implicit none

mlprec/mld_z_prec_type.f90

@@ -90,6 +90,7 @@ module mld_z_prec_type
     procedure, pass(prec)               :: psb_z_apply2v => mld_z_apply2v
     procedure, pass(prec)               :: psb_z_apply1v => mld_z_apply1v
     procedure, pass(prec)               :: dump           => mld_z_dump
+    procedure, pass(prec)               :: clone          => mld_z_clone
     procedure, pass(prec)               :: get_complexity => mld_z_get_compl
     procedure, pass(prec)               :: cmp_complexity => mld_z_cmp_compl
     procedure, pass(prec)               :: get_nzeros => mld_z_get_nzeros
@@ -722,6 +723,42 @@ contains
 
   end subroutine mld_z_dump
 
+
+  subroutine mld_z_clone(prec,precout,info)
+
+    implicit none 
+    class(mld_zprec_type), intent(inout) :: prec
+    class(mld_zprec_type), target, intent(out)           :: precout
+    integer(psb_ipk_), intent(out)               :: info
+    ! Local vars
+    integer(psb_ipk_)  :: i, j, il1, ln, lname, lev
+    integer(psb_ipk_)  :: icontxt,iam, np
+
+    info = psb_success_
+    precout%ictxt            = prec%ictxt
+    precout%coarse_aggr_size = prec%coarse_aggr_size
+    precout%op_complexity    = prec%op_complexity
+    if (allocated(prec%precv)) then 
+      ln = size(prec%precv) 
+      allocate(precout%precv(ln),stat=info)
+      if (info /= psb_success_) goto 9999
+      if (ln > 1) then 
+        call prec%precv(1)%clone(precout%precv(1),info)
+      end if
+      do lev=2, ln
+        if (info /= psb_success_) exit
+        call prec%precv(lev)%clone(precout%precv(lev),info)
+        if (info == psb_success_) then 
+          precout%precv(lev)%base_a       => precout%precv(lev)%ac
+          precout%precv(lev)%base_desc    => precout%precv(lev)%desc_ac
+          precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
+          precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+        end if
+      end do
+    end if
+9999 continue
+  end subroutine mld_z_clone
+
   subroutine mld_zprec_move_alloc(a, b,info)
     use psb_base_mod
     implicit none