eig66_mem.F90 10.7 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 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 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
      ENDDO
      CALL close_eig_DA(tmp_id)
      CALL eig66_remove_data(id)
    END SUBROUTINE priv_writetofile
  END SUBROUTINE close_eig

  SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
    IMPLICIT NONE
    INTEGER, INTENT(IN)          :: id,nk,jspin
    REAL,INTENT(IN)              :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
    COMPLEX,INTENT(IN)           :: qstars(:,:,:,:)
    INTEGER,INTENT(IN)           :: ksym(:),jsym(:)
    REAL,INTENT(IN),OPTIONAL     :: mcd(:,:,:)
    REAL,INTENT(IN),OPTIONAL     :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)

    INTEGER::nrec
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)

    nrec=nk+(jspin-1)*d%nkpts

    d%qal(:,:,:,nrec)=qal
    d%qvac(:,:,nrec)=qvac
    d%qis(:,nrec)=qis
    d%qvlay(:,:,:,nrec)=qvlay
    d%qstars(:,:,:,:,nrec)=qstars
    d%ksym(:,nrec)=ksym
    d%jsym(:,nrec)=jsym
    IF (d%l_mcd.AND.PRESENT(mcd)) d%mcd(:,:,:,nrec)=mcd
    IF (d%l_orb.AND.PRESENT(qintsl)) THEN
       d%qintsl(:,:,nrec)=qintsl
       d%qmtsl(:,:,nrec)=qmtsl
       d%qmtp(:,:,nrec)=qmtp
       d%orbcomp(:,:,:,nrec)=orbcomp
    ENDIF
  END SUBROUTINE write_dos

  SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
    IMPLICIT NONE
    INTEGER, INTENT(IN)          :: id,nk,jspin
    REAL,INTENT(OUT)              :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
    COMPLEX,INTENT(OUT)           :: qstars(:,:,:,:)
    INTEGER,INTENT(OUT)           :: ksym(:),jsym(:)
    REAL,INTENT(OUT),OPTIONAL     :: mcd(:,:,:)
    REAL,INTENT(OUT),OPTIONAL     :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)

    INTEGER::nrec
    TYPE(t_data_mem),POINTER:: d
    CALL priv_find_data(id,d)

    nrec=nk+(jspin-1)*d%nkpts

    qal=d%qal(:,:,:,nrec)
    qvac=d%qvac(:,:,nrec)
    qis=d%qis(:,nrec)
    qvlay=d%qvlay(:,:,:,nrec)
    qstars=d%qstars(:,:,:,:,nrec)
    ksym=d%ksym(:,nrec)
    jsym=d%jsym(:,nrec)
    IF (d%l_mcd.AND.PRESENT(mcd)) mcd=d%mcd(:,:,:,nrec)
    IF (d%l_orb.AND.PRESENT(qintsl)) THEN
       qintsl=d%qintsl(:,:,nrec)
       qmtsl=d%qmtsl(:,:,nrec)
       qmtp=d%qmtp(:,:,nrec)
       orbcomp=d%orbcomp(:,:,:,nrec)
    ENDIF
  END SUBROUTINE read_dos


217
  SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
218 219 220
    IMPLICIT NONE
    INTEGER, INTENT(IN)            :: id,nk,jspin
    INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
221
    REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
222
    INTEGER, INTENT(IN),OPTIONAL   :: n_start,n_end
223
    TYPE(t_zMAT),OPTIONAL  :: zmat
224

225
    INTEGER::nrec, arrayStart
226 227 228 229 230 231
    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
232
       neig=d%eig_int(nrec)
233
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
234
  
235 236 237
    !data from d%eig_eig
    IF (PRESENT(eig)) THEN
       eig=0.0
Daniel Wortmann's avatar
Daniel Wortmann committed
238
       eig=d%eig_eig(:SIZE(eig),1,nrec)
239
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
240 241 242 243 244
    IF (PRESENT(w_iks)) THEN
       w_iks=0.0
       w_iks=d%eig_eig(:SIZE(w_iks),2,nrec)
    ENDIF
    
245 246
    !data from d%eig_vec

247 248 249 250 251
    arrayStart = 1
    IF(PRESENT(n_start)) THEN
       arrayStart = (n_start-1)*zMat%nbasfcn+1
    END IF

252 253 254
    IF (PRESENT(zmat)) THEN
      
       IF (zmat%l_real) THEN
255
          IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
256
             IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
257
             zmat%z_r=REAL(RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%z_r),nrec),SHAPE(zmat%z_r)))
258
          ELSE
259
             zmat%z_r=RESHAPE(d%eig_vecr(arrayStart:arrayStart+SIZE(zmat%z_r),nrec),SHAPE(zmat%z_r))
260
          ENDIF
261
       ELSE !TYPE is (COMPLEX)
262
          IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby = "eig66_mem")
263
          zmat%z_c=RESHAPE(d%eig_vecc(arrayStart:arrayStart+SIZE(zmat%z_c),nrec),SHAPE(zmat%z_c))
264
       END IF
265 266 267 268
    ENDIF
  END SUBROUTINE read_eig


269
  SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
270 271
    INTEGER, INTENT(IN)          :: id,nk,jspin
    INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
272 273
    INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
    REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
274
    TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
275 276 277 278 279 280 281 282 283
    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"
284
          d%eig_int(nrec)=neig_total
285 286 287 288 289
       ELSE
          STOP "BUG2 in eig_mem"
       ENDIF
    ENDIF

Daniel Wortmann's avatar
Daniel Wortmann committed
290
  
291 292
    !data from d%eig_eig
    IF (PRESENT(eig)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
293 294 295 296
       d%eig_eig(:SIZE(eig),1,nrec)=eig
    ENDIF
    IF (PRESENT(w_iks)) THEN
       d%eig_eig(:SIZE(w_iks),2,nrec)=w_iks
297 298
    ENDIF
    !data from d%eig_vec
299 300
    IF (PRESENT(zmat)) THEN
       IF (zmat%l_real) THEN
301 302
          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
303
             d%eig_vecc(:SIZE(zmat%data_r),nrec)=RESHAPE(CMPLX(zmat%data_r),(/SIZE(zmat%data_r)/)) !Type cast here
304
          ELSE
Daniel Wortmann's avatar
Daniel Wortmann committed
305
             d%eig_vecr(:SIZE(zmat%data_r),nrec)=RESHAPE(REAL(zmat%data_r),(/SIZE(zmat%data_r)/))
306
          ENDIF
307
       ELSE
308
          IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
Daniel Wortmann's avatar
Daniel Wortmann committed
309
          d%eig_vecc(:SIZE(zmat%data_c),nrec)=RESHAPE(zmat%data_c,(/SIZE(zmat%data_c)/))
310
       END IF
311 312 313 314 315 316 317
    ENDIF


  END SUBROUTINE write_eig


END MODULE m_eig66_mem