Skip to content

Commit 432b351

Browse files
committed
DONT MERGE: temp. revert
1 parent ff404b4 commit 432b351

File tree

4 files changed

+40
-120
lines changed

4 files changed

+40
-120
lines changed

femtools/Multigrid.F90

Lines changed: 1 addition & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -707,11 +707,7 @@ function Prolongator(A, epsilon, omega, maxclustersize, cluster) result (P)
707707
PetscInt:: diagminloc
708708
PetscReal:: diagmin
709709
Vec:: sqrt_diag, inv_sqrt_diag, diag, one
710-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
711710
double precision, dimension(MAT_INFO_SIZE):: matrixinfo
712-
#else
713-
MatInfo :: matrixinfo
714-
#endif
715711
integer, dimension(:), allocatable:: findN, N, R
716712
integer:: nrows, nentries, ncols
717713
integer:: jc, ccnt, base, end_of_range
@@ -720,11 +716,7 @@ function Prolongator(A, epsilon, omega, maxclustersize, cluster) result (P)
720716
call MatGetLocalSize(A, nrows, ncols, ierr)
721717
! use Petsc_Tools's MatGetInfo because of bug in earlier patch levels of petsc 3.0
722718
call MatGetInfo(A, MAT_LOCAL, matrixinfo, ierr)
723-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
724719
nentries=matrixinfo(MAT_INFO_NZ_USED)
725-
#else
726-
nentries=int(matrixinfo%nz_used)
727-
#endif
728720
call MatGetOwnerShipRange(A, base, end_of_range, ierr)
729721
! we decrease by 1, so base+i gives 0-based petsc index if i is the local fortran index:
730722
base=base-1
@@ -866,7 +858,7 @@ subroutine create_prolongator(P, nrows, ncols, findN, N, R, A, base, omega)
866858
coarse_base=coarse_base-1
867859
else
868860
call MatCreateAIJ(MPI_COMM_SELF, nrows, ncols, nrows, ncols, &
869-
0, dnnz, 0, PETSC_NULL_INTEGER_ARRAY, P, ierr)
861+
0, dnnz, 0, PETSC_NULL_INTEGER, P, ierr)
870862
call MatSetOption(P, MAT_USE_INODES, PETSC_FALSE, ierr)
871863
! subtract 1 from each cluster no to get petsc 0-based numbering
872864
coarse_base=-1
@@ -913,20 +905,13 @@ subroutine Prolongator_init(R, ccnt, findN, N, A, base, epsilon)
913905
PetscReal, intent(in):: epsilon
914906

915907
PetscErrorCode:: ierr
916-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
917908
PetscReal, dimension(:), allocatable:: vals(:)
918909
integer, dimension(:), allocatable:: cols(:)
919-
#else
920-
PetscReal, dimension(:), pointer:: vals(:)
921-
integer, dimension(:), pointer:: cols(:)
922-
#endif
923910
PetscReal aij, eps_sqrt
924911
integer i, j, k, p, ncols
925912

926-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
927913
! workspace for MatGetRow
928914
allocate( vals(1:size(N)), cols(1:size(n)) )
929-
#endif
930915

931916
eps_sqrt=sqrt(epsilon)
932917

femtools/Petsc_Tools.F90

Lines changed: 26 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -1113,7 +1113,7 @@ function CreatePrivateMatrixFromSparsity(sparsity) result (M)
11131113
end do
11141114

11151115
call MatCreateAIJ(MPI_COMM_SELF, nprows, npcols, nprows, npcols, &
1116-
0, nnz, 0, PETSC_NULL_INTEGER_ARRAY, M, ierr)
1116+
0, nnz, 0, PETSC_NULL_INTEGER, M, ierr)
11171117
call MatSetup(M, ierr)
11181118

11191119
call MatSetOption(M, MAT_USE_INODES, PETSC_FALSE, ierr)
@@ -1325,27 +1325,16 @@ function petsc2csr(matrix, column_numbering) result(A)
13251325

