eig66_da.F90 7.82 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
MODULE m_eig66_da
#include "juDFT_env.h"
9 10 11 12 13 14
  ! Do the IO of the eig-file in fortran direct-access
  ! The eig-file is split into two parts:
  ! eig.bas contains the basis-set information
  ! eig.vec contains the eigenvalues and the eigenvectors
  ! The record number is given by nrec=nk+(jspin-1)*nkpts
  ! each record contains:
15
  ! eig.bas: el,evac,ello,bkpt,wtkpt,nv,nmat
16 17 18
  ! eig.vec: ne,eig,z**
  !**: real or complex depending on calculation type
  USE m_eig66_data
19
  USE m_types
20
  IMPLICIT NONE
21 22

CONTAINS
23 24 25 26 27 28 29 30 31 32 33 34 35 36
  SUBROUTINE priv_find_data(id,d)
    INTEGER,INTENT(IN)            :: id
    TYPE(t_data_DA),POINTER,INTENT(out)   :: d

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

37 38
  SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,create,l_real,l_soc,filename)
    INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins
39
    LOGICAL, INTENT(IN) :: create,l_real,l_soc
40 41 42
    CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
    !locals
    LOGICAL :: l_file
43
    INTEGER :: i1,recl_z,recl_eig
44 45 46 47 48 49 50
    REAL    :: r1,r3(3)
    COMPLEX :: c1
    TYPE(t_data_DA),POINTER:: d

    CALL priv_find_data(id,d)

    IF (PRESENT(filename)) d%fname=filename
51
    CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
52 53

    !Calculate the record length
Daniel Wortmann's avatar
Daniel Wortmann committed
54

55
    INQUIRE(IOLENGTH=recl_eig) r1
Daniel Wortmann's avatar
Daniel Wortmann committed
56 57
    d%recl_wiks=recl_eig*neig
    
58
    recl_eig=recl_eig*(neig+2) ! add a 2 for integer 'neig'
59 60 61 62 63
    if (l_real.and..not.l_soc ) THEN
       INQUIRE(IOLENGTH=recl_z) r1
    else
       INQUIRE(IOLENGTH=recl_z) c1
    endif
64
    recl_z=recl_z*nmat*neig
Daniel Wortmann's avatar
Daniel Wortmann committed
65
    
66 67 68
    d%recl_vec=recl_eig+recl_z

    IF (create) THEN
69
       INQUIRE(file=TRIM(d%fname),opened=l_file)
70
       DO WHILE(l_file)
Daniel Wortmann's avatar
Daniel Wortmann committed
71
          write(*,*) "eig66_open_da:",d%fname," in use"
72
          d%fname=TRIM(d%fname)//"6"
73
          INQUIRE(file=TRIM(d%fname),opened=l_file)
74 75
       ENDDO
       d%file_io_id_vec=priv_free_uid()
76
       OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='unknown')
Daniel Wortmann's avatar
Daniel Wortmann committed
77 78
       d%file_io_id_wiks=priv_free_uid()
       OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='unknown')
79 80
    ELSE
       d%file_io_id_vec=priv_free_uid()
81
       OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='old')
Daniel Wortmann's avatar
Daniel Wortmann committed
82 83
       d%file_io_id_wiks=priv_free_uid()
       OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='old')
84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
    ENDIF
  CONTAINS
    INTEGER FUNCTION priv_free_uid() RESULT(uid)
      IMPLICIT NONE
      LOGICAL::used
      used=.TRUE.
      uid=665
      DO WHILE(used)
         uid=uid+1
         INQUIRE(UNIT=uid,OPENED=used)
      END DO
    END FUNCTION priv_free_uid
  END SUBROUTINE open_eig
  SUBROUTINE close_eig(id,filename)
    INTEGER,INTENT(IN)::id
    CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
    TYPE(t_data_DA),POINTER:: d

    CALL priv_find_data(id,d)

    CLOSE(d%file_io_id_vec)
Daniel Wortmann's avatar
Daniel Wortmann committed
105
    CLOSE(d%file_io_id_wiks)
106
    d%recl_vec=0
Daniel Wortmann's avatar
Daniel Wortmann committed
107
    d%recl_wiks=0
108 109 110 111

    !If a filename was given and the name is not the current filename then rename
    IF (PRESENT(filename)) THEN
       IF (filename.NE.d%fname) THEN
