phynexis-deps/arpack-ng
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

gcc-10 (parpack) and mpich (#245)

Browse Source 
* port PARPACK also to gcc 10

* Ensure that the output buffer is a rank-1 vector

The vector should also not be a temporary, so that we
can use the result.

* use valid address of binary

openmpi ignores this error, but mpich doesn't

* Add travis test with gcc 10 and mpich

* After pulling fedora:rawhide, use fedora:rawhide

* simplify travis tests for fedora

* run using bash -v (permissions issue otherwise)

* run using bash -v (permissions issue otherwise)

* fix permission of script

* Add she-bang to allow execution

* fix test for fedora

Co-authored-by: Sylvestre Ledru <sledru@mozilla.com>
This commit is contained in:
dschwoerer
2020-02-24 10:05:43 +01:00
committed by GitHub
co-authored by Sylvestre Ledru
parent 3dd2d5fe97
commit ad82dcbc0b
90 changed files with 487 additions and 440 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+4
View File
@@ -73,3 +73,7 @@ PARPACK/TESTS/MPI/issue46
*.suo
VISUAL_STUDIO/Release MKL/
VISUAL_STUDIO/bin/
# Temporary files
*~
\#*#
.travis.yml
+8 -34
View File
@@ -29,6 +29,7 @@ services:
stages:
# order stages
- name: fedora
- name: osx
- name: precise
- name: trusty
@@ -36,7 +37,6 @@ stages:
- name: bionic
- name: coverage
- name: interface64
- name: fedora
jobs:
include:
@@ -265,41 +265,15 @@ jobs:
sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp \
&& \
sudo docker start -a mobydick
# fedora
# note: when you PR, docker-cp provides, in the container, the branch associated with the PR (not master where there's nothing new)
# 1. docker create --name mobydick IMAGE CMD <=> create a container (= instance of image) but container is NOT yet started
# 2. docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp <=> copy git repository (CI worker, checkout-ed on PR branch) into the container
# note: docker-cp works only if copy from/to containers (not images)
# 3. docker start -a mobydick <=> start to run the container (initialized with docker-cp)
# fedora (released fedora with openmpi)
- stage: fedora
dist: xenial
script: |
sudo docker pull registry.fedoraproject.org/fedora || sudo docker pull fedora \
&& \
sudo docker create --name mobydick fedora /bin/bash -c \
"dnf -y upgrade && \
dnf -y groupinstall \"Development Tools\" \"Development Libraries\" && \
dnf -y install environment-modules \
gcc gcc-c++ gcc-gfortran git cmake make \
openmpi openmpi-devel openblas openblas-devel && \
. /etc/profile.d/modules.sh && \
module avail && \
module load mpi/openmpi-x86_64 && \
cd /tmp && \
cd arpack-ng && \
git status && \
git log -2 && \
sed -e 's/mpirun /mpirun --allow-run-as-root --oversubscribe /' -i CMakeLists.txt && \
mkdir -p build && cd build && \
cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON .. && \
export VERBOSE=1 && \
make all && \
make test && \
tail -n 300 ./Testing/Temporary/LastTest.log" \
&& \
sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp \
&& \
sudo docker start -a mobydick
script: ./scripts/travis_fedora.sh setup openmpi latest
# fedora (with gcc 10 and mpich)
- stage: fedora
dist: xenial
script: ./scripts/travis_fedora.sh setup mpich rawhide
after_failure:
CMakeLists.txt
+1 -1
View File
@@ -60,7 +60,7 @@ function(pexamples list_name)
get_filename_component(lwe ${l} NAME_WE)
add_executable(${lwe} ${parpackexample_DIR}/${l} )
target_link_libraries(${lwe} parpack arpack ${MPI_Fortran_LIBRARIES})
add_test(NAME "${lwe}_ex" COMMAND mpirun -n 2 ${lwe} WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY})
add_test(NAME "${lwe}_ex" COMMAND mpirun -n 2 ./${lwe} WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY})
endforeach()
endfunction(pexamples)
PARPACK/SRC/BLACS/pcgetv0.f
+2 -2
View File
@@ -406,9 +406,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
call psvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
PARPACK/SRC/BLACS/pcnaitr.f
+4 -4
View File
@@ -401,9 +401,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call pcvout (comm, logfil, 1, rnorm, ndigit,
call pcvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -423,7 +423,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -757,7 +757,7 @@ c
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
PARPACK/SRC/BLACS/pcnapps.f
+7 -7
View File
@@ -284,9 +284,9 @@ c
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call pcvout (comm, logfil, 1, sigma, ndigit,
call pcvout (comm, logfil, 1, [sigma], ndigit,
& '_napps: Value of the shift ')
end if
c
@@ -307,9 +307,9 @@ c
if ( abs(real(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call pcvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -323,9 +323,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -501,7 +501,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pcvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pcmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/BLACS/pcnaup2.f
+7 -7
View File
@@ -398,7 +398,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -411,9 +411,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -440,7 +440,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -671,7 +671,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -711,7 +711,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call pcvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
@@ -776,7 +776,7 @@ c
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pcmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/BLACS/pcnaupd.f
+2 -2
View File
@@ -618,9 +618,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pcvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
PARPACK/SRC/BLACS/pcneupd.f
+2 -2
View File
@@ -558,9 +558,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/BLACS/pcngets.f
+2 -2
View File
@@ -177,8 +177,8 @@ c
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call pcvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pcvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/BLACS/pdgetv0.f
+3 -3
View File
@@ -385,9 +385,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
call pdvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -418,7 +418,7 @@ c
50 continue
c
if (msglvl .gt. 0) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/BLACS/pdnaitr.f
+4 -4
View File
@@ -390,9 +390,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -412,7 +412,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -745,7 +745,7 @@ c
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/BLACS/pdnapps.f
+7 -7
View File
@@ -276,11 +276,11 @@ c
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call pdvout (comm, logfil, 1, sigmar, ndigit,
call pdvout (comm, logfil, 1, [sigmar], ndigit,
& '_napps: The real part of the shift ')
call pdvout (comm, logfil, 1, sigmai, ndigit,
call pdvout (comm, logfil, 1, [sigmai], ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
@@ -347,7 +347,7 @@ c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call pdvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -361,9 +361,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -635,7 +635,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pdvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pdmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/BLACS/pdnaup2.f
+7 -7
View File
@@ -405,7 +405,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -418,9 +418,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -452,7 +452,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -696,7 +696,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -748,7 +748,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
@@ -815,7 +815,7 @@ c
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pdmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/BLACS/pdnaupd.f
+2 -2
View File
@@ -642,9 +642,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pdvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
PARPACK/SRC/BLACS/pdneupd.f
+2 -2
View File
@@ -617,9 +617,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/BLACS/pdngets.f
+2 -2
View File
@@ -226,8 +226,8 @@ c
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call pdvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call pdvout (comm, logfil, kev+np, ritzi, ndigit,
PARPACK/SRC/BLACS/pdsaitr.f
+4 -4
View File
@@ -389,9 +389,9 @@ c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: generating Arnoldi vector no.')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
@@ -409,7 +409,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: ****** restart at step ******')
end if
c
@@ -767,7 +767,7 @@ c
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/BLACS/pdsapps.f
+3 -3
View File
@@ -272,9 +272,9 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_sapps: occurred before shift number.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
@@ -443,7 +443,7 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
PARPACK/SRC/BLACS/pdsaup2.f
+7 -7
View File
@@ -421,13 +421,13 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
@@ -466,7 +466,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
@@ -716,7 +716,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -763,7 +763,7 @@ c
if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
@@ -831,7 +831,7 @@ c
130 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call pdvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
PARPACK/SRC/BLACS/pdsaupd.f
+2 -2
View File
@@ -644,9 +644,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saupd: number of "converged" Ritz values')
call pdvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
PARPACK/SRC/BLACS/pdseupd.f
+2 -2
View File
@@ -523,9 +523,9 @@ c | caused by incorrect passing of the _saupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/BLACS/pdsgets.f
+2 -2
View File
@@ -216,8 +216,8 @@ c
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is')
call pdvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call pdvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/BLACS/psgetv0.f
+3 -3
View File
@@ -385,9 +385,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
call psvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -418,7 +418,7 @@ c
50 continue
c
if (msglvl .gt. 0) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/BLACS/psnaitr.f
+4 -4
View File
@@ -390,9 +390,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -412,7 +412,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -745,7 +745,7 @@ c
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/BLACS/psnapps.f
+7 -7
View File
@@ -276,11 +276,11 @@ c
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call psvout (comm, logfil, 1, sigmar, ndigit,
call psvout (comm, logfil, 1, [sigmar], ndigit,
& '_napps: The real part of the shift ')
call psvout (comm, logfil, 1, sigmai, ndigit,
call psvout (comm, logfil, 1, [sigmai], ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
@@ -347,7 +347,7 @@ c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call psvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -361,9 +361,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -635,7 +635,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call psvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call psmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/BLACS/psnaup2.f
+7 -7
View File
@@ -405,7 +405,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -418,9 +418,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -452,7 +452,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -696,7 +696,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -748,7 +748,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call psvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
@@ -815,7 +815,7 @@ c
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call psmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/BLACS/psnaupd.f
+2 -2
View File
@@ -642,9 +642,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call psvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
PARPACK/SRC/BLACS/psneupd.f
+2 -2
View File
@@ -617,9 +617,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/BLACS/psngets.f
+2 -2
View File
@@ -226,8 +226,8 @@ c
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call psvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call psvout (comm, logfil, kev+np, ritzi, ndigit,
PARPACK/SRC/BLACS/pssaitr.f
+4 -4
View File
@@ -389,9 +389,9 @@ c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: generating Arnoldi vector no.')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
@@ -409,7 +409,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: ****** restart at step ******')
end if
c
@@ -767,7 +767,7 @@ c
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/BLACS/pssapps.f
+3 -3
View File
@@ -272,9 +272,9 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_sapps: occurred before shift number.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
@@ -443,7 +443,7 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
PARPACK/SRC/BLACS/pssaup2.f
+7 -7
View File
@@ -421,13 +421,13 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
@@ -466,7 +466,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
@@ -716,7 +716,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -763,7 +763,7 @@ c
if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: The number of shifts to apply ')
call psvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
@@ -831,7 +831,7 @@ c
130 continue
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call psvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
PARPACK/SRC/BLACS/pssaupd.f
+2 -2
View File
@@ -644,9 +644,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saupd: number of "converged" Ritz values')
call psvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
PARPACK/SRC/BLACS/psseupd.f
+2 -2
View File
@@ -523,9 +523,9 @@ c | caused by incorrect passing of the _saupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/BLACS/pssgets.f
+2 -2
View File
@@ -216,8 +216,8 @@ c
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is')
call psvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call psvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/BLACS/pzgetv0.f
+3 -3
View File
@@ -406,9 +406,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
call pdvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -440,7 +440,7 @@ c
c
if (msglvl .gt. 0) then
cnorm2 = dcmplx (rnorm,rzero)
call pzvout (comm, logfil, 1, cnorm2, ndigit,
call pzvout (comm, logfil, 1, [cnorm2], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/BLACS/pznaitr.f
+4 -4
View File
@@ -401,9 +401,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call pzvout (comm, logfil, 1, rnorm, ndigit,
call pzvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -423,7 +423,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -757,7 +757,7 @@ c
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
PARPACK/SRC/BLACS/pznapps.f
+7 -7
View File
@@ -284,9 +284,9 @@ c
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call pzvout (comm, logfil, 1, sigma, ndigit,
call pzvout (comm, logfil, 1, [sigma], ndigit,
& '_napps: Value of the shift ')
end if
c
@@ -307,9 +307,9 @@ c
if ( abs(dble(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call pzvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -323,9 +323,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -501,7 +501,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pzvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pzmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/BLACS/pznaup2.f
+7 -7
View File
@@ -398,7 +398,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -411,9 +411,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -440,7 +440,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -671,7 +671,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -711,7 +711,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call pzvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
@@ -776,7 +776,7 @@ c
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pzmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/BLACS/pznaupd.f
+2 -2
View File
@@ -618,9 +618,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pzvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
PARPACK/SRC/BLACS/pzneupd.f
+2 -2
View File
@@ -558,9 +558,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/BLACS/pzngets.f
+2 -2
View File
@@ -177,8 +177,8 @@ c
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call pzvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pzvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/MPI/pcgetv0.f
+8 -6
View File
@@ -185,7 +185,7 @@ c
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Complex
& cnorm_buf
& cnorm_buf, buf2(1)
c
c %----------------------%
c | External Subroutines |
@@ -332,8 +332,9 @@ c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm0 = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = pscnorm2( comm, n, resid, 1)
@@ -393,8 +394,9 @@ c
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
@@ -405,9 +407,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
call psvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -439,7 +441,7 @@ c
c
if (msglvl .gt. 0) then
cnorm2 = cmplx(rnorm,rzero)
call pcvout (comm, logfil, 1, cnorm2, ndigit,
call pcvout (comm, logfil, 1, [cnorm2], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/MPI/pcnaitr.f
+11 -8
View File
@@ -293,7 +293,7 @@ c
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Complex
& cnorm_buf
& cnorm_buf, buf2(1)
c
c %----------------------%
c | External Subroutines |
@@ -404,9 +404,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call pcvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -426,7 +426,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -577,8 +577,9 @@ c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = pscnorm2(comm, n, resid, 1)
@@ -653,8 +654,9 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
@@ -757,15 +759,16 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = pscnorm2(comm, n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
PARPACK/SRC/MPI/pcnapps.f
+7 -7
View File
@@ -283,9 +283,9 @@ c
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call pcvout (comm, logfil, 1, sigma, ndigit,
call pcvout (comm, logfil, 1, [sigma], ndigit,
& '_napps: Value of the shift ')
end if
c
@@ -306,9 +306,9 @@ c
if ( abs(real(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call pcvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -322,9 +322,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -500,7 +500,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pcvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pcmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/MPI/pcnaup2.f
+10 -9
View File
@@ -237,7 +237,7 @@ c
& nevbef, nev0 , np0, eps23
c
Real
& cmpnorm_buf
& cmpnorm_buf, buf2(1)
c
c %-----------------------%
c | Local array arguments |
@@ -401,7 +401,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -414,9 +414,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -443,7 +443,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -674,7 +674,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -714,7 +714,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call pcvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
@@ -771,8 +771,9 @@ c
c
if (bmat .eq. 'G') then
cmpnorm_buf = cdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cmpnorm_buf, cmpnorm, 1,
call MPI_ALLREDUCE( [cmpnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cmpnorm = buf2(1)
rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
@@ -780,7 +781,7 @@ c
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pcmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/MPI/pcnaupd.f
+2 -2
View File
@@ -626,9 +626,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pcvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
PARPACK/SRC/MPI/pcneupd.f
+2 -2
View File
@@ -558,9 +558,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/MPI/pcngets.f
+2 -2
View File
@@ -177,8 +177,8 @@ c
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call pcvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pcvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/MPI/pdgetv0.f
+8 -8
View File
@@ -180,7 +180,7 @@ c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Double precision
& rnorm0
& rnorm0, buf2(1)
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Double precision
@@ -318,9 +318,9 @@ c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm0, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm0 = sqrt(abs(rnorm0))
rnorm0 = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm0 = pdnorm2( comm, n, resid, 1 )
end if
@@ -379,9 +379,9 @@ c
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
@@ -391,9 +391,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
call pdvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -424,7 +424,7 @@ c
50 continue
c
if (msglvl .gt. 0) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/MPI/pdlamch10.f
+7 -6
View File
@@ -57,7 +57,7 @@
*
* .. Local Scalars ..
INTEGER IDUMM
DOUBLE PRECISION TEMP, TEMP1
DOUBLE PRECISION TEMP, TEMP1, buf2(1)
* ..
* .. External Subroutines ..
* EXTERNAL DGAMN2D, DGAMX2D
@@ -73,19 +73,20 @@
*
IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.
$ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION,
CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_DOUBLE_PRECISION,
$ MPI_MAX, ICTXT, IDUMM )
* CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, buf2(1), 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION,
CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_DOUBLE_PRECISION,
$ MPI_MIN, ICTXT, IDUMM )
* CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, buf2(1), 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE
TEMP = TEMP1
buf2(1) = TEMP1
END IF
*
TEMP = buf2(1)
PDLAMCH10 = TEMP
*
* End of PDLAMCH10
PARPACK/SRC/MPI/pdnaitr.f
+11 -11
View File
@@ -276,7 +276,7 @@ c
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Double precision
& rnorm_buf
& rnorm_buf, buf2(1)
c
c
c %-----------------------%
@@ -393,9 +393,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -415,7 +415,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -566,9 +566,9 @@ c %-------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
wnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
wnorm = pdnorm2( comm, n, resid, 1 )
end if
@@ -642,9 +642,9 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
@@ -745,15 +745,15 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
rnorm1 = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm1 = pdnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/MPI/pdnapps.f
+8 -8
View File
@@ -276,11 +276,11 @@ c
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call pdvout (comm, logfil, 1, sigmar, ndigit,
call pdvout (comm, logfil, 1, [sigmar], ndigit,
& '_napps: The real part of the shift ')
call pdvout (comm, logfil, 1, sigmai, ndigit,
call pdvout (comm, logfil, 1, [sigmai], ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
@@ -345,9 +345,9 @@ c
& tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call pdvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -361,9 +361,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -635,7 +635,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pdvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pdmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/MPI/pdnaup2.f
+10 -10
View File
@@ -234,7 +234,7 @@ c
& nevbef, nev0 , np0 , nptemp, numcnv,
& j
Double precision
& rnorm , temp , eps23
& rnorm , temp , eps23, buf2(1)
save cnorm , getv0, initv , update, ushift,
& rnorm , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , eps23 , numcnv
@@ -408,7 +408,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -421,9 +421,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -455,7 +455,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -699,7 +699,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -751,7 +751,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
@@ -810,16 +810,16 @@ c
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION , MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = pdnorm2 ( comm, n, resid, 1 )
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pdmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/MPI/pdnaupd.f
+2 -2
View File
@@ -650,9 +650,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pdvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
PARPACK/SRC/MPI/pdneupd.f
+2 -2
View File
@@ -617,9 +617,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/MPI/pdngets.f
+2 -2
View File
@@ -226,8 +226,8 @@ c
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call pdvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call pdvout (comm, logfil, kev+np, ritzi, ndigit,
PARPACK/SRC/MPI/pdnorm2.f
+5 -4
View File
@@ -45,7 +45,7 @@ c | Local Scalars |
c %---------------%
c
Double precision
& max, buf, zero
& max, buf, zero, buf2(1)
parameter ( zero = 0.0 )
c
c %---------------------%
@@ -69,15 +69,16 @@ c
pdnorm2 = dnrm2( n, x, inc)
c
buf = pdnorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION,
call MPI_ALLREDUCE( [buf], buf2, 1, MPI_DOUBLE_PRECISION,
& MPI_MAX, comm, ierr )
max = buf2(1)
if ( max .eq. zero ) then
pdnorm2 = zero
else
buf = (pdnorm2/max)**2.0
call MPI_ALLREDUCE( buf, pdnorm2, 1, MPI_DOUBLE_PRECISION,
call MPI_ALLREDUCE( [buf], buf2, 1, MPI_DOUBLE_PRECISION,
& MPI_SUM, comm, ierr )
pdnorm2 = max * sqrt(abs(pdnorm2))
pdnorm2 = max * sqrt(abs(buf2(1)))
endif
c
c %----------------%
PARPACK/SRC/MPI/pdsaitr.f
+13 -13
View File
@@ -264,7 +264,7 @@ c
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol,
& jj
Double precision
& rnorm1, wnorm, safmin, temp1
& rnorm1, wnorm, safmin, temp1, buf2(1)
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
@@ -392,9 +392,9 @@ c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: generating Arnoldi vector no.')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
@@ -412,7 +412,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: ****** restart at step ******')
end if
c
@@ -572,14 +572,14 @@ c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
rnorm_buf = ddot (n, resid, 1, workd(ivj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
wnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
wnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
wnorm = pdnorm2( comm, n, resid, 1 )
end if
@@ -669,9 +669,9 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
@@ -769,15 +769,15 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2(1), 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
rnorm1 = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm1 = pdnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/MPI/pdsapps.f
+3 -3
View File
@@ -272,9 +272,9 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_sapps: occurred before shift number.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
@@ -443,7 +443,7 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
PARPACK/SRC/MPI/pdsaup2.f
+10 -10
View File
@@ -212,7 +212,7 @@ c
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Double precision
& tol
& tol, buf2(1)
c
c %-----------------%
c | Array Arguments |
@@ -424,13 +424,13 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
@@ -469,7 +469,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
@@ -719,7 +719,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -766,7 +766,7 @@ c
if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
@@ -825,9 +825,9 @@ c
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
@@ -835,7 +835,7 @@ c
130 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call pdvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
PARPACK/SRC/MPI/pdsaupd.f
+2 -2
View File
@@ -652,9 +652,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saupd: number of "converged" Ritz values')
call pdvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
PARPACK/SRC/MPI/pdseupd.f
+2 -2
View File
@@ -523,9 +523,9 @@ c | caused by incorrect passing of the _saupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/MPI/pdsgets.f
+2 -2
View File
@@ -216,8 +216,8 @@ c
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is')
call pdvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call pdvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/MPI/pdznorm2.f
+7 -7
View File
@@ -45,7 +45,7 @@ c | Local Scalars |
c %---------------%
c
Double precision
& max, buf, zero
& max(1), buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
@@ -59,7 +59,7 @@ c | External Functions |
c %--------------------%
c
Double precision
& dznrm2
& dznrm2, buf2(1)
External dznrm2
c
c %-----------------------%
@@ -69,15 +69,15 @@ c
pdznorm2 = dznrm2( n, x, inc)
c
buf = pdznorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION,
call MPI_ALLREDUCE( [buf], max, 1, MPI_DOUBLE_PRECISION,
& MPI_MAX, comm, ierr )
if ( max .eq. zero ) then
if ( max(1) .eq. zero ) then
pdznorm2 = zero
else
buf = (pdznorm2/max)**2.0
call MPI_ALLREDUCE( buf, pdznorm2, 1, MPI_DOUBLE_PRECISION,
buf = (pdznorm2/max(1))**2.0
call MPI_ALLREDUCE( [buf], buf2, 1, MPI_DOUBLE_PRECISION,
& MPI_SUM, comm, ierr )
pdznorm2 = max * sqrt(abs(pdznorm2))
pdznorm2 = max(1) * sqrt(abs(buf2(1)))
endif
c
c %-----------------%
PARPACK/SRC/MPI/pscnorm2.f
+7 -6
View File
@@ -45,7 +45,7 @@ c | Local Scalars |
c %---------------%
c
Real
& max, buf, zero
& max(1), buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
@@ -61,6 +61,7 @@ c
Real
& scnrm2
External scnrm2
Real buf2(1)
c
c %-----------------------%
c | Executable Statements |
@@ -69,15 +70,15 @@ c
pscnorm2 = scnrm2( n, x, inc)
c
buf = pscnorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_REAL,
call MPI_ALLREDUCE( [buf], max, 1, MPI_REAL,
& MPI_MAX, comm, ierr )
if ( max .eq. zero ) then
if ( max(1) .eq. zero ) then
pscnorm2 = zero
else
buf = (pscnorm2/max)**2.0
call MPI_ALLREDUCE( buf, pscnorm2, 1, MPI_REAL,
buf = (pscnorm2/max(1))**2.0
call MPI_ALLREDUCE( [buf], buf2, 1, MPI_REAL,
& MPI_SUM, comm, ierr )
pscnorm2 = max * sqrt(abs(pscnorm2))
pscnorm2 = max(1) * sqrt(abs(buf2(1)))
endif
c
c %-----------------%
PARPACK/SRC/MPI/psgetv0.f
+8 -8
View File
@@ -163,7 +163,7 @@ c %-----------------%
c
integer ipntr(3)
Real
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
& resid(n), v(ldv,j), workd(2*n), workl(2*j), buf2(1)
c
c %------------%
c | Parameters |
@@ -318,9 +318,9 @@ c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm0, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm0 = sqrt(abs(rnorm0))
rnorm0 = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm0 = psnorm2( comm, n, resid, 1 )
end if
@@ -379,9 +379,9 @@ c
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
@@ -391,9 +391,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
call psvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -424,7 +424,7 @@ c
50 continue
c
if (msglvl .gt. 0) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/MPI/pslamch10.f
+7 -5
View File
@@ -53,7 +53,7 @@
*
* .. Local Scalars ..
INTEGER IDUMM
REAL TEMP, TEMP1
REAL TEMP, TEMP1, buf2(1)
* ..
* .. External Subroutines ..
* EXTERNAL SGAMN2D, SGAMX2D
@@ -69,14 +69,16 @@
*
IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.
$ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_REAL,
CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_REAL,
$ MPI_MAX, ICTXT, IDUMM )
* CALL SGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
TEMP = buf2(1)
* CALL SGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_REAL,
CALL MPI_ALLREDUCE( [TEMP1], buf2, 1, MPI_REAL,
$ MPI_MIN, ICTXT, IDUMM )
* CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
TEMP = buf2(1)
* CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE
TEMP = TEMP1
PARPACK/SRC/MPI/psnaitr.f
+11 -11
View File
@@ -276,7 +276,7 @@ c
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Real
& rnorm_buf
& rnorm_buf, buf2(1)
c
c
c %-----------------------%
@@ -393,9 +393,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -415,7 +415,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -566,9 +566,9 @@ c %-------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
wnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
wnorm = psnorm2( comm, n, resid, 1 )
end if
@@ -642,9 +642,9 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
@@ -745,15 +745,15 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
rnorm1 = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm1 = psnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/MPI/psnapps.f
+8 -8
View File
@@ -276,11 +276,11 @@ c
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call psvout (comm, logfil, 1, sigmar, ndigit,
call psvout (comm, logfil, 1, [sigmar], ndigit,
& '_napps: The real part of the shift ')
call psvout (comm, logfil, 1, sigmai, ndigit,
call psvout (comm, logfil, 1, [sigmai], ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
@@ -345,9 +345,9 @@ c
& tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call psvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -361,9 +361,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -635,7 +635,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call psvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call psmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/MPI/psnaup2.f
+10 -10
View File
@@ -241,7 +241,7 @@ c
c
Real
& rnorm_buf
& rnorm_buf, buf2(1)
c
c %-----------------------%
c | Local array arguments |
@@ -408,7 +408,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -421,9 +421,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -455,7 +455,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -699,7 +699,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -751,7 +751,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call psvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
@@ -810,16 +810,16 @@ c
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call psmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/MPI/psnaupd.f
+2 -2
View File
@@ -650,9 +650,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call psvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
PARPACK/SRC/MPI/psneupd.f
+2 -2
View File
@@ -617,9 +617,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/MPI/psngets.f
+2 -2
View File
@@ -226,8 +226,8 @@ c
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call psvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call psvout (comm, logfil, kev+np, ritzi, ndigit,
PARPACK/SRC/MPI/psnorm2.f
+5 -4
View File
@@ -45,7 +45,7 @@ c | Local Scalars |
c %---------------%
c
Real
& max, buf, zero
& max, buf, zero, buf2(1)
parameter ( zero = 0.0 )
c
c %---------------------%
@@ -69,15 +69,16 @@ c
psnorm2 = snrm2( n, x, inc)
c
buf = psnorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_REAL,
call MPI_ALLREDUCE( [buf], buf2, 1, MPI_REAL,
& MPI_MAX, comm, ierr )
max = buf2(1)
if ( max .eq. zero ) then
psnorm2 = zero
else
buf = (psnorm2/max)**2.0
call MPI_ALLREDUCE( buf, psnorm2, 1, MPI_REAL,
call MPI_ALLREDUCE( [buf], buf2, 1, MPI_REAL,
& MPI_SUM, comm, ierr )
psnorm2 = max * sqrt(abs(psnorm2))
psnorm2 = max * sqrt(abs(buf2(1)))
endif
c
c %----------------%
PARPACK/SRC/MPI/pssaitr.f
+15 -15
View File
@@ -264,7 +264,7 @@ c
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol,
& jj
Real
& rnorm1, wnorm, safmin, temp1
& rnorm1, wnorm(1), safmin, temp1, temp2(1)
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
@@ -392,9 +392,9 @@ c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: generating Arnoldi vector no.')
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
@@ -412,7 +412,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_saitr: ****** restart at step ******')
end if
c
@@ -572,16 +572,16 @@ c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
rnorm_buf = sdot (n, resid, 1, workd(ivj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], wnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
wnorm(1) = sqrt(abs(wnorm(1)))
else if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], wnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = psnorm2( comm, n, resid, 1 )
wnorm(1) = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
@@ -669,9 +669,9 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], temp2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(temp2(1)))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
@@ -691,7 +691,7 @@ c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
if (rnorm .gt. 0.717*wnorm(1)) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
@@ -704,7 +704,7 @@ c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(1) = wnorm(1)
xtemp(2) = rnorm
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization ; wnorm and rnorm are')
@@ -769,15 +769,15 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
call MPI_ALLREDUCE( [rnorm_buf], temp2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
rnorm1 = sqrt(abs(temp2(1)))
else if (bmat .eq. 'I') then
rnorm1 = psnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
PARPACK/SRC/MPI/pssapps.f
+3 -3
View File
@@ -271,9 +271,9 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_sapps: occurred before shift number.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
@@ -442,7 +442,7 @@ c
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_sapps: deflation at row/column no.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
PARPACK/SRC/MPI/pssaup2.f
+10 -10
View File
@@ -241,7 +241,7 @@ c
integer ierr, iter, j, kplusp, msglvl, nconv, nevbef, nev0,
& np0, nptemp, nevd2, nevm2, kp(3)
Real
& rnorm, temp, eps23
& rnorm, temp, eps23, buf2(1)
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
@@ -424,13 +424,13 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
@@ -469,7 +469,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
@@ -719,7 +719,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -766,7 +766,7 @@ c
if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saup2: The number of shifts to apply ')
call psvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
@@ -825,9 +825,9 @@ c
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
call MPI_ALLREDUCE( [rnorm_buf], buf2, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
rnorm = sqrt(abs(buf2(1)))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
@@ -835,7 +835,7 @@ c
130 continue
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
call psvout (comm, logfil, 1, [rnorm], ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call psvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
PARPACK/SRC/MPI/pssaupd.f
+2 -2
View File
@@ -652,9 +652,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_saupd: number of "converged" Ritz values')
call psvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
PARPACK/SRC/MPI/psseupd.f
+2 -2
View File
@@ -523,9 +523,9 @@ c | caused by incorrect passing of the _saupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/MPI/pssgets.f
+2 -2
View File
@@ -216,8 +216,8 @@ c
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_sgets: NP is')
call psvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call psvout (comm, logfil, kev+np, bounds, ndigit,
PARPACK/SRC/MPI/pzgetv0.f
+8 -6
View File
@@ -185,7 +185,7 @@ c
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Complex*16
& cnorm_buf
& cnorm_buf, buf2(1)
c
c %----------------------%
c | External Subroutines |
@@ -332,8 +332,9 @@ c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm0 = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = pdznorm2 ( comm, n, resid, 1)
@@ -393,8 +394,9 @@ c
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
rnorm = pdznorm2 (comm, n, resid, 1)
@@ -405,9 +407,9 @@ c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
call pdvout (comm, logfil, 1, [rnorm0], ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
@@ -439,7 +441,7 @@ c
c
if (msglvl .gt. 0) then
cnorm2 = dcmplx (rnorm,rzero)
call pzvout (comm, logfil, 1, cnorm2, ndigit,
call pzvout (comm, logfil, 1, [cnorm2], ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
PARPACK/SRC/MPI/pznaitr.f
+13 -10
View File
@@ -293,7 +293,7 @@ c
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Complex*16
& cnorm_buf
& cnorm_buf, buf2(1)
c
c %----------------------%
c | External Subroutines |
@@ -404,9 +404,9 @@ c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: generating Arnoldi vector number')
call pzvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
@@ -426,7 +426,7 @@ c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
@@ -577,9 +577,10 @@ c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
cnorm = buf2(1)
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = pdznorm2(comm, n, resid, 1)
end if
@@ -653,8 +654,9 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = pdznorm2(comm, n, resid, 1)
@@ -757,15 +759,16 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
cnorm = buf2(1)
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = pdznorm2(comm, n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
call pivout (comm, logfil, 1, [j], ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
PARPACK/SRC/MPI/pznapps.f
+7 -7
View File
@@ -283,9 +283,9 @@ c
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: shift number.')
call pzvout (comm, logfil, 1, sigma, ndigit,
call pzvout (comm, logfil, 1, [sigma], ndigit,
& '_napps: Value of the shift ')
end if
c
@@ -306,9 +306,9 @@ c
if ( abs(dble(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
call pivout (comm, logfil, 1, [i], ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
call pivout (comm, logfil, 1, [jj], ndigit,
& '_napps: matrix splitting with shift number.')
call pzvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
@@ -322,9 +322,9 @@ c
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
call pivout (comm, logfil, 1, [istart], ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
call pivout (comm, logfil, 1, [iend], ndigit,
& '_napps: End of current block ')
end if
c
@@ -500,7 +500,7 @@ c
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pzvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
call pivout (comm, logfil, 1, [kev], ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pzmout (comm, logfil, kev, kev, h, ldh, ndigit,
PARPACK/SRC/MPI/pznaup2.f
+10 -9
View File
@@ -237,7 +237,7 @@ c
& nevbef, nev0 , np0, eps23
c
Double precision
& cmpnorm_buf
& cmpnorm_buf, buf2(1)
c
c %-----------------------%
c | Local array arguments |
@@ -401,7 +401,7 @@ c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
call pivout (comm, logfil, 1, [iter], ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
c
@@ -414,9 +414,9 @@ c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
call pivout (comm, logfil, 1, [nev], ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
@@ -443,7 +443,7 @@ c
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
@@ -674,7 +674,7 @@ c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
call pivout (comm, logfil, 1, [nconv], ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
@@ -714,7 +714,7 @@ c
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naup2: The number of shifts to apply ')
call pzvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
@@ -771,8 +771,9 @@ c
c
if (bmat .eq. 'G') then
cmpnorm_buf = zdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cmpnorm_buf, cmpnorm, 1,
call MPI_ALLREDUCE( [cmpnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
cmpnorm = buf2(1)
rnorm = sqrt(dlapy2(dble(cmpnorm),dimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = pdznorm2(comm, n, resid, 1)
@@ -780,7 +781,7 @@ c
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
call pdvout (comm, logfil, 1, [rnorm], ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pzmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
PARPACK/SRC/MPI/pznaupd.f
+2 -2
View File
@@ -626,9 +626,9 @@ c
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
call pivout (comm, logfil, 1, [mxiter], ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
call pivout (comm, logfil, 1, [np], ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pzvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
PARPACK/SRC/MPI/pzneupd.f
+2 -2
View File
@@ -558,9 +558,9 @@ c | caused by incorrect passing of the dnaupd data. |
c %-----------------------------------------------------------%
c
if (msglvl .gt. 2) then
call pivout(comm, logfil, 1, numcnv, ndigit,
call pivout(comm, logfil, 1, [numcnv], ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
call pivout(comm, logfil, 1, [nconv], ndigit,
& '_neupd: Number of "converged" eigenvalues')
end if
c
PARPACK/SRC/MPI/pzngets.f
+2 -2
View File
@@ -177,8 +177,8 @@ c
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pivout (comm, logfil, 1, [kev], ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, [np], ndigit, '_ngets: NP is')
call pzvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pzvout (comm, logfil, kev+np, bounds, ndigit,
scripts/travis_fedora.sh
Executable
+51
View File
@@ -0,0 +1,51 @@
#!/bin/sh
## -e : Make sure all errors cause the script to fail
## -x be verbose; write what we are doing, as we do it
set -ex
## Should we init a container?
if [ ".$1" = .setup ]
then
# fedora
# note: when you PR, docker-cp provides, in the container, the branch associated with the PR (not master where there's nothing new)
# 1. docker create --name mobydick IMAGE CMD <=> create a container (= instance of image) but container is NOT yet started
# 2. docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp <=> copy git repository (CI worker, checkout-ed on PR branch) into the container
# note: docker-cp works only if copy from/to containers (not images)
# 3. docker start -a mobydick <=> start to run the container (initialized with docker-cp)
test . != ".$2" && mpi="$2" || mpi=openmpi
test . != ".$3" && version="$3" || version=latest
time sudo docker pull registry.fedoraproject.org/fedora:$version ||
sudo docker pull fedora:$version
time sudo docker create --name mobydick fedora:$version \
/tmp/arpack-ng/scripts/travis_fedora.sh $mpi
time sudo docker cp -a ${TRAVIS_BUILD_DIR} mobydick:/tmp
time sudo docker start -a mobydick ; e=$?
exit $e
fi
test . != ".$1" && mpi="$1" || mpi=openmpi
## If we are called as root, setup everything
if [ $UID -eq 0 ]
then
time dnf -y upgrade
time dnf -y install environment-modules git \
gfortran openblas-devel cmake ${mpi}-devel make gcc-c++
useradd test
chown -R test /tmp
sudo -u test $0 $mpi
## If we are called as normal user, run test
else
. /etc/profile.d/modules.sh
module load mpi
export OMPI_MCA_rmaps_base_oversubscribe=yes
cd /tmp
cd arpack-ng
git status
git log -2
mkdir -p build && cd build
time cmake -DEXAMPLES=ON -DMPI=ON -DICB=ON ..
export VERBOSE=1
time make all
time make test
tail -n 300 ./Testing/Temporary/LastTest.log
fi