BEGIN_PROVIDER [ character*(100), grid_data_filename ] BEGIN_DOC ! Name of the file containing the parameters of the grid END_DOC grid_data_filename = 'eplf_grid.data' END_PROVIDER BEGIN_PROVIDER [ character*(100), grid_cube_filename ] BEGIN_DOC ! Name of the file containing the parameters of the grid END_DOC grid_cube_filename = 'eplf_grid.cube' END_PROVIDER BEGIN_PROVIDER [ integer, grid_eplf_x_num ] &BEGIN_PROVIDER [ integer, grid_eplf_y_num ] &BEGIN_PROVIDER [ integer, grid_eplf_z_num ] &BEGIN_PROVIDER [ real , grid_eplf_step , (3) ] &BEGIN_PROVIDER [ real , grid_eplf_origin, (3) ] real, parameter :: UNDEFINED=123456789.123456789 BEGIN_DOC ! Number of grid points in x, y, z directions END_DOC integer :: Npoints(3) real :: step_size(3) real :: origin(3) real :: opposite(3) namelist /eplf_grid/ Npoints, step_size, origin, opposite Npoints (:) = 80 origin (:) = UNDEFINED opposite (:) = UNDEFINED step_size(:) = UNDEFINED logical :: do_next inquire(file=grid_data_filename,exist=do_next) if (do_next) then open(99,file=grid_data_filename,action='READ',status='OLD') read(99,eplf_grid,end=90,err=80) close(99) endif 90 continue if (origin(1) == UNDEFINED) then integer :: i,l do l=1,3 origin(l) = nucl_coord(1,l) do i=2,nucl_num origin(l) = min(origin(l),nucl_coord(i,l)) enddo origin(l) = origin(l) - 4. enddo endif if (opposite(1) == UNDEFINED) then do l=1,3 opposite(l) = nucl_coord(1,l) do i=2,nucl_num opposite(l) = max(opposite(l),nucl_coord(i,l)) enddo opposite(l) = opposite(l) + 4. enddo endif if (step_size(1) == UNDEFINED) then do l=1,3 step_size(l) = (opposite(l) - origin(l))/float(Npoints(l)) enddo endif do l=1,3 grid_eplf_origin(l) = origin(l) grid_eplf_step(l) = step_size(l) enddo grid_eplf_x_num = Npoints(1) grid_eplf_y_num = Npoints(2) grid_eplf_z_num = Npoints(3) return 80 continue print *, 'Error in input file' stop 1 END_PROVIDER BEGIN_PROVIDER [ real, grid_eplf, (grid_eplf_x_num,grid_eplf_y_num,grid_eplf_z_num) ] implicit none BEGIN_DOC ! EPLF on a grid END_DOC IRP_IF MPI include 'mpif.h' IRP_ENDIF integer :: ix, iy, iz integer :: ibegin, iend do iz=1,grid_eplf_z_num do iy=1,grid_eplf_y_num do ix=1,grid_eplf_x_num grid_eplf(ix,iy,iz) = 0. enddo enddo enddo integer :: icount icount = mpi_size do iz=1,grid_eplf_z_num if (mpi_master) then print *, iz endif point(3) = grid_eplf_origin(3)+(iz-1)*grid_eplf_step(3) do iy=1,grid_eplf_y_num point(2) = grid_eplf_origin(2)+(iy-1)*grid_eplf_step(2) do ix=1,grid_eplf_x_num icount = icount-1 if (icount == mpi_rank) then point(1) = grid_eplf_origin(1)+(ix-1)*grid_eplf_step(1) TOUCH point grid_eplf(ix,iy,iz) = eplf_value endif if (icount == 0) then icount = mpi_size endif enddo enddo enddo IRP_IF MPI integer :: dim, ierr real :: buffer(grid_eplf_x_num*grid_eplf_y_num*grid_eplf_z_num) icount = 0 do iz=1,grid_eplf_z_num do iy=1,grid_eplf_y_num do ix=1,grid_eplf_x_num buffer(icount+ix) = grid_eplf(ix,iy,iz) enddo icount = icount + grid_eplf_x_num enddo enddo dim = grid_eplf_x_num * grid_eplf_y_num * grid_eplf_z_num call MPI_REDUCE(buffer,grid_eplf,dim,mpi_real, & mpi_sum,0,MPI_COMM_WORLD,ierr) call MPI_BARRIER(MPI_COMM_WORLD,ierr) IRP_ENDIF END_PROVIDER subroutine write_grid_eplf implicit none integer :: i integer :: l integer :: ix, iy, iz if (.not.mpi_master) then return endif open(unit=99,file=grid_cube_filename,status='UNKNOWN',action='WRITE') write (99,*) 'Cube File' write (99,*) 'Analytical EPLF grid' write (99,10) nucl_num,(grid_eplf_origin(i), i=1,3) write (99,10) grid_eplf_x_num, grid_eplf_step(1), 0., 0. write (99,10) grid_eplf_y_num, 0., grid_eplf_step(2), 0. write (99,10) grid_eplf_z_num, 0., 0., grid_eplf_step(3) do i=1,nucl_num write (99,11) int(nucl_charge(i)), nucl_charge(i), (nucl_coord(i,l),l=1,3) enddo do ix = 1, grid_eplf_x_num do iy = 1, grid_eplf_y_num write (99,20) (grid_eplf(ix,iy,iz), iz=1, grid_eplf_z_num) enddo enddo 10 format (2X,I3,3(2X,F10.6)) 11 format (2X,I3,4(2X,F10.6)) 20 format (6(E13.5)) close(99) end