eplf/eplf_grid.irp.f

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