open_basis_file Subroutine

public subroutine open_basis_file(basis_file, filename, error)

Open and read a GAMESS formatted basis set file

Arguments

Type IntentOptional Attributes Name
type(basis_file_t), intent(out) :: basis_file
character(len=*), intent(in) :: filename
type(error_t), intent(out) :: error

Calls

proc~~open_basis_file~~CallsGraph proc~open_basis_file open_basis_file proc~error_set error_t%error_set proc~open_basis_file->proc~error_set

Variables

Type Visibility Attributes Name Initial
integer, private :: data_end
integer, private :: data_start
logical, private :: file_exists
integer, private :: file_size
integer, private :: iostat
integer, private :: unit

Source Code

   subroutine open_basis_file(basis_file, filename, error)
      !! Open and read a GAMESS formatted basis set file
      type(basis_file_t), intent(out) :: basis_file
      character(len=*), intent(in) :: filename
      type(error_t), intent(out) :: error

      integer :: unit, iostat, file_size
      logical :: file_exists
      integer :: data_start, data_end

      ! Check if file exists
      inquire (file=filename, exist=file_exists, size=file_size)
      if (.not. file_exists) then
         call error%set(ERROR_IO, "Basis set file not found: "//filename)
         return
      end if

      ! Allocate buffer for entire file
      allocate (character(len=file_size) :: basis_file%full_content)

      ! Open and read entire file
      open (newunit=unit, file=filename, status='old', action='read', &
            access='stream', form='unformatted', iostat=iostat)
      if (iostat /= 0) then
         call error%set(ERROR_IO, "Error opening file: "//filename)
         return
      end if

      read (unit, iostat=iostat) basis_file%full_content
      if (iostat /= 0) then
         close (unit)
         call error%set(ERROR_IO, "Error reading file: "//filename)
         return
      end if
      close (unit)

      ! Extract the $DATA section
      data_start = index(basis_file%full_content, "$DATA")
      if (data_start == 0) then
         call error%set(ERROR_VALIDATION, "Could not find $DATA section in basis set file: "//filename)
         return
      end if

      data_end = index(basis_file%full_content(data_start:), "$END")
      if (data_end == 0) then
         call error%set(ERROR_VALIDATION, "Could not find $END marker in basis set file: "//filename)
         return
      end if

      ! Store just the data section (between $DATA and $END)
      basis_file%data_section = basis_file%full_content(data_start + 5:data_start + data_end - 2)

   end subroutine open_basis_file