Skip to content

preprocessor compatability #7

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

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

preprocessor compatability #7

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
298073b
move files require preprocessing .f90 -> .F90
Oct 6, 2017
6bdccee
!dec$ -> cpp in diag.F90
Oct 6, 2017
fee6ffb
!dec$ -> cpp in dipole.F90
Oct 6, 2017
c7d6698
!dec$ -> cpp in lapack.F90
Oct 6, 2017
db2994d
!dec$ -> cpp in plasma.F90
Oct 6, 2017
bbcac0b
!dec$ -> cpp in tran.F90
Oct 6, 2017
48635b7
!dec$ -> cpp in refinement.F90
Oct 6, 2017
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
114 changes: 57 additions & 57 deletions diag.f90 → diag.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
module diag
!dec$ define arpack_ = 0
!dec$ define blacs_ = 0
!dec$ define mpi_ = 0
!dec$ define omparpack_ = 0
!dec$ define propack_ = 0

#define arpack_ 0
#define blacs_ 0
#define mpi_ 0
#define omparpack_ 0
#define propack_ 0

!
! Simplistic type-agnostic LAPACK interface
Expand Down Expand Up @@ -2088,17 +2088,17 @@ subroutine diag_dseupd(n,bterm,nroots,factor,maxitr_,tol,h,e)
! has been exceeded.
!

