diag_test.F90 2.28 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11
!--------------------------------------------------------------------------------
! Copyright (c) 2019 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
PROGRAM diag_test
  USE m_judft
  USE m_types_mat
  USE m_types_mpimat
  USE m_eigen_diag
  USE m_io_matrix
12
  USE m_hdf_tools
13 14 15 16 17 18 19 20 21 22 23
  IMPLICIT NONE

  INTEGER            :: matsize,ne,mode,fid
  INTEGER            :: err,isize
  CHARACTER(len=50)  :: filename
  CLASS(t_mat),ALLOCATABLE :: hmat,smat,ev
  REAL,ALLOCATABLE   :: eig(:)
  LOGICAL            :: l_exist,l_real
  REAL               :: t1,t2
#ifdef CPP_MPI
  Include 'mpif.h'
24
  CALL MPI_INIT_THREAD(MPI_THREAD_FUNNELED,isize,err)
25 26 27 28
  CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,err)
  IF (isize>1) THEN
     ALLOCATE(t_mpimat::hmat)
     ALLOCATE(t_mpimat::smat)
29 30 31 32 33 34 35 36 37
     SELECT TYPE(hmat)
     TYPE is (t_mpimat)
        ALLOCATE(hmat%blacsdata)
        hmat%blacsdata%mpi_com=MPI_COMM_WORLD
        SELECT TYPE(smat)
        TYPE is (t_mpimat)
           smat%blacsdata=>hmat%blacsdata
        END SELECT
     END SELECT
38 39 40 41 42 43 44 45 46 47
  END IF
#endif
  IF (.NOT.ALLOCATED(hmat)) THEN
     ALLOCATE(t_mat::hmat)
     ALLOCATE(t_mat::smat)
  ENDIF


  ! get filename
  filename=judft_string_for_argument("-file")
48
  INQUIRE(file=trim(filename)//".hdf",exist=l_exist)
49
  IF (.NOT.l_exist) CALL judft_error("File specified does not exist")
50
  call hdf_init()  
51

52 53
  !l_real,matsize is actually only needed if file is created
  fid=open_matrix(l_real,matsize,2,2,trim(filename))
54 55 56 57 58

  CALL read_matrix(hmat,1,fid)
  CALL read_matrix(smat,2,fid)
  SELECT TYPE(hmat)
  TYPE is (t_mpimat)
59 60 61 62
     SELECT TYPE(smat)
     TYPE is (t_mpimat)
        smat%blacsdata=>hmat%blacsdata!make sure we use same blacs-grids
     END SELECT
63 64 65 66 67 68 69 70
     ne=0.15*hmat%global_size1
     ALLOCATE(eig(hmat%global_size1))
  CLASS default
     ne=0.15*hmat%matsize1
     ALLOCATE(eig(hmat%matsize1))
  END SELECT
  
  CALL cpu_TIME(t1)
71
  mode=0
72 73 74 75 76
  CALL eigen_diag(mode,hmat,smat,ne,eig,ev)
  CALL cpu_TIME(t2)
  PRINT *,"No of eigenvalues:",ne
  PRINT *,eig(:ne)

77
  PRINT *,"Time used:",t2-t1
78 79 80 81 82 83

  CALL close_matrix(fid)

END PROGRAM diag_test