112
          CALL system("mv "//TRIM(d%fname)//" "//TRIM(filename))
113 114 115 116 117
       ENDIF
    ENDIF
    d%fname="eig"
    CALL eig66_remove_data(id)
  END SUBROUTINE close_eig
118
  SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
119 120 121
    IMPLICIT NONE
    INTEGER, INTENT(IN)            :: id,nk,jspin
    INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
122
    REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
123
    INTEGER, INTENT(IN),OPTIONAL   :: n_start,n_end
124
    TYPE(t_mat),OPTIONAL  :: zmat
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142

    !Local variables
    INTEGER:: nv_s,nmat_s,n,nrec,neig_s
    REAL   :: bkpt(3),wtkpt
    REAL,ALLOCATABLE::eig_s(:),zr_s(:,:)
    COMPLEX,ALLOCATABLE::zc_s(:,:)
    TYPE(t_data_DA),POINTER:: d



    CALL priv_find_data(id,d)
    ! check if io is performed correctly
    IF (PRESENT(n_start)) THEN
       IF (n_start/=1) &
            CALL juDFT_error("In direct access mode only all eigenstates can be read")
    ENDIF

    nrec=nk+(jspin-1)*d%nkpts
143
  
Daniel Wortmann's avatar
Daniel Wortmann committed
144 145 146 147
    IF (PRESENT(w_iks)) THEN
       print *, "R:w_iks:",nrec
        read(d%file_io_id_wiks,REC=nrec) w_iks
    ENDIF
148
  
Daniel Wortmann's avatar
Daniel Wortmann committed
149
    
150
    IF (.NOT.(PRESENT(eig).OR.PRESENT(neig).OR.PRESENT(zmat))) RETURN
151
    READ(d%file_io_id_vec,REC=nrec) neig_s
Daniel Wortmann's avatar
Daniel Wortmann committed
152 153 154
    IF (PRESENT(neig)) THEN
       neig=neig_s
    ENDIF
155
    IF (.NOT.(PRESENT(eig).OR.PRESENT(zmat))) RETURN
156
    ALLOCATE(eig_s(neig_s))
157 158
    IF (PRESENT(zmat)) THEN
       IF (zmat%l_real) THEN
159
          INQUIRE(IOLENGTH=n) neig_s,eig_s,REAL(zmat%data_r)
Daniel Wortmann's avatar
Daniel Wortmann committed
160 161 162
          IF (n>d%recl_vec) THEN
             CALL juDFT_error("BUG: Too long record")
          END IF
163
          READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%data_r
164
       ELSE
165
          INQUIRE(IOLENGTH=n) neig_s,eig_s,CMPLX(zmat%data_c)
Daniel Wortmann's avatar
Daniel Wortmann committed
166 167 168
          IF (n>d%recl_vec) THEN
             CALL juDFT_error("BUG: Too long record")
          END IF
169
          READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%data_c
170
       ENDIF
171 172 173 174 175
    ELSE
       INQUIRE(IOLENGTH=n) neig_s,eig_s
       IF (n>d%recl_vec) CALL juDFT_error("BUG: Too long record")
       READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s
    ENDIF
176
    IF (PRESENT(eig)) eig(:min(size(eig),neig_s))=eig_s(:min(size(eig),neig_s))
Daniel Wortmann's avatar
Daniel Wortmann committed
177
   
178 179
  END SUBROUTINE read_eig

180
  SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
181 182
    INTEGER, INTENT(IN)          :: id,nk,jspin
    INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
183 184
    INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
    REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
185
    TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209

    INTEGER:: nrec,r_len
    INTEGER:: nv_s,nmat_s
    REAL   :: bkpt(3),wtkpt
    TYPE(t_data_DA),POINTER:: d

    CALL priv_find_data(id,d)
    !This mode requires all data to be written at once!!

    IF (PRESENT(n_size).AND.PRESENT(n_rank)) THEN
       IF (n_size/=1.OR.n_rank/=0) &
            CALL juDFT_error("Direct Access IO not possible in eigenvalue parallel code")
    ENDIF
    !check record length
    !INQUIRE(iolength=r_len) nmat,el,evac,ello,bk,wk,nv,d%kvec_s,kveclo
    !if (r_len>recl_bas) call juDFT_error("BUG: too long record")

    !Now it is time for the IO :-)
    nrec=nk+(jspin-1)*d%nkpts
    IF (PRESENT(neig).AND.PRESENT(neig_total)) THEN
       IF (neig.NE.neig_total) THEN
          CALL juDFT_error("Neig and neig_total have to be equal in DA mode",calledby="eig66_da")
       ENDIF
    ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
210 211 212 213 214
    IF (PRESENT(w_iks)) THEN
       write(d%file_io_id_wiks,REC=nrec) w_iks
    ENDIF
 

215 216
    IF (.NOT.PRESENT(eig).OR..NOT.PRESENT(neig)) RETURN
    !Now the IO of the eigenvalues/vectors
217 218
    IF (PRESENT(zmat)) THEN
       IF (zmat%l_real) THEN
219
          INQUIRE(IOLENGTH=r_len) neig,eig,REAL(zmat%data_r)
220
          IF (r_len>d%recl_vec) CALL juDFT_error("BUG: too long record")
221
          WRITE(d%file_io_id_vec,REC=nrec) neig,eig,REAL(zmat%data_r)
222
       ELSE
223
          INQUIRE(IOLENGTH=r_len) neig,eig(:neig),CMPLX(zmat%data_c)
224
          IF (r_len>d%recl_vec) CALL juDFT_error("BUG: too long record")
225
          WRITE(d%file_io_id_vec,REC=nrec) neig,eig(:neig),CMPLX(zmat%data_c)
226
       ENDIF
227 228 229 230 231 232 233 234
    ELSE
       INQUIRE(IOLENGTH=r_len) neig,eig
       IF (r_len>d%recl_vec) CALL juDFT_error("BUG: too long record")
       WRITE(d%file_io_id_vec,REC=nrec) neig,eig
    ENDIF

  END SUBROUTINE write_eig

235
END MODULE m_eig66_da