WriterMatrix_module.f90

Go to the documentation of this file.

! Copyright 2019
!
! For a comprehensive list of the developers that contributed to these codes
! see the UK-AMOR website.
!
! This file is part of UKRmol-in (UKRmol+ suite).
!
!     UKRmol-in 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 3 of the License, or
!     (at your option) any later version.
!
!     UKRmol-in 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  UKRmol-in (in source/COPYING). Alternatively, you can also visit
!     <https://www.gnu.org/licenses/>.
 
module writermatrix_module
 
    use const_gbl,                only: stdout
    use mpi_gbl,                  only: master
    use precisn,                  only: wp
    use scatci_routines,          only: wrtem
    use distributedmatrix_module, only: distributedmatrix
    use matrixcache_module,       only: matrixcache
    use options_module,           only: options
    use parallelization_module,   only: grid => process_grid
 
    implicit none
 
    public writermatrix
 
    private
 
    type, extends(distributedmatrix) :: writermatrix
        type(matrixcache) :: write_cache
 
        integer :: num_elements_per_record
        integer :: matrix_unit
    contains
        procedure, public :: print                   => print_writer
        procedure, public :: finalize_matrix_self    => finalize_matrix_writer
        procedure, public :: set_options             =>  set_options_writer
        procedure, public :: get_matelem_self        => get_matelem_writer
        procedure, public :: clear_matrix            => clear_writer
        procedure, public :: destroy_matrix          => destroy_writer
        procedure, public :: write_cache_to_unit
        procedure, public :: insert_into_diag_matrix => insert_into_write_cache
        procedure, public :: get_matrix_unit
    end type writermatrix
 
contains
 
    integer function get_matrix_unit (this)
        class(writermatrix) :: this
 
        get_matrix_unit = this % matrix_unit
 
    end function get_matrix_unit
 
 
    subroutine set_options_writer (this, option_val)
        class(writermatrix)        :: this
        class(options), intent(in) :: option_val
 
        this % matrix_unit = option_val % hamiltonian_unit
        this % num_elements_per_record = option_val % num_matrix_elements_per_rec
 
        !we set the expansion size to the number of records + 1
        call this % write_cache % construct(this % num_elements_per_record + 1)
 
    end subroutine set_options_writer
 
 
    subroutine get_matelem_writer (this, idx, i, j, coeff)
        class(writermatrix)   :: this
        integer,  intent(in)  :: idx
        integer,  intent(out) :: i, j
        real(wp), intent(out) :: coeff
 
        i = -1
        j = -1
        coeff = -1.0
 
        stop "get element not yet implemented"
 
    end subroutine get_matelem_writer
 
 
    subroutine write_cache_to_unit (this)
        class(writermatrix) :: this
        integer             :: record_count
 
        if (this % write_cache % is_empty()) return
 
        record_count = this % write_cache % get_size()
 
        !Write it all out
        call wrtem(this % matrix_unit, record_count, this % num_elements_per_record, &
                   this % write_cache % matrix_arrays(1) % ij(1:2,1:record_count), &
                   this % write_cache % matrix_arrays(1) % coefficient(1:record_count))
        call this % write_cache % clear
 
    end subroutine write_cache_to_unit
 
 
    logical function insert_into_write_cache (this, row, column, coefficient)
        class(writermatrix)  :: this
        integer,  intent(in) :: row, column
        real(wp), intent(in) :: coefficient
        integer              :: record_count
 
        if (grid % grank /= master) then
            insert_into_write_cache = .false.
            return
        end if
 
        if (row == column) then
            if (row > size(this % diagonal)) then
                write (stdout, "('Row greater than size of diagonal!!!!',2i12)") row, size(this % diagonal)
                stop "Error"
            end if
            this % diagonal(row) = coefficient
        end if
 
        insert_into_write_cache = .true.
        if (abs(coefficient) < this % threshold) return
 
        call this % write_cache % insert_into_cache(row, column, coefficient)
        record_count = this % write_cache % get_size()
 
        !Update number of elements
        this % n = this % n + 1
        insert_into_write_cache = .true.
 
        if (record_count == this % num_elements_per_record) then
            !Write it all out
            call this % write_cache_to_unit
        end if
 
    end function insert_into_write_cache
 
 
    subroutine finalize_matrix_writer (this)
        class(writermatrix) :: this
        integer  :: dummy_ij(2, this % num_elements_per_record), record_count = 0
        real(wp) :: dummy_coeff(this % num_elements_per_record)
 
        if (grid % grank /= master) return
 
        write (stdout, "('finishing unit')")
        call this % write_cache_to_unit
        record_count = 0
        call wrtem(this % matrix_unit, record_count, this % num_elements_per_record, dummy_ij, dummy_coeff)
        write (stdout, "('done')")
 
    end subroutine finalize_matrix_writer
 
 
    subroutine print_writer (this)
        class(writermatrix) :: this
 
        write (stdout, "('-------TEMP CACHE---------')")
        call this % temp_cache % print
        !write(stdout,"('-------HARD CACHE---------')")
        !call this%matrix_cache%print
 
    end subroutine print_writer
 
 
    subroutine clear_writer (this)
        class(writermatrix) :: this
 
        call this % write_cache % clear
 
    end subroutine clear_writer
 
 
    subroutine destroy_writer (this)
        class(writermatrix) :: this
 
        call this % clear
        call this % write_cache % destroy
 
    end subroutine destroy_writer
 
end module writermatrix_module