Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

DDotMPI and DGEMVMPI implementation #45

Open
wants to merge 9 commits into
base: master
Choose a base branch
from
Open

DDotMPI and DGEMVMPI implementation #45

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
29aef22
Some first modifications:
CYChenFudan Jun 2, 2020
4b0aea0
Fix the bug in the generation of csf's using rcsfgenerate
CYChenFudan Jun 2, 2020
f7968ac
DDOTMPI and DGEMVMPI added in mpiu.f90; Then, DVDSON calls them
CYChenFudan Jun 2, 2020
e8efff4
Update matain.f90
Oct 6, 2020
76eb371
Modifcations for searching the targeted eigenpairs one by one
CYChenFudan Jan 15, 2021
14ba948
Minor modifications for rmcdhf90/maneig.f90, according to those for gdvd
CYChenFudan Jan 15, 2021
ddad394
Minor modification for searching the target eigenpairs one by one.
CYChenFudan Jan 16, 2021
892c594
Comment off the serial module rci90 and rmcdhf90, as dvdson is parall…
CYChenFudan Jan 18, 2021
7e2a0ab
Modifications for Librangular code as suggested by G.G (https://githu…
CYChenFudan Jan 20, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 16 additions & 0 deletions Changes_cychen.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
00. src/tool: Makefile, add "chmod a+x $(GRASP)/bin/rsave"
01. jj2lsj90: In jj2lsj_code.f90, lines 220 and 222 are changed to deal with both parities present.
#02. jj2lsj90: In jj2lsj_code.f90, lines around 850, and lines around 2435,
#modifications for transformation of configurations with empty K-shell, such as
#2s2p, 2lnl, as done in A&A 592, A141(2016).
03. rcsfzerofirst90: In RCSFzerofirst.f90, the number of CSFs in zero-order space
are output. The informations could be used conveniently in RCSF and RCI calculations.
04. rmcdhf90: In newco.f90, weighted average energy is output to monitor the energy convergence.
05. rangular90_mpi: getinf.90 modified for iccut=1
06. rci90_mpi: setham_gg.f90, only myid=0 reports how far the calculation has proceeded.
07. libdvd90, dvdson.f90: make lines 1119 and 1120 work for convergence
monitor. The output messages are very useful for extremely large-scaled calculations.
08. libdvd90, dvdson.f90: function TSTSEL is modified, so that dvdson performs at least TWO
iteration calculations. Or, error results could be obtained in some cases (in
O-like isoelectronic sequence?).
09. dvdson--mpi
11 changes: 9 additions & 2 deletions make_environment_gfortran
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,13 +9,20 @@
#
# Installation requirements:
# - Lapack, Blas and MPI libraries have to be installed and properly linked - e.g. add them to LD_LIBRARY_PATH.
mkdir lib bin > /dev/null 2>&1
echo "cp ../BLAS-3.8.0/blas_LINUX.a lib/libblas.a"
cp ../BLAS-3.8.0/blas_LINUX.a lib/libblas.a
echo "cp ../lapack-3.8.0/liblapack.a lib/"
cp ../lapack-3.8.0/liblapack.a lib/

# - The Fortran compiler of choice and the MPI wrapper (as specified by FC and FC_MPI below) have to be on your PATH.
#
# -------------------------------------------------------------------------------------------------------------------
# Set up main flags
# -------------------------------------------------------------------------------------------------------------------
export FC=gfortran # Fortran compiler
export FC_FLAGS="-O2 -fno-automatic " # Serial code compiler flags
#export FC_FLAGS="-O2 -fno-automatic" # Serial code compiler flags
export FC_FLAGS="-O2 -fno-automatic -fconvert=big-endian" # If little-endian used, comment out this line, use the above one
export FC_LD=" " # Serial linker flags
export GRASP="${PWD}" # Location of the 2018 root directory
export LAPACK_LIBS="-llapack -lblas" # Lapack libraries
Expand All @@ -26,4 +33,4 @@ export FC_MPI="mpifort" # MPI
export FC_MPIFLAGS="${FC_FLAGS}" # Parallel code compiler flags
export FC_MPILD=${FC_LD} # Serial linker flags
# -------------------------------------------------------------------------------------------------------------------
export MPI_TMP="${HOME}/grasp_mpi_tmp" # Location for temporary files
export MPI_TMP="${HOME}/tmp" # Location for temporary files
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The PR needs to be brought up to speed with the latest master before merging. E.g. make_environment_gfortran is not a thing anymore. I don't think any of the substantial parts of the PR have conflicts though, just the build files.

Copy link
Member

@jongrumer jongrumer Sep 30, 2020 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, and the changes with copying blas and lapack libraries from a given folder are way too case specific. Better to set e.g. the LD_LIBRARY_PATH flag or let CMake do the job.

5 changes: 3 additions & 2 deletions src/appl/rangular90_mpi/getinf.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,8 +60,9 @@ SUBROUTINE GETINF
do i = 1,nblock
write(istde,*) 'Give ICCUT for block',i
1 READ *, ICCUT(i)
IF ((ICCUT(i) <= 1).OR.(ICCUT(i) >= ncfblk(i))) THEN
WRITE (istde,*) 'GETINF: ICCUT must be greater than 1',&
!cychen IF ((ICCUT(i) <= 1).OR.(ICCUT(i) >= ncfblk(i))) THEN
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would suggest removing these commented out lines with the old code before merging.

IF ((ICCUT(i) < 1).OR.(ICCUT(i) >= ncfblk(i))) THEN
WRITE (istde,*) 'GETINF: ICCUT must be greater than 0',&
' and less than ',ncfblk(i)
WRITE (istde,*) ' please reenter ICCUT:'
GOTO 1
Expand Down
9 changes: 6 additions & 3 deletions src/appl/rci90_mpi/setham_gg.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -398,6 +398,8 @@ SUBROUTINE SETHAM (myid, nprocs, jblock, ELSTO,ICSTRT, nelmntt, &
!cjb MPI progress begin --------------------------------------------------
!
!cjb just started
!cychen: report only from myid.eq.0
if (myid .eq. 0 ) then
IF (IC .LE. nprocs) then
PRINT '(A6,I10,A9,I10,A9,I5,A8,I5)', 'Start ', ic, &
' nnonz = ', nelc, &
Expand All @@ -410,19 +412,19 @@ SUBROUTINE SETHAM (myid, nprocs, jblock, ELSTO,ICSTRT, nelmntt, &
IF (IC .GT. nprocs .and. IC .LT. NCF-nprocs .and. &
MOD (IC-1,100*nprocs) .EQ. myid) then
if (myid .eq. 0) then
PRINT '(A5,I10,A9,I10,A9,I5,A8,I5)', 'Done ', ic, &
PRINT '(A6,I10,A9,I10,A9,I5,A8,I5)', 'Done ', ic, &
' nnonz = ', nelc, &
' block = ', jblock,' myid = ', myid
flush output_unit
flush error_unit
else
PRINT '(A5,I10,A9,I10,A9,I5,A8,I5)', 'Row ', ic, &
PRINT '(A6,I10,A9,I10,A9,I5,A8,I5)', 'Row ', ic, &
' nnonz = ', nelc, &
' block = ', jblock,' myid = ', myid
flush output_unit
flush error_unit
endif
endif
endif
!
!cjb almost finished
IF (IC .GT. NCF-nprocs) then
Expand All @@ -433,6 +435,7 @@ SUBROUTINE SETHAM (myid, nprocs, jblock, ELSTO,ICSTRT, nelmntt, &
flush output_unit
flush error_unit
endif
endif
!cjb MPI progress end ----------------------------------------------------
!
!
Expand Down
6 changes: 4 additions & 2 deletions src/appl/rcsfgenerate90/matain.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -262,7 +262,8 @@ subroutine matain(org, lock, closed, varmax, skal, nmax, anel, par, low, &
if (Y(1:1).GE.'0' .AND. Y(1:1).LE.'9') then
if (org(i,j).GT.0) then
tmp = ICHAR(Y(1:1))-ICHAR('0')
if (Y(2:2).GE.'1' .AND. Y(2:2).LE.'9') &
!cychen if (Y(2:2).GE.'1' .AND. Y(2:2).LE.'9') &
if (Y(2:2).GE.'0' .AND. Y(2:2).LE.'9') &
tmp = tmp*10 + ICHAR(Y(2:2))-ICHAR('0')
low(i,j) = min(org(i,j),tmp)
endif
Expand Down Expand Up @@ -312,7 +313,8 @@ subroutine matain(org, lock, closed, varmax, skal, nmax, anel, par, low, &
if (Y(1:1).GE.'0' .AND. Y(1:1).LE.'9') then
if (org(i,j).GT.0) then
tmp = ICHAR(Y(1:1))-ICHAR('0')
if (Y(2:2).GE.'1' .AND. Y(2:2).LE.'9') &
!cychen if (Y(2:2).GE.'1' .AND. Y(2:2).LE.'9') &
if (Y(2:2).GE.'0' .AND. Y(2:2).LE.'9') &
tmp = tmp*10 + ICHAR(Y(2:2))-ICHAR('0')
low(i,j) = min(org(i,j),tmp)
endif
Expand Down
4 changes: 4 additions & 0 deletions src/appl/rcsfzerofirst90/RCSFzerofirst.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,19 +44,23 @@ PROGRAM RCSFzerofirst
print *, ""
NBLOCK = 0
CALL SET_CSF_ZFlist
!cychen: output the zero-order space for re-use in mcp, rci
open(301,file='icut',form='formatted',status='unknown')
WRITE (6, *) " Block Zero-order Space Complete Space"
DO
CALL LODCSL_Zero (NEXT_BLOCK)
CALL LODCSL_Part (CSF_Number)
WRITE (6,'(3X,I2,6X,I14,3X,I17)') &
NBLOCK,NCFBLK(NBLOCK),CSF_Number-1
write(301,*)NCFBLK(NBLOCK)
deallocate (Found)
deallocate (C_shell)
deallocate (C_quant)
deallocate (C_coupl)
IF(.NOT. NEXT_BLOCK) EXIT
WRITE(22,'(A2)') ' *'
END DO
close(301)
call stoptime (ncount1, 'RCSFzerofirst')
STOP
END PROGRAM RCSFzerofirst
2 changes: 2 additions & 0 deletions src/appl/rmcdhf90/newco.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -114,6 +114,8 @@ SUBROUTINE NEWCO(SUM)
! Write out average energy
!
IF (NCMIN > 1) WRITE (*, 304) SUM
!cychen, output sum to the terminal for convergence monitor.
WRITE (0,'(A25,1PD18.10)') 'Weighted average energy: ', SUM
!
! Write out generalized occupation numbers
!
Expand Down
119 changes: 96 additions & 23 deletions src/lib/libdvd90/dvdson.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -543,6 +543,8 @@ SUBROUTINE ADDS(N, LIM, KPASS, NNCV, BASIS, AB, S)
DO IV = 1, NNCV
IBSTART = 1
DO IBV = 1, KPASS + IV
!cychen SS = DDOT(N,BASIS(IBSTART),1,AB(IDSTART),1)
call DDOTMPI(N,BASIS(IBSTART),AB(IDSTART),SS)
SS = DDOT(N,BASIS(IBSTART),1,AB(IDSTART),1)
S(ISSTART+IBV) = SS
IBSTART = IBSTART + N
Expand Down Expand Up @@ -640,6 +642,7 @@ SUBROUTINE DVDRVR(IRC, IREV, N, HIEND, LIM, MBLOCK, NOC, NUME, NIV, NEIG&
INTEGER :: REST, I, KPASS, NNCV, IFIND, NFOUND, INFO, NEWSTART
REAL(DOUBLE) :: TOL
LOGICAL :: FIRST, DONE
REAL(DOUBLE) :: dsum

SAVE FIRST, DONE, REST, I, KPASS, NNCV, IFIND, TOL, NFOUND, INFO, &
NEWSTART
Expand Down Expand Up @@ -732,7 +735,7 @@ SUBROUTINE DVDRVR(IRC, IREV, N, HIEND, LIM, MBLOCK, NOC, NUME, NIV, NEIG&
! by the largest magnitude in the last added NNCV rows of Svec.
!
DONE = TSTSEL(KPASS,NUME,NEIG,ISELEC,SVEC,EIGVAL,ICV,CRITE,CRITC,SCRA1,&
ISCRA2,OLDVAL,NNCV,INCV)
ISCRA2,OLDVAL,NNCV,INCV,NLOOPS)
IF (DONE .OR. KPASS>=N) GO TO 30
!
! Maximum size for expanding basis. Truncate basis, D, and S, Svec
Expand Down Expand Up @@ -822,17 +825,21 @@ SUBROUTINE DVDRVR(IRC, IREV, N, HIEND, LIM, MBLOCK, NOC, NUME, NIV, NEIG&
OLDVAL(I) = ABS(OLDVAL(I)-EIGVAL(I))
END DO

CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, BASIS)
CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, AB)
!cychen CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, BASIS)
!cychen CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, AB)
CALL MULTBC_COL (N, KPASS, NUME, SVEC, SCRA1, BASIS)
CALL MULTBC_COL (N, KPASS, NUME, SVEC, SCRA1, AB)
!
! i=1,NUME residual(i)= DCi-liBCi= newDi-linewBi
! temporarily stored in AB(NUME*N+1)
!
DO I = 1, NUME
CALL DCOPY (N, AB((I-1)*N+1), 1, AB(NUME*N+1), 1)
CALL DAXPY (N, (-EIGVAL(I)),BASIS((I-1)*N+1), 1, AB(NUME*N+1), 1)
SCRA1(I) = DDOT(N,AB(NUME*N+1),1,AB(NUME*N+1),1)
SCRA1(I) = SQRT(SCRA1(I))
!cychen SCRA1(I) = DDOT(N,AB(NUME*N+1),1,AB(NUME*N+1),1)
! SCRA1(I) = SQRT(SCRA1(I))
call DDOTMPI(N,AB(NUME*N+1),AB(NUME*N+1),dsum)
SCRA1(I) = SQRT(dsum)
END DO
!
! Set IRC=0 for normal exit with no reverse communication
Expand Down Expand Up @@ -997,6 +1004,55 @@ SUBROUTINE MULTBC(N, K, M, C, TEMP, B)
RETURN
END SUBROUTINE MULTBC

!=======================================================================
SUBROUTINE MULTBC_COL(N,K,M,C,SCARTMP,B)
!=======================================================================
!cychen: obtain the column of B(N,M), by using DGEMVMPI
! called by: DVDRVR
!
! Multiplies B(N,K)*C(K,M) and stores it in B(N,M)
! Used for collapsing the expanding basis to current estimates,
! when basis becomes too large, or for returning the results back

! Subroutines called
! DINIT, DGEMV, DCOPY
!-----------------------------------------------------------------------
!-----------------------------------------------
! M o d u l e s
!-----------------------------------------------
USE vast_kind_param, ONLY: DOUBLE
!-----------------------------------------------
! I n t e r f a c e B l o c k s
!-----------------------------------------------
!USE dgemv_I
!USE dcopy_I
IMPLICIT NONE
!-----------------------------------------------
! D u m m y A r g u m e n t s
!-----------------------------------------------
INTEGER :: N
INTEGER :: K
INTEGER :: M
REAL(DOUBLE) :: C(K*M)
REAL(DOUBLE) :: SCARTMP(M)
!cychen REAL(DOUBLE) :: B(N*K)
REAL(DOUBLE) :: B(1)
!-----------------------------------------------
! L o c a l V a r i a b l e s
!-----------------------------------------------
INTEGER :: JCOL
REAL(DOUBLE) :: TEMP(N*M)

!-----------------------------------------------------------------------
DO JCOL=1,M
CALL DGEMVMPI('N',N,K,1.D0,B,N,C((JCOL-1)*K+1),1, &
0.d0,TEMP((JCOL-1)*N+1),1)
ENDDO
CALL DCOPY(N*M,TEMP,1,B,1)
CALL DCOPY(M,B(N),N,SCARTMP,1)

RETURN
END SUBROUTINE MULTBC_COL

!=======================================================================
SUBROUTINE NEWVEC(N, NUME, LIM, MBLOCK, KPASS, CRITR, NNCV, INCV, SVEC, &
Expand Down Expand Up @@ -1029,7 +1085,7 @@ SUBROUTINE NEWVEC(N, NUME, LIM, MBLOCK, KPASS, CRITR, NNCV, INCV, SVEC, &
! M o d u l e s
!-----------------------------------------------
USE vast_kind_param, ONLY: DOUBLE
! USE MPI_C, ONLY: MYID
USE MPI_C, ONLY: MYID !cychen
!-----------------------------------------------
! I n t e r f a c e B l o c k s
!-----------------------------------------------
Expand Down Expand Up @@ -1104,20 +1160,28 @@ SUBROUTINE NEWVEC(N, NUME, LIM, MBLOCK, KPASS, CRITR, NNCV, INCV, SVEC, &
! ..Compute d = AB*Svec_indx
! ..Daxpy d'= d - eigval b gives the residual

CALL DGEMV ('N', N, KPASS, 1.D0, BASIS, N, SVEC((INDX-1)*KPASS+1) &
, 1, 0.D0, BASIS(ICUR), 1)
CALL DGEMV ('N', N, KPASS, 1.D0, AB, N, SVEC((INDX-1)*KPASS+1), 1, &
0.D0, AB(ICUR), 1)
!cychen CALL DGEMV ('N', N, KPASS, 1.D0, BASIS, N, SVEC((INDX-1)*KPASS+1) &
!cychen , 1, 0.D0, BASIS(ICUR), 1)
!cychen CALL DGEMV ('N', N, KPASS, 1.D0, AB, N, SVEC((INDX-1)*KPASS+1), 1, &
!cychen 0.D0, AB(ICUR), 1)
CALL DGEMVMPI('N',N,KPASS,1.D0,BASIS,N,SVEC((INDX-1)*KPASS+1),1,&
0.d0,BASIS(ICUR),1)
CALL DGEMVMPI('N',N,KPASS,1.D0,AB,N,SVEC((INDX-1)*KPASS+1),1, &
0.d0,AB(ICUR),1)
!cychen: daxpympi is worse
CALL DAXPY (N, (-EIGVAL(INDX)),BASIS(ICUR), 1, AB(ICUR), 1)
!CALL DAXPYMPI(N,-EIGVAL(INDX),BASIS(ICUR),1,AB(ICUR),1)
!
! ..Compute the norm of the residual
! ..and check for convergence
!
SQRES = DDOT(N,AB(ICUR),1,AB(ICUR),1)
!cychen SQRES = DDOT(N,AB(ICUR),1,AB(ICUR),1)
call DDOTMPI(N,AB(ICUR),AB(ICUR),SQRES)
SCRA1(INDX) = SQRT(SQRES)

! IF (MYID == 0) WRITE (6, '(A11,F22.16,I2,A10,F19.16)') ' EIGVAL(i) ', &
! EIGVAL(INDX), INDX, ' Res.Norm ', SCRA1(INDX)
!cychen, the following informations are very useful for convergence
!monitoring in an extremely large-scaled calculations.
IF (MYID == 0) WRITE (6, '(A11,F22.16,I4,A10,F19.16)') &
' EIGVAL(i) ', EIGVAL(INDX), INDX, ' Res.Norm ', SCRA1(INDX)

IF (SCRA1(INDX) < CRITR) THEN
! ..Converged,do not add. Go for next non converged one
Expand Down Expand Up @@ -1233,8 +1297,10 @@ SUBROUTINE OVFLOW(N, NUME, KPASS, SCRA1, BASIS, AB, S, SVEC, EIGVAL)
!-----------------------------------------------------------------------
! Truncate the basis and the AB array.
!
CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, BASIS)
CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, AB)
!cychen CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, BASIS)
!cychen CALL MULTBC (N, KPASS, NUME, SVEC, SCRA1, AB)
CALL MULTBC_COL (N, KPASS, NUME, SVEC, SCRA1, BASIS)
CALL MULTBC_COL (N, KPASS, NUME, SVEC, SCRA1, AB)
!
! calculation of the new upper S=diag(l1,...,l_NUME) and
! its matrix Svec of eigenvectors (e1,...,e_NUME)
Expand All @@ -1258,7 +1324,7 @@ END SUBROUTINE OVFLOW

!=======================================================================
LOGICAL FUNCTION TSTSEL (KPASS, NUME, NEIG, ISELEC, SVEC, EIGVAL, ICV, &
CRITE, CRITC, ROWLAST, IND, OLDVAL, NNCV, INCV)
CRITE, CRITC, ROWLAST, IND, OLDVAL, NNCV, INCV, NLOOPS)
!=======================================================================
!
! Called by: DVDRVR
Expand Down Expand Up @@ -1308,6 +1374,7 @@ LOGICAL FUNCTION TSTSEL (KPASS, NUME, NEIG, ISELEC, SVEC, EIGVAL, ICV, &
REAL(DOUBLE) , INTENT(IN) :: EIGVAL(NUME)
REAL(DOUBLE) :: ROWLAST(NEIG)
REAL(DOUBLE) , INTENT(IN) :: OLDVAL(NUME)
INTEGER , INTENT(IN) :: NLOOPS
!-----------------------------------------------
! L o c a l V a r i a b l e s
!-----------------------------------------------
Expand Down Expand Up @@ -1372,7 +1439,8 @@ LOGICAL FUNCTION TSTSEL (KPASS, NUME, NEIG, ISELEC, SVEC, EIGVAL, ICV, &
DO L = 1, NNCV - 1
TMAX = MAX(TMAX,ABS(SVEC(ICUR-L)))
END DO
IF (TMAX < CRITC) THEN
!cychen: perform at least TWO iterations, or, obtain error results in some cases.
IF (NLOOPS > 2 .and. TMAX < CRITC) THEN
! ..this coefficient converged
ICV(ISELEC(I)) = 1
ELSE
Expand Down Expand Up @@ -1465,8 +1533,10 @@ subroutine mgs_nrm(n, kp, new, scra, b)
kcur = 1
do k = 1, kp
jcur = newstart
call dgemv ('T', n, new, 1.D0, b(jcur), n, b(kcur), 1, 0.D0, scra, &
1)
!cychen call DGEMV ('T', n, new, 1.D0, b(jcur), n, b(kcur), 1, 0.D0, scra, &
!cychen 1)
call DGEMVMPI('T', N, new, 1.d0, B(jcur), N, B(kcur), 1, &
0.d0, scra, 1)
do j = 1, new
! call daxpy(N,-scra(j),B(kcur),1,B(jcur),1)
do mm = 0, n - 1
Expand All @@ -1483,12 +1553,15 @@ subroutine mgs_nrm(n, kp, new, scra, b)
jcur = kcur + n
! The current vector should be normalized
!
dnm = ddot(n,b(kcur),1,b(kcur),1)
!cychen dnm = DDOT(n,b(kcur),1,b(kcur),1)
call DDOTMPI(N,B(kcur),B(kcur),dnm)
dnm = sqrt(dnm)
call dscal (n, 1/dnm, b(kcur), 1)
!
call dgemv ('T', n, new - k, 1.D0, b(jcur), n, b(kcur), 1, 0.D0, &
scra, 1)
!cychen call DGEMV ('T', n, new - k, 1.D0, b(jcur), n, b(kcur), 1, 0.D0, &
!cychen scra, 1)
call DGEMVMPI('T', N, new - k, 1.d0, B(jcur), N, B(kcur), 1,&
0.d0, scra, 1)
do j = k + 1, new
! call daxpy(N,-scra(j-k),B(kcur),1,B(jcur),1)
do mm = 0, n - 1
Expand Down
3 changes: 2 additions & 1 deletion src/lib/libdvd90/tstsel_I.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ MODULE tstsel_I
!...Modified by Charlotte Froese Fischer
! Gediminas Gaigalas 10/05/17
LOGICAL FUNCTION tstsel (KPASS, NUME, NEIG, ISELEC, SVEC, EIGVAL, ICV&
, CRITE, CRITC, ROWLAST, IND, OLDVAL, NNCV, INCV)
, CRITE, CRITC, ROWLAST, IND, OLDVAL, NNCV, INCV, NLOOPS)
USE vast_kind_param,ONLY: DOUBLE
INTEGER, INTENT(IN) :: KPASS
INTEGER, INTENT(IN) :: NUME
Expand All @@ -20,6 +20,7 @@ LOGICAL FUNCTION tstsel (KPASS, NUME, NEIG, ISELEC, SVEC, EIGVAL, ICV&
REAL(DOUBLE), DIMENSION(NUME), INTENT(IN) :: OLDVAL
INTEGER, INTENT(INOUT) :: NNCV
INTEGER, DIMENSION(NEIG), INTENT(OUT) :: INCV
INTEGER, INTENT(IN) :: NLOOPS
!VAST.../MPI/ MYID(IN)
!VAST...Calls: IDAMAX
!...This routine performs I/O.
Expand Down
Loading