prg_nonortho_mod.F90

Go to the documentation of this file.

 
!
module prg_nonortho_mod
 
  use bml
  use prg_parallel_mod
 
  implicit none
 
  private
 
  integer, parameter :: dp = kind(1.0d0)
 
  public :: prg_orthogonalize, prg_deorthogonalize
 
contains
 
  subroutine prg_orthogonalize(A_bml,zmat_bml,orthoA_bml,threshold,bml_type,verbose)
    implicit none
    integer :: hdim, mdim
    integer, intent(in) :: verbose
    real(dp), intent(in) :: threshold
    type(bml_matrix_t), intent(inout) :: a_bml
    type(bml_matrix_t), intent(inout) :: zmat_bml
    type(bml_matrix_t) :: aux_bml
    type(bml_matrix_t), intent(inout) :: orthoa_bml
    character(len=*), intent(in) :: bml_type
 
    if(verbose.eq.1) write(*,*)"In prg_orthogonalize ..."
 
    hdim= bml_get_n(a_bml)
    mdim= bml_get_m(a_bml)
 
    !Allocate bml's
    if(bml_get_n(orthoa_bml) .le. 0)then
      call bml_zero_matrix(bml_type,bml_element_real,dp,hdim ,mdim,orthoa_bml, &
           bml_get_distribution_mode(a_bml))
    endif
 
    !Do the operations in bml
    call bml_transpose_new(zmat_bml, aux_bml)
 
    call bml_multiply(aux_bml, a_bml, orthoa_bml, 1.0_dp, 0.0_dp,threshold) !Z^t*A
 
    call bml_multiply(orthoa_bml, zmat_bml, aux_bml, 1.0_dp, 0.0_dp,threshold) !Z^t*A * Z
 
    call bml_copy_new(aux_bml, orthoa_bml)
 
    call bml_deallocate(aux_bml)
 
  end subroutine prg_orthogonalize
 
 
  subroutine prg_deorthogonalize(orthoA_bml,zmat_bml,a_bml,threshold,bml_type,verbose)
    use, intrinsic :: iso_c_binding
    implicit none
    integer :: hdim,verbose
    real(dp) :: threshold
    type(bml_matrix_t), intent(inout) :: a_bml
    type(bml_matrix_t), intent(in) :: zmat_bml
    type(bml_matrix_t) :: aux_bml
    type(bml_matrix_t), intent(in) :: orthoa_bml
    character(len=*) :: bml_type
 
    if(verbose.eq.1) write(*,*)"In prg_deorthogonalize ..."
 
    hdim = bml_get_n(orthoa_bml)
 
    !Allocate bml's
    if(bml_get_n(a_bml).le.0) then
      call bml_zero_matrix(bml_type,bml_element_real,dp,hdim,hdim,a_bml, &
           bml_get_distribution_mode(orthoa_bml))
    endif
 
    call bml_transpose_new(zmat_bml, aux_bml)
 
    call bml_multiply(orthoa_bml, aux_bml, a_bml, 1.0_dp, 0.0_dp, threshold) !orthoA*Z^t
 
    ! Required when running distributed
#ifdef DO_MPI
    if (getnranks() > 1 .and. &
         bml_get_distribution_mode(orthoa_bml) == bml_dmode_distributed) then
      call prg_allgatherparallel(a_bml)
    endif
#endif
 
    call bml_multiply(zmat_bml, a_bml, aux_bml, 1.0_dp, 0.0_dp, threshold) !Z*orthoA * Z^t
 
    !    call bml_copy(aux_bml, a_bml)
    !call bml_copy(aux_bml, a_bml)
    call bml_deallocate(a_bml)
    a_bml%ptr = aux_bml%ptr
    aux_bml%ptr = c_null_ptr
 
    call bml_deallocate(aux_bml)
 
  end subroutine prg_deorthogonalize
 
end module prg_nonortho_mod