ps_cpi_file.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module ps_cpi_file_oct_m
  use debug_oct_m
  use global_oct_m
  use messages_oct_m
  use profiling_oct_m
  use ps_in_grid_oct_m
 
  implicit none
 
  private
 
  public ::                &
    ps_cpi_file_t,          &
    ps_cpi_file_read,       &
    ps_cpi_file_end
 
  type ps_cpi_file_t
    ! Components are public by default
    real(real64)       :: zval
    integer            :: no_l_channels
 
    integer            :: nr
    real(real64)       :: a
 
    real(real64), allocatable :: rofi(:)
    real(real64), allocatable :: vps(:,:)
    real(real64), allocatable :: rphi(:,:)
 
    logical            :: core_corrections
    real(real64), allocatable :: chcore(:)
    real(real64), allocatable, private :: d1chcore(:)
    real(real64), allocatable, private :: d2chcore(:)
  end type ps_cpi_file_t
 
contains
 
  ! ---------------------------------------------------------
  subroutine ps_cpi_file_read(unit, psf)
    integer,             intent(in)    :: unit
    type(ps_cpi_file_t), intent(inout) :: psf
 
    integer  :: i, l, ios, idummy
    real(real64)    :: a, b, c, d
 
    push_sub(ps_cpi_file_read)
 
    read(unit, *) psf%zval, psf%no_l_channels
    ! skip 10 lines
    do i = 1, 10
      read(unit, *)
    end do
 
    read(unit, *) psf%nr, psf%a
 
    ! add extra point for the zero
    psf%nr = psf%nr + 1
 
    safe_allocate(psf%rofi   (1:psf%nr))
    safe_allocate(psf%vps    (1:psf%nr, 1:psf%no_l_channels))
    safe_allocate(psf%rphi   (1:psf%nr, 1:psf%no_l_channels))
 
    do l = 1, psf%no_l_channels
      if (l /= 1) read(unit, *)
 
      do i = 2, psf%nr
        read(unit, *) idummy, psf%rofi(i), psf%rphi(i, l), psf%vps(i, l)
      end do
    end do
 
    ! read core charge (if present)
    read(unit, *, iostat=ios) a, b, c, d
    if (ios == 0) then
      psf%core_corrections = .true.
 
      safe_allocate(psf%chcore  (1:psf%nr))
      safe_allocate(psf%d1chcore(1:psf%nr))
      safe_allocate(psf%d2chcore(1:psf%nr))
 
      psf%  chcore(2) = b
      psf%d1chcore(2) = c
      psf%d2chcore(2) = d
 
      do i = 3, psf%nr
        read(unit, *) a, psf%chcore(i), psf%d1chcore(i), psf%d2chcore(i)
      end do
    else
      psf%core_corrections = .false.
    end if
 
    ! add extra point at zero
    psf%rofi(1) = m_zero
    do l = 1, psf%no_l_channels
      psf%vps(1,  l) = first_point_extrapolate(psf%rofi, psf%vps(:, l))
 
      psf%rphi(1, l) = m_zero
    end do
 
    if (psf%core_corrections) then
      ! At this point, we use the normalization of the siesta format, where
      ! psf%chcore(:) = 4*pi*\tilde{rho} r**2. As in the Fritz-Haber file we
      ! have written 4*pi*\tilde{rho}, we multiply by r**2
      psf%chcore(:) = psf%chcore(:) * psf%rofi(:)**2
 
      psf%chcore(1) = first_point_extrapolate(psf%rofi, psf%chcore)
      psf%d1chcore(1) = first_point_extrapolate(psf%rofi, psf%d1chcore)
      psf%d2chcore(1) = first_point_extrapolate(psf%rofi, psf%d2chcore)
    end if
 
    ! WARNING: This should go away
    psf%vps(:,:) = psf%vps(:,:)*m_two ! convert to Rydbergs
 
    pop_sub(ps_cpi_file_read)
  end subroutine ps_cpi_file_read
 
 
  ! ---------------------------------------------------------
  subroutine ps_cpi_file_end(psf)
    type(ps_cpi_file_t), intent(inout) :: psf
 
    push_sub(ps_cpi_file_end)
 
    safe_deallocate_a(psf%rofi)
    safe_deallocate_a(psf%vps)
    safe_deallocate_a(psf%rphi)
 
    if (psf%core_corrections) then
      safe_deallocate_a(psf%chcore)
      safe_deallocate_a(psf%d1chcore)
      safe_deallocate_a(psf%d2chcore)
    end if
 
    pop_sub(ps_cpi_file_end)
  end subroutine ps_cpi_file_end
 
end module ps_cpi_file_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: