Added level%allocate_wrk. Fix wrksize calculation.

mlprec/mld_c_onelev_mod.f90

@@ -163,6 +163,8 @@ module mld_c_onelev_mod
     procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
+    procedure, pass(lv) :: allocate_wrk   => c_base_onelev_allocate_wrk
+    procedure, pass(lv) :: free_wrk       => c_base_onelev_free_wrk
     procedure, nopass   :: stringval => mld_stringval
     procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
   end type mld_c_onelev_type
@@ -175,7 +177,7 @@ module mld_c_onelev_mod
   private :: c_base_onelev_default, c_base_onelev_sizeof, &
        & c_base_onelev_nullify, c_base_onelev_get_nzeros, &
        & c_base_onelev_clone, c_base_onelev_move_alloc, &
-       & c_base_onelev_get_wrksize
+       & c_base_onelev_get_wrksize, c_base_onelev_allocate_wrk, c_base_onelev_free_wrk
 
 
 
@@ -540,13 +542,13 @@ contains
   
   function c_base_onelev_get_wrksize(lv) result(val)
     implicit none 
-    class(mld_c_base_onelev_type), intent(inout) :: lv
+    class(mld_c_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
     val = 0
     ! SM and SM2A can share work vectors
-    if (allocated(lv%sm))   val = val + sm%get_wrksz()
-    if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz())
+    if (allocated(lv%sm))   val = val + lv%sm%get_wrksz()
+    if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz())
     !
     ! Now for the ML application itself
     !
@@ -572,6 +574,29 @@ contains
     end select
     
   end function c_base_onelev_get_wrksize
