eig66_mem.F90 8.67 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,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
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
    LOGICAL,INTENT(IN),OPTIONAL::l_dos,l_mcd,l_orb
32
    CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
33
34
35
36
37
    INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
    !locals
    INTEGER:: length
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)
38

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

46
    ENDIF
47

48
    CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
49
50

    !d%eig_int
51
    ALLOCATE(d%eig_int(jspins*nkpts))
52
53
54

    !d%eig_eig
    length=jspins
55
    IF (l_noco) length=1
Daniel Wortmann's avatar
Daniel Wortmann committed
56
    ALLOCATE(d%eig_eig(neig,2,jspins*nkpts)) !additional dimension for w_iks
57
    !d%eig_vec
58
    if (l_real.and..not.l_soc) THEN
59
60
61
62
       ALLOCATE(d%eig_vecr(nmat*neig,length*nkpts))
    else
       ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts))
    endif
63
    length=length*nkpts
64
    IF (d%l_dos) THEN
65
66
67
       ALLOCATE(d%qal(0:3,ntype,neig,length))
       ALLOCATE(d%qvac(neig,2,length))
       ALLOCATE(d%qis(neig,length))
68
69
       ALLOCATE(d%qvlay(neig,max(layers,1),2,length))
       ALLOCATE(d%qstars(nstars,neig,max(layers,1),2,length))
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
       ALLOCATE(d%ksym(neig,length))
       ALLOCATE(d%jsym(neig,length))
       IF (l_mcd) ALLOCATE(d%mcd(3*ntype,ncored,neig,length))
       IF (l_orb) THEN
          ALLOCATE(d%qintsl(nsld,neig,length))
          ALLOCATE(d%qmtsl(nsld,neig,length))
          ALLOCATE(d%qmtp(neig,nat,length))
          ALLOCATE(d%orbcomp(neig,23,nat,length))
       ENDIF
    ENDIF
    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
86
      REAL    :: eig(neig),w_iks(neig),ello(d%nlo,d%ntype),el(d%lmax,d%ntype)
87
88
89
90
91
92
93
      TYPE(t_zmat):: zmat

      zmat%l_real=l_real
      zmat%nbasfcn=nmat
      zmat%nbands=neig
      ALLOCATE(zmat%z_r(nmat,neig),zmat%z_c(nmat,neig))
    
94
      tmp_id=eig66_data_newid(DA_mode)
95
      IF (d%l_dos) CPP_error("Can not read DOS-data")
96
      CALL open_eig_IO(tmp_id,nmat,neig,nkpts,jspins,d%lmax,d%nlo,d%ntype,nlotot,.FALSE.,.FALSE.,l_real,l_soc,.FALSE.,.FALSE.,filename)
97
98
      DO jspin=1,jspins
         DO nk=1,nkpts
99
100
            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)
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
         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
132
      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
133
      TYPE(t_mat)::zmat
134
      zmat%l_real=d%l_real
Daniel Wortmann's avatar
Daniel Wortmann committed
135
136
137
      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)))
138
139
      tmp_id=eig66_data_newid(DA_mode)
      IF (d%l_dos) CPP_error("Could not write DOS data")
140
      CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,d%lmax,d%nlo,d%ntype,d%nlotot,.FALSE.,.FALSE.,d%l_real,d%l_soc,.FALSE.,.FALSE.,filename)
141
142
      DO jspin=1,d%jspins
         DO nk=1,d%nkpts
Daniel Wortmann's avatar
Daniel Wortmann committed
143
144
145
            !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)
146
               !CALL write_eig_DA(tmp_id,nk,jspin,ii,ii,nv,i,bk3,wk,eig,w_iks,el,ello,evac,nlotot,zmat=zmat)
147
           ENDDO
148
149
150
151
152
153
      ENDDO
      CALL close_eig_DA(tmp_id)
      CALL eig66_remove_data(id)
    END SUBROUTINE priv_writetofile
  END SUBROUTINE close_eig

154
  SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
155
156
157
    IMPLICIT NONE
    INTEGER, INTENT(IN)            :: id,nk,jspin
    INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
158
    REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
159
    INTEGER, INTENT(IN),OPTIONAL   :: n_start,n_end
160
    TYPE(t_zMAT),OPTIONAL  :: zmat
161

162
    INTEGER::nrec, arrayStart
163
164
165
166
167
168
    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
169
       neig=d%eig_int(nrec)
170
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
171
  
172
173
174
    !data from d%eig_eig
    IF (PRESENT(eig)) THEN
       eig=0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
175
       eig=d%eig_eig(:SIZE(eig),1,nrec)
176
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
177
178
179
180
181
    IF (PRESENT(w_iks)) THEN
       w_iks=0.0
       w_iks=d%eig_eig(:SIZE(w_iks),2,nrec)
    ENDIF
    
182
183
    !data from d%eig_vec

184
185
186
187
188
    arrayStart = 1
    IF(PRESENT(n_start)) THEN
       arrayStart = (n_start-1)*zMat%nbasfcn+1
    END IF

189
190
191
    IF (PRESENT(zmat)) THEN
      
       IF (zmat%l_real) THEN
192
          IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
193
             IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
194
             zmat%z_r=REAL(RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%z_r)-1,nrec),SHAPE(zmat%z_r)))
195
          ELSE
196
             zmat%z_r=RESHAPE(d%eig_vecr(arrayStart:arrayStart+SIZE(zmat%z_r)-1,nrec),SHAPE(zmat%z_r))
197
          ENDIF
198
       ELSE !TYPE is (COMPLEX)
199
          IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby = "eig66_mem")
200
          zmat%z_c=RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%z_c)-1,nrec),SHAPE(zmat%z_c))
201
       END IF
202
203
204
205
    ENDIF
  END SUBROUTINE read_eig


206
  SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
207
208
    INTEGER, INTENT(IN)          :: id,nk,jspin
    INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
209
210
    INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
    REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
211
    TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
212
213
214
215
216
217
218
219
220
    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"
221
          d%eig_int(nrec)=neig_total
222
223
224
225
226
       ELSE
          STOP "BUG2 in eig_mem"
       ENDIF
    ENDIF

Daniel Wortmann's avatar
Daniel Wortmann committed
227
  
228
229
    !data from d%eig_eig
    IF (PRESENT(eig)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
230
231
232
233
       d%eig_eig(:SIZE(eig),1,nrec)=eig
    ENDIF
    IF (PRESENT(w_iks)) THEN
       d%eig_eig(:SIZE(w_iks),2,nrec)=w_iks
234
235
    ENDIF
    !data from d%eig_vec
236
237
    IF (PRESENT(zmat)) THEN
       IF (zmat%l_real) THEN
238
239
          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
240
             d%eig_vecc(:SIZE(zmat%data_r),nrec)=RESHAPE(CMPLX(zmat%data_r),(/SIZE(zmat%data_r)/)) !Type cast here
241
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
242
             d%eig_vecr(:SIZE(zmat%data_r),nrec)=RESHAPE(REAL(zmat%data_r),(/SIZE(zmat%data_r)/))
243
          ENDIF
244
       ELSE
245
          IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
Daniel Wortmann's avatar
Daniel Wortmann committed
246
          d%eig_vecc(:SIZE(zmat%data_c),nrec)=RESHAPE(zmat%data_c,(/SIZE(zmat%data_c)/))
247
       END IF
248
249
250
251
252
253
254
    ENDIF


  END SUBROUTINE write_eig


END MODULE m_eig66_mem