fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Avoid warnings on ALLOCATE by using tmp_aggr object,

Browse Source
This commit is contained in:
Salvatore Filippone
2018-07-30 12:18:16 +01:00
parent 9184e29ba3
commit 9de544f540
4 changed files with 56 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/mld_c_hierarchy_bld.f90
+14 -8
View File
@@ -226,13 +226,18 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
& prec%precv(i)%sm,prec%precv(i)%sm2a,info)
if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr)
end do
! Further intermediates, if any
do i=iszv-1, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tprecv(iszv-1)%aggr,stat=info)
end do
if (iszv < nplevs) then
allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info)
! Further intermediates, if any
do i=iszv, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tmp_aggr,stat=info)
end do
deallocate(tmp_aggr,stat=info)
end if
! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -240,7 +245,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
if (nplevs <= iszv) then
allocate(tprecv(nplevs)%aggr,source=prec%precv(nplevs)%aggr,stat=info)
else
allocate(tprecv(nplevs)%aggr,source=tprecv(nplevs-1)%aggr,stat=info)
allocate(tmp_aggr,source=tprecv(nplevs-1)%aggr,stat=info)
call move_alloc(tmp_aggr,tprecv(nplevs)%aggr)
end if
end if
if (info /= psb_success_) then
mlprec/impl/mld_d_hierarchy_bld.f90
+14 -8
View File
@@ -226,13 +226,18 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
& prec%precv(i)%sm,prec%precv(i)%sm2a,info)
if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr)
end do
! Further intermediates, if any
do i=iszv-1, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tprecv(iszv-1)%aggr,stat=info)
end do
if (iszv < nplevs) then
allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info)
! Further intermediates, if any
do i=iszv, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tmp_aggr,stat=info)
end do
deallocate(tmp_aggr,stat=info)
end if
! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -240,7 +245,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
if (nplevs <= iszv) then
allocate(tprecv(nplevs)%aggr,source=prec%precv(nplevs)%aggr,stat=info)
else
allocate(tprecv(nplevs)%aggr,source=tprecv(nplevs-1)%aggr,stat=info)
allocate(tmp_aggr,source=tprecv(nplevs-1)%aggr,stat=info)
call move_alloc(tmp_aggr,tprecv(nplevs)%aggr)
end if
end if
if (info /= psb_success_) then
mlprec/impl/mld_s_hierarchy_bld.f90
+14 -8
View File
@@ -226,13 +226,18 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
& prec%precv(i)%sm,prec%precv(i)%sm2a,info)
if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr)
end do
! Further intermediates, if any
do i=iszv-1, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tprecv(iszv-1)%aggr,stat=info)
end do
if (iszv < nplevs) then
allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info)
! Further intermediates, if any
do i=iszv, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tmp_aggr,stat=info)
end do
deallocate(tmp_aggr,stat=info)
end if
! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -240,7 +245,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
if (nplevs <= iszv) then
allocate(tprecv(nplevs)%aggr,source=prec%precv(nplevs)%aggr,stat=info)
else
allocate(tprecv(nplevs)%aggr,source=tprecv(nplevs-1)%aggr,stat=info)
allocate(tmp_aggr,source=tprecv(nplevs-1)%aggr,stat=info)
call move_alloc(tmp_aggr,tprecv(nplevs)%aggr)
end if
end if
if (info /= psb_success_) then
mlprec/impl/mld_z_hierarchy_bld.f90
+14 -8
View File
@@ -226,13 +226,18 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
& prec%precv(i)%sm,prec%precv(i)%sm2a,info)
if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr)
end do
! Further intermediates, if any
do i=iszv-1, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tprecv(iszv-1)%aggr,stat=info)
end do
if (iszv < nplevs) then
allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info)
! Further intermediates, if any
do i=iszv, nplevs - 1
if (info == 0) tprecv(i)%parms = medparms
if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info)
if ((info == 0).and..not.allocated(tprecv(i)%aggr))&
& allocate(tprecv(i)%aggr,source=tmp_aggr,stat=info)
end do
deallocate(tmp_aggr,stat=info)
end if
! Then coarse
if (info == 0) tprecv(nplevs)%parms = coarseparms
if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info)
@@ -240,7 +245,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
if (nplevs <= iszv) then
allocate(tprecv(nplevs)%aggr,source=prec%precv(nplevs)%aggr,stat=info)
else
allocate(tprecv(nplevs)%aggr,source=tprecv(nplevs-1)%aggr,stat=info)
allocate(tmp_aggr,source=tprecv(nplevs-1)%aggr,stat=info)
call move_alloc(tmp_aggr,tprecv(nplevs)%aggr)
end if
end if
if (info /= psb_success_) then