+
+  subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
+    use psb_base_mod
+    implicit none
+    class(mld_c_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    class(psb_c_base_vect_type), intent(in), optional  :: vmold
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+    nwv = lv%get_wrksz()
+    write(0,*) 'Debug allocate_wrk: ',nwv
+  end subroutine c_base_onelev_allocate_wrk
+
   
-  
+  subroutine c_base_onelev_free_wrk(lv,info)
+    use psb_base_mod
+    implicit none
+    class(mld_c_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+  end subroutine c_base_onelev_free_wrk
+    
 end module mld_c_onelev_mod

mlprec/mld_c_prec_type.f90

@@ -851,6 +851,7 @@ contains
     end if
     level = 1
     do level = 1, nlev
+      call prec%precv(level)%allocate_wrk(info,vmold=vmold)
       call psb_geasb(prec%wrk(level)%vx2l,&
            & prec%precv(level)%base_desc,info,&
            & scratch=.true.,mold=vmold)
@@ -909,6 +910,7 @@ contains
       nlev   = size(prec%wrk)  
 
       do level = 1, nlev
+        call prec%precv(level)%free_wrk(info)
         !write(0,*) 'Free at level ',level,': x2,y2,tx,ty'
         call prec%wrk(level)%vx2l%free(info)
         call prec%wrk(level)%vy2l%free(info)

mlprec/mld_d_onelev_mod.f90

@@ -163,6 +163,8 @@ module mld_d_onelev_mod
     procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
+    procedure, pass(lv) :: allocate_wrk   => d_base_onelev_allocate_wrk
+    procedure, pass(lv) :: free_wrk       => d_base_onelev_free_wrk
     procedure, nopass   :: stringval => mld_stringval
     procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
   end type mld_d_onelev_type
@@ -175,7 +177,7 @@ module mld_d_onelev_mod
   private :: d_base_onelev_default, d_base_onelev_sizeof, &
        & d_base_onelev_nullify, d_base_onelev_get_nzeros, &
        & d_base_onelev_clone, d_base_onelev_move_alloc, &
-       & d_base_onelev_get_wrksize
+       & d_base_onelev_get_wrksize, d_base_onelev_allocate_wrk, d_base_onelev_free_wrk
 
 
 
@@ -540,13 +542,13 @@ contains
   
   function d_base_onelev_get_wrksize(lv) result(val)
     implicit none 
-    class(mld_d_base_onelev_type), intent(inout) :: lv
+    class(mld_d_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
     val = 0
     ! SM and SM2A can share work vectors
-    if (allocated(lv%sm))   val = val + sm%get_wrksz()
-    if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz())
+    if (allocated(lv%sm))   val = val + lv%sm%get_wrksz()
+    if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz())
     !
     ! Now for the ML application itself
     !
@@ -572,6 +574,29 @@ contains
     end select
     
   end function d_base_onelev_get_wrksize
+
+  subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
+    use psb_base_mod
+    implicit none
+    class(mld_d_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    class(psb_d_base_vect_type), intent(in), optional  :: vmold
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+    nwv = lv%get_wrksz()
+    write(0,*) 'Debug allocate_wrk: ',nwv
+  end subroutine d_base_onelev_allocate_wrk
+
   
-  
+  subroutine d_base_onelev_free_wrk(lv,info)
+    use psb_base_mod
+    implicit none
+    class(mld_d_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+  end subroutine d_base_onelev_free_wrk
+    
 end module mld_d_onelev_mod

mlprec/mld_d_prec_type.f90

@@ -851,6 +851,7 @@ contains
     end if
     level = 1
     do level = 1, nlev
+      call prec%precv(level)%allocate_wrk(info,vmold=vmold)
       call psb_geasb(prec%wrk(level)%vx2l,&
            & prec%precv(level)%base_desc,info,&
            & scratch=.true.,mold=vmold)
@@ -909,6 +910,7 @@ contains
       nlev   = size(prec%wrk)  
 
       do level = 1, nlev
+        call prec%precv(level)%free_wrk(info)
         !write(0,*) 'Free at level ',level,': x2,y2,tx,ty'
         call prec%wrk(level)%vx2l%free(info)
         call prec%wrk(level)%vy2l%free(info)

mlprec/mld_s_onelev_mod.f90

@@ -163,6 +163,8 @@ module mld_s_onelev_mod
     procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
+    procedure, pass(lv) :: allocate_wrk   => s_base_onelev_allocate_wrk
+    procedure, pass(lv) :: free_wrk       => s_base_onelev_free_wrk
     procedure, nopass   :: stringval => mld_stringval
     procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
   end type mld_s_onelev_type
@@ -175,7 +177,7 @@ module mld_s_onelev_mod
   private :: s_base_onelev_default, s_base_onelev_sizeof, &
        & s_base_onelev_nullify, s_base_onelev_get_nzeros, &
        & s_base_onelev_clone, s_base_onelev_move_alloc, &
-       & s_base_onelev_get_wrksize
+       & s_base_onelev_get_wrksize, s_base_onelev_allocate_wrk, s_base_onelev_free_wrk
 
 
 
@@ -540,13 +542,13 @@ contains
   
   function s_base_onelev_get_wrksize(lv) result(val)
     implicit none 
-    class(mld_s_base_onelev_type), intent(inout) :: lv
+    class(mld_s_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
     val = 0
     ! SM and SM2A can share work vectors
-    if (allocated(lv%sm))   val = val + sm%get_wrksz()
-    if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz())
+    if (allocated(lv%sm))   val = val + lv%sm%get_wrksz()
+    if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz())
     !
     ! Now for the ML application itself
     !
@@ -572,6 +574,29 @@ contains
     end select
     
   end function s_base_onelev_get_wrksize
+
+  subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
+    use psb_base_mod
+    implicit none
+    class(mld_s_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    class(psb_s_base_vect_type), intent(in), optional  :: vmold
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+    nwv = lv%get_wrksz()
+    write(0,*) 'Debug allocate_wrk: ',nwv
+  end subroutine s_base_onelev_allocate_wrk
+
   
-  
+  subroutine s_base_onelev_free_wrk(lv,info)
+    use psb_base_mod
+    implicit none
+    class(mld_s_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+  end subroutine s_base_onelev_free_wrk
+    
 end module mld_s_onelev_mod

mlprec/mld_s_prec_type.f90

@@ -851,6 +851,7 @@ contains
     end if
     level = 1
     do level = 1, nlev
+      call prec%precv(level)%allocate_wrk(info,vmold=vmold)
       call psb_geasb(prec%wrk(level)%vx2l,&
            & prec%precv(level)%base_desc,info,&
            & scratch=.true.,mold=vmold)
@@ -909,6 +910,7 @@ contains
       nlev   = size(prec%wrk)  
 
       do level = 1, nlev
+        call prec%precv(level)%free_wrk(info)
         !write(0,*) 'Free at level ',level,': x2,y2,tx,ty'
         call prec%wrk(level)%vx2l%free(info)
         call prec%wrk(level)%vy2l%free(info)

mlprec/mld_z_onelev_mod.f90

@@ -163,6 +163,8 @@ module mld_z_onelev_mod
     procedure, pass(lv) :: sizeof => z_base_onelev_sizeof
     procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros
     procedure, pass(lv) :: get_wrksz => z_base_onelev_get_wrksize
+    procedure, pass(lv) :: allocate_wrk   => z_base_onelev_allocate_wrk
+    procedure, pass(lv) :: free_wrk       => z_base_onelev_free_wrk
     procedure, nopass   :: stringval => mld_stringval
     procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc
   end type mld_z_onelev_type
@@ -175,7 +177,7 @@ module mld_z_onelev_mod
   private :: z_base_onelev_default, z_base_onelev_sizeof, &
        & z_base_onelev_nullify, z_base_onelev_get_nzeros, &
        & z_base_onelev_clone, z_base_onelev_move_alloc, &
-       & z_base_onelev_get_wrksize
+       & z_base_onelev_get_wrksize, z_base_onelev_allocate_wrk, z_base_onelev_free_wrk
 
 
 
@@ -540,13 +542,13 @@ contains
   
   function z_base_onelev_get_wrksize(lv) result(val)
     implicit none 
-    class(mld_z_base_onelev_type), intent(inout) :: lv
+    class(mld_z_onelev_type), intent(inout) :: lv
     integer(psb_ipk_)  :: val
 
     val = 0
     ! SM and SM2A can share work vectors
-    if (allocated(lv%sm))   val = val + sm%get_wrksz()
-    if (allocated(lv%sm2a)) val = max(val,sm2a%get_wrksz())
+    if (allocated(lv%sm))   val = val + lv%sm%get_wrksz()
+    if (allocated(lv%sm2a)) val = max(val,lv%sm2a%get_wrksz())
     !
     ! Now for the ML application itself
     !
@@ -572,6 +574,29 @@ contains
     end select
     
   end function z_base_onelev_get_wrksize
+
+  subroutine z_base_onelev_allocate_wrk(lv,info,vmold)
+    use psb_base_mod
+    implicit none
+    class(mld_z_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    class(psb_z_base_vect_type), intent(in), optional  :: vmold
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+    nwv = lv%get_wrksz()
+    write(0,*) 'Debug allocate_wrk: ',nwv
+  end subroutine z_base_onelev_allocate_wrk
+
   
-  
+  subroutine z_base_onelev_free_wrk(lv,info)
+    use psb_base_mod
+    implicit none
+    class(mld_z_onelev_type), target, intent(inout) :: lv
+    integer(psb_ipk_), intent(out) :: info 
+    !
+    integer(psb_ipk_) :: nwv
+    info = psb_success_
+  end subroutine z_base_onelev_free_wrk
+    
 end module mld_z_onelev_mod

mlprec/mld_z_prec_type.f90

@@ -851,6 +851,7 @@ contains
     end if
     level = 1
     do level = 1, nlev
+      call prec%precv(level)%allocate_wrk(info,vmold=vmold)
       call psb_geasb(prec%wrk(level)%vx2l,&
            & prec%precv(level)%base_desc,info,&
            & scratch=.true.,mold=vmold)
@@ -909,6 +910,7 @@ contains
       nlev   = size(prec%wrk)  
 
       do level = 1, nlev
+        call prec%precv(level)%free_wrk(info)
         !write(0,*) 'Free at level ',level,': x2,y2,tx,ty'
         call prec%wrk(level)%vx2l%free(info)
         call prec%wrk(level)%vy2l%free(info)