qmcchem/src/nuclei.irp.f

 BEGIN_PROVIDER [ integer, nucl_num ]
&BEGIN_PROVIDER [ integer, nucl_num_8 ]
  implicit none
  BEGIN_DOC
! Number of nuclei
  END_DOC
  
  nucl_num = -1
  call get_nuclei_nucl_num(nucl_num)
  if (nucl_num <= 0) then
    call abrt(irp_here,'Number of nuclei should be > 0')
  endif
  integer, external              :: mod_align
  nucl_num_8 = mod_align(nucl_num)
   
END_PROVIDER

 
BEGIN_PROVIDER  [ real, nucl_charge, (nucl_num) ]
  implicit none
  BEGIN_DOC
! Nuclear charge
  END_DOC
  
  nucl_charge = -1.d0
  call get_nuclei_nucl_charge(nucl_charge)
  
  integer                        :: i
  do i=1,nucl_num
    if (nucl_charge(i) < 0.) then
      call abrt(irp_here,'Nuclear charges should be > 0')
    endif
  enddo
END_PROVIDER

 
BEGIN_PROVIDER [ real, nucl_coord,  (nucl_num_8,3) ]
  implicit none
  BEGIN_DOC
! Nuclear coordinates
  END_DOC
  
  nucl_coord = 0.
  real, allocatable              :: buffer(:,:)
  allocate (buffer(nucl_num,3))
  buffer = 0.
  call get_nuclei_nucl_coord(buffer)
  integer                        :: i,j
  
  do i=1,3
    do j=1,nucl_num
      nucl_coord(j,i) = buffer(j,i)
    enddo
  enddo
  deallocate(buffer)
  
END_PROVIDER

 
BEGIN_PROVIDER [ real, nucl_coord_transp, (8,nucl_num)
  implicit none
  BEGIN_DOC
! Transposed array of nucl_coord
  END_DOC
  integer                        :: i, k
  integer, save                  :: ifirst = 0
  if (ifirst == 0) then
    ifirst = 1
    nucl_coord_transp = 0.
  endif
  
  !DIR$ VECTOR ALIGNED
  do i=1,nucl_num
    nucl_coord_transp(1,i) = nucl_coord(i,1)
    nucl_coord_transp(2,i) = nucl_coord(i,2)
    nucl_coord_transp(3,i) = nucl_coord(i,3)
  enddo
END_PROVIDER

 
 BEGIN_PROVIDER [ real, nucl_dist, (nucl_num_8,nucl_num) ]
&BEGIN_PROVIDER [ real, nucl_dist_vec_x, (nucl_num_8,nucl_num) ]
&BEGIN_PROVIDER [ real, nucl_dist_vec_y, (nucl_num_8,nucl_num) ]
&BEGIN_PROVIDER [ real, nucl_dist_vec_z, (nucl_num_8,nucl_num) ]
  implicit none
  BEGIN_DOC
! nucl_dist     : Nucleus-nucleus distances : nucl_dist(i,j) = |R_i-R_j|
   
! nucl_dist_vec : Nucleus-nucleus distances vectors
  END_DOC
   
  integer                        :: ie1, ie2, l
  integer,save                   :: ifirst = 0
  if (ifirst == 0) then
    ifirst = 1
    nucl_dist = 0.
    nucl_dist_vec_x = 0.
    nucl_dist_vec_y = 0.
    nucl_dist_vec_z = 0.
  endif
  
  do ie2 = 1,nucl_num
    !DIR$ VECTOR ALIGNED
    !DIR$ LOOP COUNT (100)
    do ie1 = 1,nucl_num
      nucl_dist_vec_x(ie1,ie2) = nucl_coord(ie1,1) - nucl_coord(ie2,1)
      nucl_dist_vec_y(ie1,ie2) = nucl_coord(ie1,2) - nucl_coord(ie2,2)
      nucl_dist_vec_z(ie1,ie2) = nucl_coord(ie1,3) - nucl_coord(ie2,3)
    enddo
    !DIR$ VECTOR ALIGNED
    !DIR$ LOOP COUNT (100)
    do ie1 = 1,nucl_num
      nucl_dist  (ie1,ie2) = nucl_dist_vec_x(ie1,ie2)*nucl_dist_vec_x(ie1,ie2) +&
          nucl_dist_vec_y(ie1,ie2)*nucl_dist_vec_y(ie1,ie2) +       &
          nucl_dist_vec_z(ie1,ie2)*nucl_dist_vec_z(ie1,ie2)
      nucl_dist(ie1,ie2) = sqrt(nucl_dist  (ie1,ie2))
      ASSERT (nucl_dist(ie1,ie2) > 0.)
    enddo
  enddo
   
END_PROVIDER
 
BEGIN_PROVIDER [ real, nucl_fitcusp_radius, (nucl_num) ]
  implicit none
  BEGIN_DOC
! Distance threshold for the fit
  END_DOC
  real                           :: def(nucl_num), factor
  integer                        :: k
  real, parameter                :: a = 1.74891
  real, parameter                :: b = 0.126057
  
  if (.not. do_nucl_fitcusp) then
    nucl_fitcusp_radius = 0.d0
    return
  endif

  do k=1,nucl_num
    nucl_fitcusp_radius(k) = nucl_fitcusp_factor/(a*nucl_charge(k)+b)
  enddo

  ! Avoid dummy atoms
  do k=1,nucl_num
    if (nucl_charge(k) < 5.d-1) then
      nucl_fitcusp_radius(k) = 0.
    endif
  enddo
   
END_PROVIDER