13261326
PetscErrorCode ierr
13271327
type(csr_sparsity) :: sparsity
1328-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
1328+
double precision, dimension(MAT_INFO_SIZE):: matrixinfo
13291329
PetscScalar, dimension(:), allocatable:: row_vals
1330-
integer, dimension(:), allocatable:: row_cols
1331-
MatInfo, dimension(MAT_INFO_SIZE):: matrixinfo
1332-
#else
1333-
PetscScalar, dimension(:), pointer:: row_vals
1334-
integer, dimension(:), pointer :: row_cols
1335-
MatInfo :: matrixinfo
1336-
#endif
1337-
integer, dimension(:), allocatable:: unn2gnn
1330+
integer, dimension(:), allocatable:: row_cols, unn2gnn
13381331
integer private_columns
13391332
integer i, j, k, ui, rows, columns, entries, ncols, offset, end_of_range
13401333
logical parallel
13411334

13421335
! get the necessary info about the matrix:
13431336
call MatGetInfo(matrix, MAT_LOCAL, matrixinfo, ierr)
1344-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
1345-
entries = matrixinfo(MAT_INFO_NZ_USED)
1346-
#else
1347-
entries = int(matrixinfo%nz_used)
1348-
#endif
1337+
entries=matrixinfo(MAT_INFO_NZ_USED)
13491338
! note we're no longer using MAT_INFO for getting local n/o rows and cols
13501339
! as it's bugged in Petsc < 3.0 and obsoloted thereafter:
13511340
call MatGetLocalSize(matrix, rows, columns, ierr)
@@ -1386,10 +1375,10 @@ function petsc2csr(matrix, column_numbering) result(A)
13861375
end if
13871376
call allocate(A, sparsity)
13881377

1389-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
1390-
allocate(row_cols(1:entries), row_vals(1:entries))
1391-
#endif
13921378
if (parallel) then
1379+
! in the parallel case we first copy in a temp. buffer
1380+
! and only insert the entries A_ij with both i *and* j local
1381+
allocate(row_cols(1:entries), row_vals(1:entries))
13931382
j=1
13941383
do i=0, rows-1
13951384
sparsity%findrm(i+1)=j
@@ -1408,30 +1397,41 @@ function petsc2csr(matrix, column_numbering) result(A)
14081397
j=j+1
14091398
end if
14101399
end do
1400+
! This is stupid, we were given copies in MatGetRow so it could
1401+
! have restored its internal tmp arrays straight away, anyway:
14111402
call MatRestoreRow(matrix, offset+i, ncols, row_cols, row_vals, ierr)
14121403
end do
14131404
A%sparsity%findrm(i+1)=j
14141405

1406+
deallocate(row_cols, row_vals)
14151407
else
14161408
! Serial case:
14171409
j=1
14181410
do i=0, rows-1
14191411
sparsity%findrm(i+1)=j
1420-
call MatGetRow(matrix, offset+i, ncols, row_cols, row_vals, ierr)
1421-
sparsity%colm(j:j+ncols-1) = row_cols(1:ncols)
1422-
A%val(j:j+ncols-1) = row_vals(1:ncols)
1412+
#ifdef DOUBLEP
1413+
call MatGetRow(matrix, offset+i, ncols, sparsity%colm(j:), A%val(j:), ierr)
14231414
j=j+ncols
1424-
call MatRestoreRow(matrix, offset+i, ncols, row_cols, row_vals, ierr)
1415+
! This is stupid, we were given copies in MatGetRow so it could
1416+
! have restored its internal tmp arrays straight away, anyway:
1417+
call MatRestoreRow(matrix, offset+i, ncols, sparsity%colm(j:), A%val(j:), ierr)
1418+
#else
1419+
allocate(row_vals(size(A%val) - j + 1))
1420+
call MatGetRow(matrix, offset+i, ncols, sparsity%colm(j:), row_vals, ierr)
1421+
A%val(j:) = row_vals
1422+
j=j+ncols
1423+
! This is stupid, we were given copies in MatGetRow so it could
1424+
! have restored its internal tmp arrays straight away, anyway:
1425+
call MatRestoreRow(matrix, offset+i, ncols, sparsity%colm(j:), row_vals, ierr)
1426+
deallocate(row_vals)
1427+
#endif
14251428
end do
14261429
A%sparsity%findrm(i+1)=j
14271430

14281431
! matrix is indexed from offset+0, colm should be indexed from 1:
14291432
sparsity%colm=sparsity%colm-offset+1
14301433

14311434
end if
1432-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
1433-
deallocate(row_cols, row_vals)
1434-
#endif
14351435
call deallocate(sparsity)
14361436

