Added level%allocate_wrk. Fix wrksize calculation.

7 years ago · 08040c455b
parent f982986a1c
commit 08040c455b
8 changed files with 128 additions and 20 deletions
--- a/mlprec/mld_c_onelev_mod.f90
+++ b/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
--- a/mlprec/mld_c_prec_type.f90
+++ b/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)
--- a/mlprec/mld_d_onelev_mod.f90
+++ b/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
--- a/mlprec/mld_d_prec_type.f90
+++ b/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)
--- a/mlprec/mld_s_onelev_mod.f90
+++ b/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
--- a/mlprec/mld_s_prec_type.f90
+++ b/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)
--- a/mlprec/mld_z_onelev_mod.f90
+++ b/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
--- a/mlprec/mld_z_prec_type.f90
+++ b/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)