eig66_data.F90 5.61 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 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.
!--------------------------------------------------------------------------------

7 8 9
module m_eig66_data
#include "juDFT_env.h"
#ifdef CPP_HDF
Matthias Redies's avatar
Matthias Redies committed
10
   use hdf5
11
#endif
Matthias Redies's avatar
Matthias Redies committed
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
   implicit none

   TYPE :: t_data
      INTEGER:: io_mode
      INTEGER:: jspins, nkpts, nmat, neig, nlo, ntype
      LOGICAL:: l_real, l_soc
   END TYPE

   TYPE, EXTENDS(t_data):: t_data_DA
      INTEGER            :: recl_vec = 0, recl_wiks
      CHARACTER(LEN=20)  :: fname = "eig"
      INTEGER            :: file_io_id_vec, file_io_id_wiks
   END TYPE

   TYPE, extends(t_data):: t_data_MPI
      INTEGER             :: n_size = 1
      INTEGER             :: size_k, size_eig
      INTEGER             :: eig_handle, zr_handle, zc_handle, neig_handle, w_iks_handle
      INTEGER, ALLOCATABLE :: pe_basis(:, :), slot_basis(:, :)
      INTEGER, ALLOCATABLE :: pe_ev(:, :, :), slot_ev(:, :, :)
      INTEGER             :: irank
      INTEGER, POINTER :: neig_data(:)
      REAL, POINTER    :: eig_data(:), zr_data(:), w_iks_data(:)
      COMPLEX, POINTER :: zc_data(:)
   END TYPE
   TYPE, EXTENDS(t_data):: t_data_hdf
38
#ifdef CPP_HDF
Matthias Redies's avatar
Matthias Redies committed
39 40 41 42
      INTEGER(HID_T) :: fid
      INTEGER(HID_T) :: neigsetid
      INTEGER(HID_T) :: energysetid, wikssetid, evsetid
      CHARACTER(LEN=20) :: fname = "eig"
43
#endif
Matthias Redies's avatar
Matthias Redies committed
44 45 46 47 48 49 50
   END TYPE

   TYPE, EXTENDS(t_data):: t_data_mem
      INTEGER, ALLOCATABLE :: eig_int(:)
      REAL, ALLOCATABLE    :: eig_eig(:, :, :)
      REAL, ALLOCATABLE    :: eig_vecr(:, :)
      COMPLEX, ALLOCATABLE :: eig_vecc(:, :)
Matthias Redies's avatar
Matthias Redies committed
51 52
      REAL, ALLOCATABLE    :: olap_r(:, :)
      COMPLEX, ALLOCATABLE :: olap_c(:, :)
Matthias Redies's avatar
Matthias Redies committed
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
   END TYPE

   TYPE t_list
      INTEGER               :: id
      CLASS(t_data), POINTER :: data
      TYPE(t_list), POINTER  :: next => null()
   END TYPE

   TYPE(t_list), POINTER :: linked_list => null()
   private linked_list
   INTEGER, PARAMETER :: DA_mode = 0, HDF_mode = 1, MEM_mode = 2, MPI_mode = 3

contains

   subroutine eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real, l_soc)
      CLASS(t_data)::d
      INTEGER, INTENT(IN)::jspins, nkpts, nmat, neig
      LOGICAL, INTENT(IN):: l_real, l_soc
      d%jspins = jspins
      d%nkpts = nkpts
      d%nmat = nmat
      d%neig = neig
      d%l_real = l_real
      d%l_soc = l_soc
   END SUBROUTINE

   subroutine eig66_find_data(d, id, io_mode)
      IMPLICIT NONE
      INTEGER, INTENT(IN) ::id
      INTEGER, INTENT(IN), OPTIONAL :: io_mode
      CLASS(t_data), pointer::d

      TYPE(t_list), POINTER, ASYNCHRONOUS:: listpointer, lastinlist
      lastinlist => null()

      listpointer => linked_list
      DO WHILE (associated(listpointer))
         lastinlist => listpointer
         if (listpointer%id == id) THEN
            d => listpointer%data
            return
         endif
         listpointer => listpointer%next
      enddo
      !no pointer found
      IF (present(io_mode)) THEN
         IF (.not. associated(lastinlist)) THEN
            allocate (linked_list)
            linked_list%id = id
            lastinlist => linked_list
         ELSE
            allocate (lastinlist%next)
            lastinlist%next%id = id
            lastinlist => lastinlist%next
         ENDIF
         SELECT CASE (io_mode)
109
         case (DA_MODE)
Matthias Redies's avatar
Matthias Redies committed
110
            allocate (t_data_DA::lastinlist%data)
111 112
         case (HDF_MODE)
#ifdef CPP_HDF
Matthias Redies's avatar
Matthias Redies committed
113
            allocate (t_data_HDF::lastinlist%data)
114
#else
Matthias Redies's avatar
Matthias Redies committed
115
            call juDFT_error("Cannot use hdf mode for IO, recompile with CPP_HDF", calledby="eig66_data")
116 117
#endif
         case (MEM_MODE)
Matthias Redies's avatar
Matthias Redies committed
118
            allocate (t_data_MEM::lastinlist%data)
119
         case (MPI_MODE)
Matthias Redies's avatar
Matthias Redies committed
120
            allocate (t_data_MPI::lastinlist%data)
121
         end select
Matthias Redies's avatar
Matthias Redies committed
122 123 124 125
         lastinlist%data%io_mode = io_mode
         d => lastinlist%data
      ELSE
         call juDFT_error("BUG:Could not find data object in eig66_mpi")
126
      ENDIF
Matthias Redies's avatar
Matthias Redies committed
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
   END SUBROUTINE

   subroutine eig66_remove_data(id)
      INTEGER, INTENT(IN)::id

      TYPE(t_list), POINTER:: listpointer, lastpointer
      lastpointer => null()
      listpointer => linked_list
      loop: DO WHILE (associated(listpointer))
         IF (listpointer%id == id) THEN
            exit loop
         ENDIF
         lastpointer => listpointer
         listpointer => listpointer%next
      ENDDO loop

      if (.not. associated(listpointer)) call juDFT_error("BUG in eig66_data: ID not found in deleting")
      IF (associated(lastpointer)) THEN
         lastpointer%next => listpointer%next
      ELSE
         linked_list => listpointer%next
      ENDIF

      deallocate (listpointer)
   end subroutine

   INTEGER FUNCTION eig66_data_newid(mode)
      INTEGER, INTENT(IN)  :: mode
      TYPE(t_list), POINTER:: listpointer
      INTEGER             :: id
      CLASS(t_data), POINTER::d

      id = 0
      listpointer => linked_list
      DO WHILE (associated(listpointer))
         id = max(id, listpointer%id)
         listpointer => listpointer%next
      ENDDO
      eig66_data_newid = id + 1

      call eig66_find_data(d, id + 1, mode)

   end function

   INTEGER function eig66_data_mode(id) RESULT(mode)
      INTEGER, INTENT(IN)  :: id
      TYPE(t_list), POINTER:: listpointer

      mode = -1
      listpointer => linked_list

      DO WHILE (associated(listpointer))
         if (id == listpointer%id) THEN
            mode = listpointer%data%io_mode
            return
         ENDIF
         listpointer => listpointer%next
      ENDDO
   END FUNCTION
186 187

end module m_eig66_data