14371437
if (present(column_numbering)) then
@@ -1535,7 +1535,7 @@ function IsNullMatNullSpace(nullsp)
15351535
! MatNullSpace(0) is what is returned by MatGetNullspace if no nullspace is present
15361536
! (because a wrapper on the output is missing, and there isn't a PETSC_NULL_MATNULLSPACE
15371537
! in the first place)
1538-
IsNullMatNullSpace = nullsp%v<= 0
1538+
IsNullMatNullSpace = nullsp%v==-1 .or. nullsp%v==0
15391539

15401540
end function IsNullMatNullSpace
15411541

femtools/Solvers.F90

Lines changed: 5 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1366,16 +1366,15 @@ subroutine petsc_solve_destroy_petsc_csr(y, b, solver_option_path)
13661366

13671367
end subroutine petsc_solve_destroy_petsc_csr
13681368

1369-
subroutine ConvergenceCheck(converged_reason, iterations, name, solver_option_path, &
1369+
subroutine ConvergenceCheck(reason, iterations, name, solver_option_path, &
13701370
startfromzero, A, b, petsc_numbering, x0, vector_x0, checkconvergence, nomatrixdump)
13711371
!!< Checks reason of convergence. If negative (not converged)
13721372
!!< writes out a scary warning and dumps matrix (if first time),
13731373
!!< and if reason<0 but reason/=-3
13741374
!!< (i.e. not converged due to other reasons than reaching max_its)
13751375
!!< it sets sig_int to .true. causing the run to halt and dump
13761376
!!< at the end of the time step.
1377-
KSPConvergedReason, intent(in):: converged_reason
1378-
integer, intent(in):: iterations
1377+
integer, intent(in):: reason, iterations
13791378
!! name of the thing we're solving for, used in log output:
13801379
character(len=*), intent(in):: name
13811380
!! for new options path to solver options
@@ -1399,7 +1398,6 @@ subroutine ConvergenceCheck(converged_reason, iterations, name, solver_option_pa
13991398
PetscErrorCode ierr
14001399
character(len=30) reasons(10)
14011400
real spin_up_time, current_time
1402-
integer reason
14031401

14041402
reasons(1) = "Undefined"
14051403
reasons(2) = "KSP_DIVERGED_NULL"
@@ -1412,11 +1410,6 @@ subroutine ConvergenceCheck(converged_reason, iterations, name, solver_option_pa
14121410
reasons(9) = "KSP_DIVERGED_NAN"
14131411
reasons(10) = "KSP_DIVERGED_INDEFINITE_MAT"
14141412

1415-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
1416-
reason = converged_reason
1417-
#else
1418-
reason = converged_reason%v ! recover the (old style) numerical version (probably a bad idea)
1419-
#endif
14201413
if (reason<=0) then
14211414
if(present_and_true(nomatrixdump)) matrixdumped = .true.
14221415
if (present(checkconvergence)) then
@@ -1822,11 +1815,6 @@ recursive subroutine setup_pc_from_options(pc, pmat, option_path, &
18221815
logical, optional, intent(in) :: is_subpc
18231816

18241817
KSP:: subksp
1825-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
1826-
KSP:: subksps
1827-
#else
1828-
KSP, dimension(:), pointer :: subksps
1829-
#endif
18301818
PC:: subpc
18311819
MatNullSpace:: nullsp
18321820
PCType:: pctype, hypretype
@@ -1894,19 +1882,11 @@ recursive subroutine setup_pc_from_options(pc, pmat, option_path, &
18941882
! need to call this before the subpc can be retrieved:
18951883
call PCSetup(pc, ierr)
18961884

1897-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>=23)
1898-
nullify(subksps)
1899-
#endif
19001885
if (pctype==PCBJACOBI) then
1901-
call PCBJACOBIGetSubKSP(pc, n_local, first_local, subksps, ierr)
1886+
call PCBJACOBIGetSubKSP(pc, n_local, first_local, subksp, ierr)
19021887
else
1903-
call PCASMGetSubKSP(pc, n_local, first_local, subksps, ierr)
1888+
call PCASMGetSubKSP(pc, n_local, first_local, subksp, ierr)
19041889
end if
1905-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>=23)
1906-
subksp = subksps(1)
1907-
#else
1908-
subksp = subksps
1909-
#endif
19101890

19111891
call KSPGetPC(subksp, subpc, ierr)
19121892
! recursively call to setup the subpc
@@ -1928,15 +1908,7 @@ recursive subroutine setup_pc_from_options(pc, pmat, option_path, &
19281908
call PCSetType(pc, PCBJACOBI, ierr)
19291909
! need to call this before the subpc can be retrieved:
19301910
call PCSetup(pc, ierr)
1931-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>=23)
1932-
nullify(subksps)
1933-
#endif
1934-
call PCBJACOBIGetSubKSP(pc, n_local, first_local, subksps, ierr)
1935-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>=23)
1936-
subksp = subksps(1)
1937-
#else
1938-
subksp = subksps
1939-
#endif
1911+
call PCBJACOBIGetSubKSP(pc, n_local, first_local, subksp, ierr)
19401912
call KSPGetPC(subksp, subpc, ierr)
19411913
call PCSetType(subpc, pctype, ierr)
19421914

@@ -2012,11 +1984,7 @@ recursive subroutine setup_fieldsplit_preconditioner(pc, option_path, &
20121984
type(petsc_numbering_type), intent(in):: petsc_numbering
20131985

20141986
character(len=128):: fieldsplit_type
2015-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
20161987
KSP, dimension(size(petsc_numbering%gnn2unn,2)):: subksps
2017-
#else
2018-
KSP, dimension(:), pointer:: subksps => null()
2019-
#endif
20201988
Mat :: mat, pmat
20211989
MatNullSpace :: null_space
20221990
IS:: index_set

femtools/Sparse_Tools_Petsc.F90

Lines changed: 8 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -411,7 +411,7 @@ subroutine allocate_petsc_csr_matrix_from_nnz(matrix, rows, columns, &
411411
! Create serial block matrix:
412412
call MatCreateBAIJ(MPI_COMM_SELF, element_size, &
413413
urows, ucols, urows, ucols, &
414-
0, dnnz, 0, PETSC_NULL_INTEGER_ARRAY, matrix%M, ierr)
414+
0, dnnz, 0, PETSC_NULL_INTEGER, matrix%M, ierr)
415415

416416
elseif (use_element_blocks) then
417417

@@ -429,7 +429,7 @@ subroutine allocate_petsc_csr_matrix_from_nnz(matrix, rows, columns, &
429429

430430
! Create serial matrix:
431431
call MatCreateAIJ(MPI_COMM_SELF, urows, ucols, urows, ucols, &
432-
0, dnnz, 0, PETSC_NULL_INTEGER_ARRAY, matrix%M, ierr)
432+
0, dnnz, 0, PETSC_NULL_INTEGER, matrix%M, ierr)
433433
call MatSetBlockSizes(matrix%M, lgroup_size(1), lgroup_size(2), ierr)
434434

435435
else
@@ -735,20 +735,12 @@ function petsc_csr_entries(matrix) result (entries)
735735
integer :: entries
736736
type(petsc_csr_matrix), intent(in) :: matrix
737737

738-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
739738
double precision, dimension(MAT_INFO_SIZE):: matrixinfo
740-
#else
741-
MatInfo :: matrixinfo
742-
#endif
743739
PetscErrorCode:: ierr
744740

745741
! get the necessary info about the matrix:
746742
call MatGetInfo(matrix%M, MAT_LOCAL, matrixinfo, ierr)
747-
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR<23)
748743
entries=matrixinfo(MAT_INFO_NZ_USED)
749-
#else
750-
entries=int(matrixinfo%nz_used)
751-
#endif
752744

753745
end function petsc_csr_entries
754746

@@ -780,26 +772,6 @@ subroutine petsc_csr_addto(matrix, blocki, blockj, i, j, val)
780772

781773
end subroutine petsc_csr_addto
782774

783-
subroutine fix_column_numbers(idxm, idxn)
784-
! for some rows that we are not assembling (indicated with negative index)
785-
! the column indices are not reliable, as they are outside any halo and thus
786-
! have not been filled in in the gnn2unn numbering (we don't know their universal petsc number)
787-
! this is fine because we're telling petsc to skip these entries (with a negative row index)
788-
! but the random column index may still trip some internal petsc checks
789-
! therefore here we set these to negative as well
790-
791-
PetscInt, dimension(:), intent(in) :: idxm ! row numbers
792-
PetscInt, dimension(:), intent(inout) :: idxn ! column numbers
793-
integer i
794-
795-
do i=1, size(idxm)
796-
if (idxm(i)<0) then
797-
idxn(i) = -1
798-
end if
799-
end do
800-
801-
end subroutine fix_column_numbers
802-
803775
subroutine petsc_csr_vaddto(matrix, blocki, blockj, i, j, val)
804776
!!< Add multiple values to matrix(blocki, blockj, i,j)
805777
type(petsc_csr_matrix), intent(inout) :: matrix
@@ -813,10 +785,8 @@ subroutine petsc_csr_vaddto(matrix, blocki, blockj, i, j, val)
813785

814786
idxm=matrix%row_numbering%gnn2unn(i,blocki)
815787
idxn=matrix%column_numbering%gnn2unn(j,blockj)
816-
call fix_column_numbers(idxm, idxn)
817788

818-
call MatSetValues(matrix%M, size(i), idxm, size(j), idxn, &
819-
real(reshape(val, (/ size(val) /)), kind=PetscScalar_kind), &
789+
call MatSetValues(matrix%M, size(i), idxm, size(j), idxn, real(val, kind=PetscScalar_kind), &
820790
ADD_VALUES, ierr)
821791

822792
matrix%is_assembled=.false.
@@ -837,10 +807,9 @@ subroutine petsc_csr_block_addto(matrix, i, j, val)
837807

838808
idxm=matrix%row_numbering%gnn2unn(i,:)
839809
idxn=matrix%column_numbering%gnn2unn(j,:)
840-
call fix_column_numbers(idxm, idxn)
841810

842811
call MatSetValues(matrix%M, size(idxm), idxm, size(idxn), idxn, &
843-
real(reshape(val, (/ size(val) /)), kind=PetscScalar_kind), ADD_VALUES, ierr)
812+
real(val, kind=PetscScalar_kind), ADD_VALUES, ierr)
844813

845814
matrix%is_assembled=.false.
846815

@@ -855,7 +824,7 @@ subroutine petsc_csr_blocks_addto(matrix, i, j, val)
855824
integer, dimension(:), intent(in) :: j
856825
real, dimension(:,:,:,:), intent(in) :: val
857826

858-
PetscScalar, dimension(size(i)*size(j)):: value
827+
PetscScalar, dimension(size(i), size(j)):: value
859828
PetscInt, dimension(size(i)):: idxm
860829
PetscInt, dimension(size(j)):: idxn
861830
PetscErrorCode:: ierr
@@ -865,9 +834,8 @@ subroutine petsc_csr_blocks_addto(matrix, i, j, val)
865834
idxm=matrix%row_numbering%gnn2unn(i,blocki)
866835
do blockj=1, size(matrix%column_numbering%gnn2unn,2)
867836
idxn=matrix%column_numbering%gnn2unn(j,blockj)
868-
call fix_column_numbers(idxm, idxn)
869837
! unfortunately we need a copy here to pass contiguous memory
870-
value=reshape(val(blocki, blockj, :, :), (/ size(value) /))
838+
value=val(blocki, blockj, :, :)
871839
call MatSetValues(matrix%M, size(i), idxm, size(j), idxn, &
872840
value, ADD_VALUES, ierr)
873841
end do
@@ -887,7 +855,7 @@ subroutine petsc_csr_blocks_addto_withmask(matrix, i, j, val, block_mask)
887855
real, dimension(:,:,:,:), intent(in) :: val
888856
logical, dimension(:,:), intent(in) :: block_mask
889857

890-
PetscScalar, dimension(size(i)*size(j)):: value
858+
PetscScalar, dimension(size(i), size(j)):: value
891859
PetscInt, dimension(size(i)):: idxm
892860
PetscInt, dimension(size(j)):: idxn
893861
PetscErrorCode:: ierr
@@ -898,9 +866,8 @@ subroutine petsc_csr_blocks_addto_withmask(matrix, i, j, val, block_mask)
898866
do blockj=1, size(matrix%column_numbering%gnn2unn,2)
899867
if (block_mask(blocki,blockj)) then
900868
idxn=matrix%column_numbering%gnn2unn(j,blockj)
901-
call fix_column_numbers(idxm, idxn)
902869
! unfortunately we need a copy here to pass contiguous memory
903-
value=reshape(val(blocki, blockj, :, :), (/ size(value) /))
870+
value=val(blocki, blockj, :, :)
904871
call MatSetValues(matrix%M, size(i), idxm, size(j), idxn, &
905872
value, ADD_VALUES, ierr)
906873
end if

0 commit comments

Comments
 (0)