Skip to content
Snippets Groups Projects
Commit 92848e02 authored by Bastian Schütrumpf's avatar Bastian Schütrumpf
Browse files

Merge branch 'revert-ad20b904' into 'master' 

Revert "new modifications removing communication,calc matrix and recombine"

See merge request !1
parents ad20b904 c4af1611
No related branches found
No related tags found
1 merge request!1Revert "new modifications removing communication,calc matrix and recombine"
Expand all Hide whitespace changes
Inline Side-by-side
Code/linalg_scalapack.f90 deleted 100755 → 0
+ 0
− 95
View file @ ad20b904
MODULE LINALG
USE Params, ONLY: db,cmplxzero,cmplxone
USE Levels
USE Parallel, ONLY: nb,mb,contxt,nstloc_x,nstloc_y,globalindex_x,globalindex_y,nb_psi
!
IMPLICIT NONE
INTEGER :: nlin(2)
INTEGER :: desca(2,10),descz(2,10),descc(2,10),desc_t(2,10)&
, work_t_size(2),iwork_t_size(2),rwork_t_size(2)
!
REAL(db) ,ALLOCATABLE :: rwork_t(:),evals(:)
COMPLEX(db),ALLOCATABLE :: work_t(:),matr_lin(:,:),unitary(:,:)
INTEGER ,ALLOCATABLE :: iwork_t(:)
!
CONTAINS
!************************************************************
SUBROUTINE init_linalg
INTEGER :: iq,infoconv
DO iq=1,2
nlin(iq)=npsi(iq)-npmin(iq)+1
CALL DESCINIT(DESCA(iq,1:10),npsi(iq)-npmin(iq)+1,npsi(iq)-npmin(iq)+1,&
NB,MB,0,0,CONTXT,nstloc_x(iq),infoconv)
CALL DESCINIT(DESCZ(iq,1:10),npsi(iq)-npmin(iq)+1,npsi(iq)-npmin(iq)+1,&
NB,MB,0,0,CONTXT,nstloc_x(iq),infoconv)
CALL DESCINIT(DESCC(iq,1:10),npsi(iq)-npmin(iq)+1,npsi(iq)-npmin(iq)+1,&
NB,MB,0,0,CONTXT,nstloc_x(iq),infoconv)
CALL DESCINIT(DESC_T(iq,1:10),nx*ny*nz*2,npsi(iq)-npmin(iq)+1,nx*ny*nz*2,&
nb_psi,0,0,CONTXT,nx*ny*nz*2,infoconv)
work_t_size(iq) = -1
iwork_t_size(iq) = -1
rwork_t_size(iq) = -1
ALLOCATE(work_t(1),iwork_t(1),rwork_t(1),matr_lin(nstloc_x(iq),nstloc_y(iq)),&
unitary(nstloc_x(iq),nstloc_y(iq)),evals(nlin(iq)))
CALL PZHEEVD('V','L',nlin(iq),matr_lin,1,1,DESCA(iq,1:10),evals,&
unitary,1,1,DESCZ(iq,1:10),work_t,work_t_size(iq),rwork_t,&
rwork_t_size(iq),iwork_t,iwork_t_size(iq),infoconv)
work_t_size(iq) = INT(ABS(work_t(1)))
iwork_t_size(iq) = INT(ABS(iwork_t(1)))
rwork_t_size(iq) = INT(ABS(rwork_t(1)))
DEALLOCATE(work_t,iwork_t,rwork_t,matr_lin,unitary,evals)
END DO
END SUBROUTINE init_linalg
!************************************************************
SUBROUTINE eigenvecs(matr_in,evecs,evals_out,iq)
INTEGER, INTENT(IN) :: iq
COMPLEX(db), INTENT(IN) :: matr_in(:,:)
COMPLEX(db), INTENT(OUT) :: evecs(:,:)
REAL(db), INTENT(OUT),OPTIONAL :: evals_out(:)
INTEGER :: infoconv
ALLOCATE(work_t(work_t_size(iq)),rwork_t(rwork_t_size(iq)),&
iwork_t(iwork_t_size(iq)),evals(nlin(iq)))
CALL PZHEEVD('V','L',nlin(iq),matr_in,1,1,DESCA(iq,1:10),evals,evecs,1,1,DESCZ(iq,1:10),&
work_t,work_t_size(iq),rwork_t,rwork_t_size(iq),iwork_t,iwork_t_size(iq),infoconv)
IF (PRESENT(evals_out))evals_out=evals
DEALLOCATE(evals,work_t,iwork_t,rwork_t)
END SUBROUTINE eigenvecs
!************************************************************
SUBROUTINE loewdin(imatr,smatr,iq)
INTEGER, INTENT(IN) :: iq
COMPLEX(db),INTENT(IN) :: imatr(:,:)
COMPLEX(db),INTENT(OUT) :: smatr(:,:)
COMPLEX(db),ALLOCATABLE :: tmatr(:,:)
REAL(db) ,ALLOCATABLE :: eigen_h(:)
INTEGER :: i,it,jt,iy
ALLOCATE(tmatr(nstloc_x(iq),nstloc_y(iq)),eigen_h(nlin(iq)))
CALL eigenvecs(imatr,tmatr,eigen_h,iq)
eigen_h=1.0d0/sqrt(eigen_h)
DO it = 1,nstloc_x(iq)
DO jt = 1,nstloc_y(iq)
iy = globalindex_y(jt,iq)-npmin(iq)+1
tmatr(it,jt) = tmatr(it,jt)*sqrt(eigen_h(iy))
ENDDO
ENDDO
CALL PZGEMM('N','C',nlin(iq),nlin(iq),nlin(iq),cmplxone,tmatr,1,1,DESCA(iq,1:10),&
tmatr,1,1,DESCZ(iq,1:10),cmplxzero,smatr,1,1,DESCC(iq,1:10))
DEALLOCATE(tmatr,eigen_h)
END SUBROUTINE
!************************************************************
SUBROUTINE comb_orthodiag(unitary_1,unitary_2,unitary,iq)
INTEGER, INTENT(IN) :: iq
COMPLEX(db),INTENT(IN) :: unitary_1(:,:),unitary_2(:,:)
COMPLEX(db),INTENT(OUT) :: unitary(:,:)
CALL PZGEMM('T','T',nlin(iq),nlin(iq),nlin(iq),cmplxone,unitary_1,1,1,DESCA(iq,1:10),unitary_2,&
1,1,DESCZ(iq,1:10),cmplxzero,unitary,1,1,DESCC(iq,1:10))
END SUBROUTINE
!************************************************************
SUBROUTINE recombine(matrix,psi_in,psi_out,iq)
INTEGER, INTENT(IN) :: iq
COMPLEX(db),INTENT(IN) :: psi_in(:),matrix(:,:)
COMPLEX(db),INTENT(OUT) :: psi_out(:)
CALL zgemv('N',nstloc_x(iq),nstloc_y(iq),cmplxone,matrix,nstloc_x(iq),psi_in,1,cmplxzero,&
psi_out,1)
END SUBROUTINE
END MODULE LINALG
Code/parallel.f90
+ 22
− 279
View file @ 92848e02
...@@ -5,24 +5,13 @@ MODULE Parallel ...@@ -5,24 +5,13 @@ MODULE Parallel
IMPLICIT NONE IMPLICIT NONE
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
SAVE SAVE
INTEGER, PARAMETER :: NB=32,MB=32,NB_psi = 32 LOGICAL,PARAMETER :: tmpi=.TRUE.
LOGICAL, PARAMETER :: tmpi=.TRUE.,ttabc=.FALSE. INTEGER, ALLOCATABLE :: node(:),localindex(:),globalindex(:)
INTEGER, ALLOCATABLE :: node(:),localindex(:),globalindex(:),& INTEGER :: mpi_nprocs,mpi_ierror,mpi_myproc
node_x(:),node_y(:),localindex_x(:),localindex_y(:),&
globalindex_x(:,:),globalindex_y(:,:)
INTEGER, ALLOCATABLE :: recvcounts(:,:),displs(:,:)
INTEGER, ALLOCATABLE :: node_2dto1d(:,:),node_1dto2d_x(:),node_1dto2d_y(:)
INTEGER :: mpi_nprocs,mpi_ierror,mpi_myproc
INTEGER :: comm2d,mpi_dims(2),mpi_mycoords(2),nstloc_x(2),nstloc_y(2),first(2)
INTEGER :: comm2d_x,comm2d_y,mpi_size_x,mpi_size_y,mpi_rank_x,mpi_rank_y
INTEGER :: NPROCS,NPROW,NPCOL,MYPROW,MYPCOL,CONTXT,IAM
INTEGER, EXTERNAL :: NUMROC,INDXL2G,INDXG2L,INDXG2P
REAL(db) :: timer(20)
CONTAINS CONTAINS
!*********************************************************************** !***********************************************************************
SUBROUTINE alloc_nodes SUBROUTINE alloc_nodes
ALLOCATE(node(nstmax),localindex(nstmax),globalindex(nstmax),& ALLOCATE(node(nstmax),localindex(nstmax),globalindex(nstmax))
localindex_x(nstmax),localindex_y(nstmax))
END SUBROUTINE alloc_nodes END SUBROUTINE alloc_nodes
!*********************************************************************** !***********************************************************************
SUBROUTINE init_all_mpi SUBROUTINE init_all_mpi
...@@ -33,123 +22,15 @@ CONTAINS ...@@ -33,123 +22,15 @@ CONTAINS
IF(wflag) WRITE(*,'(a,i5)') ' number of nodes=',mpi_nprocs IF(wflag) WRITE(*,'(a,i5)') ' number of nodes=',mpi_nprocs
CALL mpi_barrier (mpi_comm_world, mpi_ierror) CALL mpi_barrier (mpi_comm_world, mpi_ierror)
END SUBROUTINE init_all_mpi END SUBROUTINE init_all_mpi
!************************************************************************
SUBROUTINE mpi_init_filename
CONTINUE
END SUBROUTINE mpi_init_filename
!************************************************************************
FUNCTION tabc_av(val)
REAL(db),INTENT(IN) :: val
REAL(db) :: tabc_av
tabc_av=val
END FUNCTION tabc_av
!************************************************************************
FUNCTION tabc_dens(density)
REAL(db),INTENT(IN) :: density(nx,ny,nz,2)
REAL(db) :: tabc_dens(nx,ny,nz,2)
tabc_dens=density
END FUNCTION tabc_dens
!************************************************************************
FUNCTION tabc_vec_dens(density)
REAL(db),INTENT(IN) :: density(nx,ny,nz,3,2)
REAL(db) :: tabc_vec_dens(nx,ny,nz,3,2)
tabc_vec_dens=density
END FUNCTION tabc_vec_dens
!************************************************************************
FUNCTION tabc_filename(filename)
CHARACTER(64),INTENT(IN) :: filename
CHARACTER(64) :: tabc_filename
tabc_filename=filename
END FUNCTION tabc_filename
!***********************************************************************
SUBROUTINE init_mpi_2d
!***********************************************************************
! calculates 2d wave function distribution over nodes
!***********************************************************************
LOGICAL :: isperiodic(2),reorder
INTEGER :: i,is,noffset
isperiodic=.FALSE.
reorder=.FALSE.
!Calculate best dimensions for the given number of processes
CALL mpi_dims_create(mpi_nprocs,2,mpi_dims,mpi_ierror)
!Create 2-dimensional grid of processes to calculate the matrices in diagstep
CALL mpi_cart_create(mpi_comm_world,2,mpi_dims,isperiodic,reorder,comm2d,mpi_ierror)
!get my coordinates on the grid
CALL mpi_cart_get(comm2d,2,mpi_dims,isperiodic,mpi_mycoords,mpi_ierror)
IF(wflag)WRITE(*,*)'Initialized 2d-grid with dimensions ',mpi_dims(1),' and',mpi_dims(2)
!Create communicators for x- and y-directions
CALL mpi_comm_split(comm2d,mpi_mycoords(2),mpi_mycoords(1),comm2d_x,mpi_ierror)
CALL mpi_comm_split(comm2d,mpi_mycoords(1),mpi_mycoords(2),comm2d_y,mpi_ierror)
!determine their sizes and ranks (is already known, just to make sure)
CALL mpi_comm_size(comm2d_x,mpi_size_x,mpi_ierror)
CALL mpi_comm_rank(comm2d_x,mpi_rank_x,mpi_ierror)
CALL mpi_comm_size(comm2d_y,mpi_size_y,mpi_ierror)
CALL mpi_comm_rank(comm2d_y,mpi_rank_y,mpi_ierror)
CALL init_blacs
DO is=1,2
nstloc_x(is) = NUMROC(npsi(is)-npmin(is)+1,NB,MYPROW,0,NPROW)
nstloc_y(is) = NUMROC(npsi(is)-npmin(is)+1,MB,MYPCOL,0,NPCOL)
END DO
ALLOCATE(node_x(nstmax),node_y(nstmax),globalindex_x(nstmax,2),globalindex_y(nstmax,2))
globalindex_x=0
globalindex_y=0
DO is=1,2
noffset=npmin(is)-1
DO i=npmin(is),npsi(is)
localindex_x(i) = INDXG2L(i-noffset, NB, MYPROW, 0, NPROW)
localindex_y(i) = INDXG2L(i-noffset, MB, MYPCOL, 0, NPCOL)
node_x(i) = INDXG2P(i-noffset, NB, MYPROW, 0, NPROW)
node_y(i) = INDXG2P(i-noffset, MB, MYPCOL, 0, NPCOL)
IF(node_x(i)==mpi_rank_x) globalindex_x(localindex_x(i),is)=i
IF(node_y(i)==mpi_rank_y) globalindex_y(localindex_y(i),is)=i
END DO
END DO
END SUBROUTINE init_mpi_2d
!***************************************************************************
SUBROUTINE init_blacs
CALL BLACS_PINFO(IAM,NPROCS)
IF (NPROCS.LT.1) THEN
CALL BLACS_SETUP(IAM,NPROCS)
END IF
NPROW=mpi_dims(1)
NPCOL=mpi_dims(2)
CALL BLACS_GET(0,0,CONTXT)
CALL BLACS_GRIDINIT(CONTXT,'Row',NPROW,NPCOL)
CALL BLACS_GRIDINFO(CONTXT,NPROW,NPCOL,MYPROW,MYPCOL)
IF(mpi_rank_x/=MYPROW.OR.mpi_rank_y/=MYPCOL) STOP 'BLACS and MPI init is different'
END SUBROUTINE init_blacs
!*********************************************************************** !***********************************************************************
SUBROUTINE associate_nodes SUBROUTINE associate_nodes
!*********************************************************************** INTEGER :: ncount,nst,ip,iloc
! calculates 1d wave function distribution over nodes
!***********************************************************************
INTEGER :: ncount,nst,ip,iloc,iq,mpi_ierror
ncount=0 ncount=0
globalindex=0 DO nst=1,nstmax
node=0 ncount=MOD(ncount,mpi_nprocs)
! DO iq=1,2 node(nst)=ncount
! DO nst=1,nstloc_x(iq) ncount=ncount+1
! IF(INT(REAL(nst-1)/nstloc_x(iq)*mpi_size_y)==mpi_rank_y) & ENDDO
! node(globalindex_x(nst,iq))=mpi_myproc
! END DO
! END DO
! CALL mpi_allreduce(MPI_IN_PLACE,node,nstmax,mpi_integer,mpi_sum,mpi_comm_world,mpi_ierror)
DO iq=1,2
DO nst=npmin(iq),npsi(iq)
node(nst)=MOD((nst-npmin(iq))/nb_psi,mpi_nprocs)
END DO
END DO
nstloc=0 nstloc=0
DO nst=1,nstmax DO nst=1,nstmax
IF(node(nst)==mpi_myproc) THEN IF(node(nst)==mpi_myproc) THEN
...@@ -158,35 +39,25 @@ CONTAINS ...@@ -158,35 +39,25 @@ CONTAINS
ENDIF ENDIF
ENDDO ENDDO
DO ip=0,mpi_nprocs-1 DO ip=0,mpi_nprocs-1
iloc=0 iloc=0
DO nst=1,nstmax DO nst=1,nstmax
IF(node(nst)==ip) THEN IF(node(nst)==ip) THEN
iloc=iloc+1 iloc=iloc+1
localindex(nst)=iloc localindex(nst)=iloc
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
IF(wflag) THEN
WRITE(*,'(A/(1X,20I4))') &
' sorting of wfs on nodes:',node(1:nstmax)
ENDIF
CALL mpi_barrier (mpi_comm_world, mpi_ierror) CALL mpi_barrier (mpi_comm_world, mpi_ierror)
CALL mpi_relate_comm
END SUBROUTINE associate_nodes END SUBROUTINE associate_nodes
!***********************************************************************
SUBROUTINE mpi_relate_comm
ALLOCATE(node_1dto2d_x(0:mpi_nprocs-1),node_1dto2d_y(0:mpi_nprocs-1),&
node_2dto1d(0:mpi_size_x-1,0:mpi_size_y-1))
node_1dto2d_x=0
node_1dto2d_y=0
node_2dto1d=0
node_1dto2d_x(mpi_myproc)=mpi_rank_x
node_1dto2d_y(mpi_myproc)=mpi_rank_y
node_2dto1d(mpi_rank_x,mpi_rank_y)=mpi_myproc
CALL mpi_allreduce(MPI_IN_PLACE,node_1dto2d_x,mpi_nprocs,mpi_integer,mpi_sum,mpi_comm_world,mpi_ierror)
CALL mpi_allreduce(MPI_IN_PLACE,node_1dto2d_y,mpi_nprocs,mpi_integer,mpi_sum,mpi_comm_world,mpi_ierror)
CALL mpi_allreduce(MPI_IN_PLACE,node_2dto1d,mpi_nprocs,mpi_integer,mpi_sum,mpi_comm_world,mpi_ierror)
END SUBROUTINE mpi_relate_comm
!*********************************************************************** !***********************************************************************
SUBROUTINE collect_densities SUBROUTINE collect_densities
USE Densities, ONLY : rho,tau,current,sodens,sdens USE Densities, ONLY : rho,tau,current,sodens,sdens
REAL(db) :: tmp_rho(nx,ny,nz,2),tmp_current(nx,ny,nz,3,2) REAL(db) :: tmp_rho(nx,ny,nz,2),tmp_current(nx,ny,nz,3,2)
REAL(db) :: rsum
CALL mpi_barrier (mpi_comm_world, mpi_ierror) CALL mpi_barrier (mpi_comm_world, mpi_ierror)
CALL mpi_allreduce(rho,tmp_rho,2*nx*ny*nz, & CALL mpi_allreduce(rho,tmp_rho,2*nx*ny*nz, &
mpi_double_precision,mpi_sum,mpi_comm_world,mpi_ierror) mpi_double_precision,mpi_sum,mpi_comm_world,mpi_ierror)
...@@ -237,137 +108,9 @@ CONTAINS ...@@ -237,137 +108,9 @@ CONTAINS
sp_parity=tmpgat sp_parity=tmpgat
CALL mpi_barrier (mpi_comm_world,mpi_ierror) CALL mpi_barrier (mpi_comm_world,mpi_ierror)
END SUBROUTINE collect_sp_properties END SUBROUTINE collect_sp_properties
!***********************************************************************
SUBROUTINE collect_energies(delesum,sumflu)
!***********************************************************************
! collects s.p. energies, fluctuation measure and energy differences
!***********************************************************************
REAL(db),INTENT(INOUT) :: delesum,sumflu
REAL(db) :: tmpgat(nstmax),tmpgat3(3,nstmax)
INTEGER :: nst
CALL mpi_barrier (mpi_comm_world,mpi_ierror)
DO nst=1,nstmax
IF(node(nst)/=mpi_myproc) THEN
sp_energy(nst)=0.0d0
sp_efluct1(nst)=0.0d0
sp_efluct2(nst)=0.0d0
END IF
ENDDO
CALL mpi_allreduce(sp_energy,tmpgat,nstmax,mpi_double_precision,mpi_sum, &
mpi_comm_world,mpi_ierror)
sp_energy=tmpgat
CALL mpi_allreduce(sumflu,tmpgat(1),1,mpi_double_precision,mpi_sum, &
mpi_comm_world,mpi_ierror)
sumflu=tmpgat(1)
CALL mpi_allreduce(delesum,tmpgat(1),1,mpi_double_precision,mpi_sum, &
mpi_comm_world,mpi_ierror)
delesum=tmpgat(1)
CALL mpi_barrier (mpi_comm_world,mpi_ierror)
END SUBROUTINE collect_energies
!***********************************************************************i
SUBROUTINE mpi_wf_1d2x(psi,psi_x,iq)
USE Trivial
COMPLEX(db),INTENT(IN) :: psi(:,:,:,:,:)
COMPLEX(db),INTENT(OUT) :: psi_x(:,:)
INTEGER, INTENT(IN) :: iq
INTEGER :: nst,ierr,is
IF(.NOT.ALLOCATED(recvcounts)) THEN
ALLOCATE(recvcounts(0:mpi_size_y-1,2),displs(0:mpi_size_y-1,2))
recvcounts=0
displs=0
first(1)=1
DO is=1,2
DO nst=1,nstloc_x(is)
recvcounts(node_1dto2d_y(node(globalindex_x(nst,is))),is)=&
recvcounts(node_1dto2d_y(node(globalindex_x(nst,is))),is)+1
END DO
END DO
first(2)=recvcounts(mpi_rank_y,1)+1
recvcounts=recvcounts*size(psi(:,:,:,:,1))
DO is=1,2
DO nst=1,mpi_size_y-1
displs(nst,is)=SUM(recvcounts(0:nst-1,is))
END DO
END DO
END IF
psi_x=0.0d0
CALL mpi_allgatherv(psi(:,:,:,:,first(iq)),recvcounts(mpi_rank_y,iq),mpi_double_complex,&
psi_x,recvcounts(:,iq),displs(:,iq),mpi_double_complex,comm2d_y,ierr)
END SUBROUTINE mpi_wf_1d2x
!***********************************************************************
SUBROUTINE mpi_wf_x2y(psi_x,psi_y,iq)
COMPLEX(db),INTENT(IN) :: psi_x(:,:)
COMPLEX(db),INTENT(OUT) :: psi_y(:,:)
INTEGER, INTENT(IN) :: iq
INTEGER :: nst,ierr,is,lastnode,ip,first,last
INTEGER,ALLOCATABLE,SAVE :: rootnode(:,:),firstwf(:,:),nwf(:,:)
IF(.NOT.ALLOCATED(rootnode)) THEN
nst=MAX(nstloc_y(1)+1,nstloc_y(2)+1)
ALLOCATE(rootnode(nst,2),firstwf(nst,2),nwf(nst,2))
rootnode=0
firstwf=0
nwf=0
DO is=1,2
lastnode=-1
ip=0
DO nst=1,nstloc_y(is)
IF(lastnode==node_x(globalindex_y(nst,is))) THEN
nwf(ip,is)=nwf(ip,is)+1
ELSE
ip=ip+1
firstwf(ip,is)=nst
nwf(ip,is)=1
lastnode=node_x(globalindex_y(nst,is))
rootnode(ip,is)=lastnode
END IF
END DO
END DO
END IF
psi_y=0.0d0
ip=1
DO WHILE (nwf(ip,iq)>0)
first=firstwf(ip,iq)
last=firstwf(ip,iq)+nwf(ip,iq)-1
IF(rootnode(ip,iq)==mpi_rank_x) &
psi_y(:,first:last)=&
psi_x(:,localindex_x(globalindex_y(first,iq)):localindex_x(globalindex_y(last,iq)))
CALL mpi_bcast(psi_y(:,first:last),size(psi_y(:,first:last)),mpi_double_complex,&
rootnode(ip,iq),comm2d_x,ierr)
ip=ip+1
END DO
END SUBROUTINE mpi_wf_x2y
!***********************************************************************
SUBROUTINE collect_wf_1d_x(psi,psi_x,iq)
!*********************************************************************************
! adds all |psi> together and copies them to 1d distribution over nodes.
! Copies each wave function at a time
!*********************************************************************************
USE Trivial
INTEGER,INTENT(IN) :: iq
COMPLEX(db),INTENT(INOUT) :: psi_x(:,:)
COMPLEX(db),INTENT(OUT) :: psi(:,:,:,:,:)
INTEGER :: ierr
CALL mpi_reduce_scatter(psi_x,psi(:,:,:,:,first(iq)),recvcounts(:,iq),mpi_double_complex,&
mpi_sum,comm2d_y,ierr)
END SUBROUTINE collect_wf_1d_x
!*********************************************************************** !***********************************************************************
SUBROUTINE finish_mpi SUBROUTINE finish_mpi
INTEGER :: ierr INTEGER :: ierr
CALL mpi_finalize(ierr) CALL mpi_finalize(ierr)
END SUBROUTINE finish_mpi END SUBROUTINE finish_mpi
!***********************************************************************
SUBROUTINE mpi_start_timer(index)
INTEGER,INTENT(IN) :: index
INTEGER :: ierr
CALL mpi_barrier (mpi_comm_world,ierr)
timer(index)=mpi_wtime()
END SUBROUTINE mpi_start_timer
!***********************************************************************
SUBROUTINE mpi_stop_timer(index,textline)
INTEGER,INTENT(IN) :: index
CHARACTER(*),INTENT(IN) :: textline
INTEGER :: ierr
CALL mpi_barrier (mpi_comm_world,ierr)
IF(wflag)WRITE(*,'(A20,F10.4)')textline,mpi_wtime()-timer(index)
END SUBROUTINE mpi_stop_timer
END MODULE Parallel END MODULE Parallel
Code/static.f90
+ 247
− 565
View file @ 92848e02
This diff is collapsed.
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment