eig66_mem.F90 7.75 KB
Newer Older
1
MODULE m_eig66_mem
2
#include "juDFT_env.h"
3 4
  ! Do the IO of the eig-file into memory
  ! The eig-file is split into four arrays:
5
  ! eig_int contains the basis-set information/integers (ne)
6 7 8 9
  ! eig_eig contains the eigenvalues
  ! eig_vec contains the eigenvectors
  ! The record number is given by nrec=nk+(jspin-1)*nkpts
  USE m_eig66_data
10
  USE m_types
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
  IMPLICIT NONE
CONTAINS

  SUBROUTINE priv_find_data(id,d)
    INTEGER,INTENT(IN)::id
    TYPE(t_data_mem),POINTER,INTENT(out):: d

    CLASS(t_data),POINTER   ::dp
    CALL eig66_find_data(dp,id)
    SELECT TYPE(dp)
    TYPE is (t_data_mem)
       d=>dp
       CLASS default
       CALL judft_error("BUG: wrong datatype in eig66_mem")
    END SELECT
  END SUBROUTINE priv_find_data

28
  SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,lmax,nlo,ntype,l_create,l_real,l_soc,nlotot,l_noco,filename)
29
    INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
30
    LOGICAL, INTENT(IN) :: l_noco,l_create,l_real,l_soc
31
    CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
32 33 34 35
    !locals
    INTEGER:: length
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)
36

37 38 39 40 41 42
    IF (ALLOCATED(d%eig_int)) THEN
       IF (.NOT.l_create) THEN
          IF (PRESENT(filename)) CALL priv_readfromfile()
          RETURN
       ENDIF
       CALL close_eig(id,.TRUE.)
43

44
    ENDIF
45

46
    CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc)
47 48

    !d%eig_int
49
    ALLOCATE(d%eig_int(jspins*nkpts))
50 51 52

    !d%eig_eig
    length=jspins
53
    IF (l_noco) length=1
Daniel Wortmann's avatar
Daniel Wortmann committed
54
    ALLOCATE(d%eig_eig(neig,2,jspins*nkpts)) !additional dimension for w_iks
55
    !d%eig_vec
56
    if (l_real.and..not.l_soc) THEN
57 58 59 60
       ALLOCATE(d%eig_vecr(nmat*neig,length*nkpts))
    else
       ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts))
    endif
61 62 63 64 65 66 67
    length=length*nkpts
    IF (PRESENT(filename)) CALL priv_readfromfile()
  CONTAINS
    SUBROUTINE priv_readfromfile()
      USE m_eig66_da,ONLY:open_eig_IO=>open_eig,read_eig_IO=>read_eig,close_eig_IO=>close_eig
      INTEGER:: jspin,nk,i,ii,iii,nv,tmp_id
      REAL   :: wk,bk3(3),evac(2)
Daniel Wortmann's avatar
Daniel Wortmann committed
68
      REAL    :: eig(neig),w_iks(neig),ello(d%nlo,d%ntype),el(d%lmax,d%ntype)
69
      TYPE(t_mat):: zmat
70 71

      zmat%l_real=l_real
72 73 74
      zmat%matsize1=nmat
      zmat%matsize2=neig
      ALLOCATE(zmat%data_r(nmat,neig),zmat%data_c(nmat,neig))
75
    
76
      tmp_id=eig66_data_newid(DA_mode)
77
      CALL open_eig_IO(tmp_id,nmat,neig,nkpts,jspins,d%lmax,d%nlo,d%ntype,nlotot,.FALSE.,l_real,l_soc,filename)
78 79
      DO jspin=1,jspins
         DO nk=1,nkpts
80 81
            CALL read_eig_IO(tmp_id,nk,jspin,i,eig,w_iks,zmat=zmat)
            !CALL write_eig(id,nk,jspin,i,i,eig,w_iks,zmat=zmat)
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 109 110 111 112
         ENDDO
      ENDDO
      CALL close_eig_IO(tmp_id)
    END SUBROUTINE priv_readfromfile

  END SUBROUTINE open_eig

  SUBROUTINE close_eig(id,delete,filename)
    INTEGER,INTENT(in)         :: id
    LOGICAL,INTENT(in),OPTIONAL::delete
    CHARACTER(len=*),OPTIONAL,INTENT(in)::filename
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)

    IF (PRESENT(filename)) CALL priv_writetofile()

    IF (PRESENT(delete)) THEN
       IF (delete) THEN
          IF (ALLOCATED(d%eig_int)) DEALLOCATE(d%eig_int)
          IF (ALLOCATED(d%eig_eig)) DEALLOCATE(d%eig_eig)
          IF (ALLOCATED(d%eig_vecr)) DEALLOCATE(d%eig_vecr)
          IF (ALLOCATED(d%eig_vecc)) DEALLOCATE(d%eig_vecc)
       ENDIF
    ENDIF
  CONTAINS
    SUBROUTINE priv_writetofile()
      USE m_eig66_DA,ONLY:open_eig_DA=>open_eig,write_eig_DA=>write_eig,close_eig_DA=>close_eig
      IMPLICIT NONE

      INTEGER:: nlotot,nk,jspin,nv,i,ii,tmp_id
      REAL   :: wk,bk3(3),evac(2)
Daniel Wortmann's avatar
Daniel Wortmann committed
113
      REAL    :: eig(SIZE(d%eig_eig,1)),w_iks(SIZE(d%eig_eig,1)),ello(d%nlo,d%ntype),el(d%lmax,d%ntype)
Daniel Wortmann's avatar
Daniel Wortmann committed
114
      TYPE(t_mat)::zmat
115
      zmat%l_real=d%l_real
Daniel Wortmann's avatar
Daniel Wortmann committed
116 117 118
      zmat%matsize1=d%nmat
      zmat%matsize2=SIZE(d%eig_eig,1)
      ALLOCATE(zmat%data_r(d%nmat,SIZE(d%eig_eig,1)),zmat%data_c(d%nmat,SIZE(d%eig_eig,1)))
119
      tmp_id=eig66_data_newid(DA_mode)
120
      CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,d%lmax,d%nlo,d%ntype,d%nlotot,.FALSE.,d%l_real,d%l_soc,filename)
121 122
      DO jspin=1,d%jspins
         DO nk=1,d%nkpts
Daniel Wortmann's avatar
Daniel Wortmann committed
123 124 125
            !TODO this code is no longer working
            STOP "BUG"
               !CALL read_eig(id,nk,jspin,nv,i,bk3,wk,ii,eig,w_iks,el,ello,evac,zmat=zmat)
126
               !CALL write_eig_DA(tmp_id,nk,jspin,ii,ii,nv,i,bk3,wk,eig,w_iks,el,ello,evac,nlotot,zmat=zmat)
127
           ENDDO
128 129 130 131 132 133
      ENDDO
      CALL close_eig_DA(tmp_id)
      CALL eig66_remove_data(id)
    END SUBROUTINE priv_writetofile
  END SUBROUTINE close_eig

134
  SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
135 136 137
    IMPLICIT NONE
    INTEGER, INTENT(IN)            :: id,nk,jspin
    INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
138
    REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
139
    INTEGER, INTENT(IN),OPTIONAL   :: n_start,n_end
140
    TYPE(t_mat),OPTIONAL  :: zmat
141

142
    INTEGER::nrec, arrayStart
143 144 145 146 147 148
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)

    nrec=nk+(jspin-1)*d%nkpts
    ! data from d%eig_int
    IF (PRESENT(neig)) THEN
149
       neig=d%eig_int(nrec)
150
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
151
  
152 153 154
    !data from d%eig_eig
    IF (PRESENT(eig)) THEN
       eig=0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
155
       eig=d%eig_eig(:SIZE(eig),1,nrec)
156
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
157 158 159 160 161
    IF (PRESENT(w_iks)) THEN
       w_iks=0.0
       w_iks=d%eig_eig(:SIZE(w_iks),2,nrec)
    ENDIF
    
162 163
    !data from d%eig_vec

164 165
    arrayStart = 1
    IF(PRESENT(n_start)) THEN
166
       arrayStart = (n_start-1)*zMat%matsize1+1
167 168
    END IF

169 170 171
    IF (PRESENT(zmat)) THEN
      
       IF (zmat%l_real) THEN
172
          IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
173
             IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
174
             zmat%data_r=REAL(RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%data_r)-1,nrec),SHAPE(zmat%data_r)))
175
          ELSE
176
             zmat%data_r=RESHAPE(d%eig_vecr(arrayStart:arrayStart+SIZE(zmat%data_r)-1,nrec),SHAPE(zmat%data_r))
177
          ENDIF
178
       ELSE !TYPE is (COMPLEX)
179
          IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby = "eig66_mem")
180
          zmat%data_c=RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%data_c)-1,nrec),SHAPE(zmat%data_c))
181
       END IF
182 183 184 185
    ENDIF
  END SUBROUTINE read_eig


186
  SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
187 188
    INTEGER, INTENT(IN)          :: id,nk,jspin
    INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
189 190
    INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
    REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
191
    TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
192 193 194 195 196 197 198 199 200
    INTEGER::nrec
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)

    nrec=nk+(jspin-1)*d%nkpts
    ! data from d%eig_int
    IF (PRESENT(neig)) THEN
       IF (PRESENT(neig_total)) THEN
          IF (neig.NE.neig_total) STOP "BUG in eig_mem"
201
          d%eig_int(nrec)=neig_total
202 203 204 205 206
       ELSE
          STOP "BUG2 in eig_mem"
       ENDIF
    ENDIF

Daniel Wortmann's avatar
Daniel Wortmann committed
207
  
208 209
    !data from d%eig_eig
    IF (PRESENT(eig)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
210 211 212 213
       d%eig_eig(:SIZE(eig),1,nrec)=eig
    ENDIF
    IF (PRESENT(w_iks)) THEN
       d%eig_eig(:SIZE(w_iks),2,nrec)=w_iks
214 215
    ENDIF
    !data from d%eig_vec
216 217
    IF (PRESENT(zmat)) THEN
       IF (zmat%l_real) THEN
218 219
          IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
             IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
Daniel Wortmann's avatar
Daniel Wortmann committed
220
             d%eig_vecc(:SIZE(zmat%data_r),nrec)=RESHAPE(CMPLX(zmat%data_r),(/SIZE(zmat%data_r)/)) !Type cast here
221
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
222
             d%eig_vecr(:SIZE(zmat%data_r),nrec)=RESHAPE(REAL(zmat%data_r),(/SIZE(zmat%data_r)/))
223
          ENDIF
224
       ELSE
225
          IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
Daniel Wortmann's avatar
Daniel Wortmann committed
226
          d%eig_vecc(:SIZE(zmat%data_c),nrec)=RESHAPE(zmat%data_c,(/SIZE(zmat%data_c)/))
227
       END IF
228 229 230 231 232 233 234
    ENDIF


  END SUBROUTINE write_eig


END MODULE m_eig66_mem