!dec$ if (arpack_ > 0)
#if arpack_ > 0
!
call dsaupd ( ido, bmat, n, which, nev, tol, resid, &
ncv, v, ldv, iparam, ipntr, workd, workl, &
lworkl, info )
!dec$ else
#else
!
write(out,"(/'Arpack was not activated yet. Please uncomment dsaupd and dseupd bellow')")
stop 'Arpack was not activated'
!
!dec$ end if
#endif
!
!if (verbose>=4.and.iparam(5)>0) then
! !
Expand Down Expand Up @@ -2134,7 +2134,7 @@ subroutine diag_dseupd(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
rvec = .true.
!
!dec$ if (arpack_ > 0)
#if arpack_ > 0
!
if (verbose>=5) write(out,"(/'Arpack: dseupd')")
!
Expand All @@ -2148,12 +2148,12 @@ subroutine diag_dseupd(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
if (verbose>=5) write(out,"(/'Arpack: done!')")
!
!dec$ else
#else
!
write(out,"(/'Arpack was not activated yet. Please uncomment dsaupd and dseupd bellow')")
stop 'Arpack was not activated'
!
!dec$ end if
#endif
!
if ( ierr < 0 ) then
write(out,"(/'Error with_seupd, info = ',i8)") ierr
Expand Down Expand Up @@ -2439,17 +2439,17 @@ subroutine matvec_p(comm,n,nloc,nprocs,kstart,dx,bterm,h,mv_buf,z,w)
myid = 1
nprow = 1
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
myid= myprow
!dec$ elseif (mpi_ > 0)
#elif mpi_ > 0
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs_, ierr )
if (nprocs_/=nprocs) then
write(out,"('matvec_p: inconsistent number of nprocs = ',2i)") nprocs_,nprocs
stop 'matvec_p: inconsistent number of nprocs s'
endif
!dec$ end if
#endif
!
kend = kstart(myid) + nloc-1
!
Expand Down Expand Up @@ -2479,12 +2479,12 @@ subroutine matvec_p(comm,n,nloc,nprocs,kstart,dx,bterm,h,mv_buf,z,w)
!
nx = iend-istart+1
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call dgerv2d( comm, nx, 1, mv_buf(istart:iend), nx, iprev, mypcol )
!dec$ end if
!dec$ if (mpi_ > 0)
#endif
#if mpi_ > 0
call mpi_recv(mv_buf(istart),nx,MPI_DOUBLE_PRECISION,iprev,myid,comm,ierr)
!dec$ end if
#endif
!
istart = max(istart,bterm(k,1))
!
Expand All @@ -2498,12 +2498,12 @@ subroutine matvec_p(comm,n,nloc,nprocs,kstart,dx,bterm,h,mv_buf,z,w)
!
nx = iend-istart+1
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call dgesd2d( comm, nx, 1, z(istart:iend), nx, iprev, mypcol )
!dec$ end if
!dec$ if (mpi_ > 0)
#endif
#if mpi_ > 0
call mpi_send(mv_buf(istart),nx,MPI_DOUBLE_PRECISION,iprev,iprev,comm,ierr)
!dec$ end if
#endif
!
enddo
!
Expand All @@ -2520,12 +2520,12 @@ subroutine matvec_p(comm,n,nloc,nprocs,kstart,dx,bterm,h,mv_buf,z,w)
!
nx = iend-istart+1
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call dgerv2d( comm, nx, 1, mv_buf(istart:iend), nx, inext, mypcol )
!dec$ end if
!dec$ if (mpi_ > 0)
#endif
#if mpi_ > 0
call mpi_recv(mv_buf(istart),nx,MPI_DOUBLE_PRECISION,inext,myid,comm,ierr)
!dec$ end if
#endif
!
iend = min(bterm(k,2),iend)
!
Expand All @@ -2539,12 +2539,12 @@ subroutine matvec_p(comm,n,nloc,nprocs,kstart,dx,bterm,h,mv_buf,z,w)
!
nx = iend-istart+1
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call dgesd2d( comm, nx, 1, z(istart:iend), nx, inext, mypcol )
!dec$ end if
!dec$ if (mpi_ > 0)
#endif
#if mpi_ > 0
call mpi_send(mv_buf(istart),nx,MPI_DOUBLE_PRECISION,inext,inext,comm,ierr)
!dec$ end if
#endif
!
enddo
!
Expand Down Expand Up @@ -2674,19 +2674,19 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
write(out,"('Start PARPACK-diagonalization')")


!dec$ if (blacs_ > 0)
#if blacs_ > 0
write(out,"('BLAS-PINFO-start')")
call BLACS_PINFO( iam, nprocs )
print *,nprocs
blacs_or_mpi = 'BLACS'
!dec$ end if
#endif
!
write(out,"('BLAS-PINFO-done')")
!
!call BLACS_PINFO( iam, nprocs )
!print *,nprocs

!dec$ if (mpi_ > 0)
#if mpi_ > 0
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
Expand All @@ -2701,7 +2701,7 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
blacs_or_mpi = 'MPI'
!
!dec$ end if
#endif
!


Expand All @@ -2710,9 +2710,9 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
if (nprocs .lt. 1) then
nprocs = 1
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call BLACS_SETUP( iam, nprocs )
!dec$ end if
#endif
!
print *,nprocs
!
Expand Down Expand Up @@ -2801,14 +2801,14 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
myprow = 1 ; mypcol = 1 ; myid = 1
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
!
write(out,"(' myprow, nprow, mypcol, npcol = ',4i8)") myprow, nprow, mypcol, npcol
!
!dec$ end if
#endif
!
if (verbose>=2.and.trim(blacs_or_mpi)=='BLACS') write(out,"('myprow, nprow, mypcol, npcol, nprocs = ',5i8)") myprow, nprow, mypcol, npcol, nprocs
if (verbose>=2.and.trim(blacs_or_mpi)=='MPI') write(out,"('myid,nproc = ',2i8)") myid,nprocs
Expand Down Expand Up @@ -2874,19 +2874,19 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
! has been exceeded.
!

!dec$ if (blacs_ > 0.or.mpi_ > 0)
#if (blacs_ > 0) || (mpi_ > 0)
!
call pdsaupd ( comm, ido, bmat, nloc, which, nev, tol, resid, &
ncv, v, ldv, iparam, ipntr, workd, workl, &
lworkl, info )
!
!dec$ else
#else
!
call dsaupd ( ido, bmat, n, which, nev, tol, resid, &
ncv, v, ldv, iparam, ipntr, workd, workl, &
lworkl, info )
!
!dec$ end if
#endif
!
!if (verbose>=4.and.iparam(5)>0) then
! !
Expand Down Expand Up @@ -2920,7 +2920,7 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
rvec = .true.
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
!
if (verbose>=5) write(out,"(/'Arpack: dseupd')")
!
Expand All @@ -2932,12 +2932,12 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
if (verbose>=5) write(out,"(/'Arpack: done!')")

!
!dec$ else
#else
!
write(out,"(/'Arpack was not activated yet. Please uncomment dsaupd and dseupd bellow')")
stop 'Arpack was not activated'
!
!dec$ end if
#endif
!
if ( ierr < 0 ) then
write(out,"(/'Error with_seupd, info = ',i8)") ierr
Expand Down Expand Up @@ -2985,13 +2985,13 @@ subroutine diag_dseupd_p(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
9000 continue
!
!dec$ if (blacs_ > 0)
#if blacs_ > 0
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
!dec$ end if
!dec$ if (mpi_ > 0)
#endif
#if mpi_ > 0
call MPI_FINALIZE(rc)
!dec$ end if
#endif


deallocate(v,workl,workd,d,resid,select,mv_buf)
Expand Down Expand Up @@ -3136,17 +3136,17 @@ subroutine dseupd_omp_arpack(n,bterm,nroots,factor,maxitr_,tol,h,e)
! has been exceeded.
!

!dec$ if (omparpack_ > 0)
#if omparpack_ > 0
!
call dsaupd_ ( ido, bmat, n, which, nev, tol, resid, &
ncv, v, ldv, iparam, ipntr, workd, workl, &
lworkl, info )
!dec$ else
#else
!
write(out,"(/'Arpack was not activated yet. Please uncomment dsaupd and dseupd bellow')")
stop 'Arpack was not activated'
!
!dec$ end if
#endif
!
!if (verbose>=4.and.iparam(5)>0) then
! !
Expand Down Expand Up @@ -3182,7 +3182,7 @@ subroutine dseupd_omp_arpack(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
rvec = .true.
!
!dec$ if (omparpack_ > 0)
#if omparpack_ > 0
!
if (verbose>=5) write(out,"(/'Arpack: dseupd')")
!
Expand All @@ -3196,12 +3196,12 @@ subroutine dseupd_omp_arpack(n,bterm,nroots,factor,maxitr_,tol,h,e)
!
if (verbose>=5) write(out,"(/'Arpack: done!')")
!
!dec$ else
#else
!
write(out,"(/'Arpack was not activated yet. Please uncomment dsaupd and dseupd bellow')")
stop 'Arpack was not activated'
!
!dec$ end if
#endif
!
if ( ierr < 0 ) then
write(out,"(/'Error with_seupd, info = ',i8)") ierr
Expand Down Expand Up @@ -3294,15 +3294,15 @@ subroutine diag_propack(n,bterm,nroots,factor,maxiter,iverbose,tol,h,e)
if (iverbose>=2) call TimerStart('diag_propack: diagonalization')
!
!
!dec$ if (propack_ < 1)
#if propack_ < 1
!
write(out,'("PROPACK is not activated!")')
stop 'PROPACK is not activated!'
e = 0
nroots = 0
return
!
!dec$ endif
#endif
!
nev = nroots
!
Expand Down
Loading