10
0
mirror of https://gitlab.com/scemama/eplf synced 2024-12-22 20:35:30 +01:00

EPLF MC OK

This commit is contained in:
Anthony Scemama 2010-05-28 22:08:08 +02:00
parent 0d69dec304
commit 01ef6620cd
2 changed files with 48 additions and 13 deletions

View File

@ -105,10 +105,10 @@ END_PROVIDER
exc = det_exc(k,l,3)
if ( exc < 0 ) then
phase = -0.5d0
phase = -1.0d0
exc = -exc
else
phase = 0.5d0
phase = 1.0d0
endif
if ( exc == 0 ) then

View File

@ -114,23 +114,58 @@ BEGIN_PROVIDER [ real, grid_$X, (grid_x_num,grid_y_num,grid_z_num) ]
enddo
IRP_IF MPI
! integer :: dim, ierr
! do iz=1,grid_z_num
! real :: buffer(grid_x_num*grid_y_num+1)
! icount = 0
! do iy=1,grid_y_num
! do ix=1,grid_x_num
! buffer(icount+ix) = grid_$X(ix,iy,iz)
! enddo
! icount = icount + grid_x_num
! enddo
! dim = grid_x_num * grid_y_num
! call MPI_REDUCE(buffer,grid_$X(1,1,iz),dim,mpi_real, &
! mpi_sum,0,MPI_COMM_WORLD,ierr)
! if (ierr /= MPI_SUCCESS) then
! call abrt(irp_here,'Unable to fetch buffer')
! endif
! call barrier
! enddo
! integer :: dim, ierr
! real :: buffer(grid_x_num*grid_y_num*grid_z_num)
! icount = 0
! do iz=1,grid_z_num
! do iy=1,grid_y_num
! do ix=1,grid_x_num
! buffer(icount+ix) = grid_$X(ix,iy,iz)
! enddo
! icount = icount + grid_x_num
! enddo
! enddo
! dim = grid_x_num * grid_y_num * grid_y_num
! call MPI_REDUCE(buffer,grid_$X,dim,mpi_real, &
! mpi_sum,0,MPI_COMM_WORLD,ierr)
! if (ierr /= MPI_SUCCESS) then
! call abrt(irp_here,'Unable to fetch buffer')
! endif
integer :: dim, ierr
dim = grid_x_num
do iz=1,grid_z_num
real :: buffer(grid_x_num*grid_y_num+1)
icount = 0
real :: buffer(grid_x_num)
do iy=1,grid_y_num
do ix=1,grid_x_num
buffer(icount+ix) = grid_$X(ix,iy,iz)
buffer(ix) = grid_$X(ix,iy,iz)
enddo
icount = icount + grid_x_num
call MPI_REDUCE(buffer,grid_$X(1,iy,iz),dim,mpi_real, &
mpi_sum,0,MPI_COMM_WORLD,ierr)
if (ierr /= MPI_SUCCESS) then
call abrt(irp_here,'Unable to fetch buffer')
endif
call barrier
enddo
dim = grid_x_num * grid_y_num
call MPI_REDUCE(buffer,grid_$X(1,1,iz),dim,mpi_real, &
mpi_sum,0,MPI_COMM_WORLD,ierr)
if (ierr /= MPI_SUCCESS) then
call abrt(irp_here,'Unable to fetch buffer')
endif
call barrier
enddo
IRP_ENDIF