Line data    Source code

       1             : MODULE m_eig66_mem
       2             : use m_juDFT
       3             :    ! Do the IO of the eig-file into memory
       4             :    ! The eig-file is split into four arrays:
       5             :    ! eig_int contains the basis-set information/integers (ne)
       6             :    ! eig_eig contains the eigenvalues
       7             :    ! eig_vec contains the eigenvectors
       8             :    ! The record number is given by nrec=nk+(jspin-1)*nkpts
       9             :    USE m_eig66_data
      10             :    USE m_types_mat
      11             :    USE m_juDFT
      12             :    IMPLICIT NONE
      13             : CONTAINS
      14             : 
      15           0 :    SUBROUTINE priv_find_data(id, d)
      16             :       INTEGER, INTENT(IN)::id
      17             :       TYPE(t_data_mem), POINTER, INTENT(out):: d
      18             : 
      19             :       CLASS(t_data), POINTER   ::dp
      20           0 :       CALL eig66_find_data(dp, id)
      21             :       SELECT TYPE (dp)
      22             :       TYPE is (t_data_mem)
      23           0 :          d => dp
      24             :       CLASS default
      25           0 :          CALL judft_error("BUG: wrong datatype in eig66_mem")
      26             :       END SELECT
      27           0 :    END SUBROUTINE priv_find_data
      28             : 
      29           0 :    SUBROUTINE open_eig(id, nmat, neig, nkpts, jspins, l_create, l_real, l_soc, l_noco, l_olap, filename)
      30             :       INTEGER, INTENT(IN) :: id, nmat, neig, nkpts, jspins
      31             :       LOGICAL, INTENT(IN) :: l_noco, l_create, l_real, l_soc, l_olap
      32             :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
      33             :       !locals
      34             :       INTEGER :: length, ierr
      35             :       INTEGER :: elementsize
      36             :       CHARACTER(LEN=80) errorString
      37             :       TYPE(t_data_mem), POINTER:: d
      38           0 :       CALL priv_find_data(id, d)
      39             : 
      40           0 :       IF (ALLOCATED(d%eig_int)) THEN
      41           0 :          IF (.NOT. l_create) THEN
      42           0 :             IF (PRESENT(filename)) CALL priv_readfromfile()
      43           0 :             RETURN
      44             :          ENDIF
      45           0 :          CALL close_eig(id, .TRUE.)
      46             : 
      47             :       ENDIF
      48             : 
      49           0 :       CALL eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real, l_soc)
      50             : 
      51             :       !d%eig_int
      52           0 :       ALLOCATE (d%eig_int(jspins*nkpts))
      53             : 
      54             :       !d%eig_eig
      55           0 :       length = jspins
      56           0 :       IF (l_noco) length = 1
      57           0 :       ALLOCATE (d%eig_eig(neig, jspins*nkpts))
      58             :       !d%eig_vec
      59           0 :       if (l_real .and. .not. l_soc) THEN
      60           0 :          ALLOCATE (d%eig_vecr(nmat*neig, length*nkpts), source=0.0, STAT=ierr)
      61           0 :          elementsize = 8
      62             :       else
      63           0 :          ALLOCATE (d%eig_vecc(nmat*neig, length*nkpts), source=CMPLX(0.0,0.0), STAT=ierr)
      64           0 :          elementsize = 16
      65             :       endif
      66           0 :       IF (ierr.NE.0) THEN
      67           0 :          WRITE(errorString,'(a,i0,a,i0,a,i0,a,i0,a,i0,a)') "Could not allocate eigenvector array of size ", &
      68           0 :                                                             elementsize, " x ", nmat, " x ", neig, " x ", length, " x ", nkpts, " bytes."
      69           0 :          CALL juDFT_error(TRIM(ADJUSTL(errorString)), calledby = 'eig66_mem')
      70             :       END IF
      71             : 
      72             :       !d%olap 
      73           0 :       if(l_olap) then
      74           0 :          if (l_real .and. .not. l_soc) THEN
      75           0 :             ALLOCATE (d%olap_r(nmat**2, length*nkpts))
      76             :          else
      77           0 :             ALLOCATE (d%olap_c(nmat**2, length*nkpts))
      78             :          endif
      79             :       endif
      80             :       length = length*nkpts
      81           0 :       IF (PRESENT(filename)) CALL priv_readfromfile()
      82             :    CONTAINS
      83           0 :       SUBROUTINE priv_readfromfile()
      84             :          USE m_eig66_da, ONLY: open_eig_IO => open_eig, read_eig_IO => read_eig, close_eig_IO => close_eig
      85             :          INTEGER:: jspin, nk, i, ii, iii, nv, tmp_id
      86             :          REAL   :: wk, bk3(3), evac(2)
      87           0 :          REAL    :: eig(neig)
      88             :          TYPE(t_mat):: zmat
      89             : 
      90           0 :          zmat%l_real = l_real
      91           0 :          zmat%matsize1 = nmat
      92           0 :          zmat%matsize2 = neig
      93           0 :          ALLOCATE (zmat%data_r(nmat, neig), zmat%data_c(nmat, neig))
      94             : 
      95           0 :          tmp_id = eig66_data_newid(DA_mode)
      96           0 :          CALL open_eig_IO(tmp_id, nmat, neig, nkpts, jspins, .FALSE., l_real, l_soc, .false., filename)
      97           0 :          DO jspin = 1, jspins
      98           0 :             DO nk = 1, nkpts
      99           0 :                CALL read_eig_IO(tmp_id, nk, jspin, i, eig, zmat=zmat)
     100             :                !CALL write_eig(id,nk,jspin,i,i,eig,zmat=zmat)
     101             :             ENDDO
     102             :          ENDDO
     103           0 :          CALL close_eig_IO(tmp_id)
     104           0 :       END SUBROUTINE priv_readfromfile
     105             : 
     106             :    END SUBROUTINE open_eig
     107             : 
     108           0 :    SUBROUTINE close_eig(id, delete, filename)
     109             :       INTEGER, INTENT(in)         :: id
     110             :       LOGICAL, INTENT(in), OPTIONAL::delete
     111             :       CHARACTER(len=*), OPTIONAL, INTENT(in)::filename
     112             :       TYPE(t_data_mem), POINTER:: d
     113           0 :       CALL priv_find_data(id, d)
     114             : 
     115           0 :       IF (PRESENT(filename)) CALL priv_writetofile()
     116             : 
     117           0 :       IF (PRESENT(delete)) THEN
     118           0 :          IF (delete) THEN
     119           0 :             IF (ALLOCATED(d%eig_int))  DEALLOCATE (d%eig_int)
     120           0 :             IF (ALLOCATED(d%eig_eig))  DEALLOCATE (d%eig_eig)
     121           0 :             IF (ALLOCATED(d%eig_vecr)) DEALLOCATE (d%eig_vecr)
     122           0 :             IF (ALLOCATED(d%eig_vecc)) DEALLOCATE (d%eig_vecc)
     123           0 :             if (allocated(d%olap_r))   deallocate (d%olap_r)
     124           0 :             if (allocated(d%olap_c))   deallocate (d%olap_c)
     125             :          ENDIF
     126             :       ENDIF
     127             :    CONTAINS
     128           0 :       SUBROUTINE priv_writetofile()
     129             :          USE m_eig66_DA, ONLY: open_eig_DA => open_eig, write_eig_DA => write_eig, close_eig_DA => close_eig
     130             :          IMPLICIT NONE
     131             : 
     132             :          INTEGER:: nk, jspin, nv, i, ii, tmp_id
     133             :          REAL   :: wk, bk3(3), evac(2)
     134             :          REAL    :: eig(SIZE(d%eig_eig, 1))
     135           0 :          TYPE(t_mat)::zmat
     136           0 :          zmat%l_real = d%l_real
     137           0 :          zmat%matsize1 = d%nmat
     138           0 :          zmat%matsize2 = SIZE(d%eig_eig, 1)
     139           0 :          ALLOCATE (zmat%data_r(d%nmat, SIZE(d%eig_eig, 1)), zmat%data_c(d%nmat, SIZE(d%eig_eig, 1)))
     140           0 :          tmp_id = eig66_data_newid(DA_mode)
     141           0 :          CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, .false., filename)
     142           0 :          DO jspin = 1, d%jspins
     143           0 :             DO nk = 1, d%nkpts
     144             :                !TODO this code is no longer working
     145           0 :                STOP "BUG"
     146             :                !CALL read_eig(id,nk,jspin,nv,i,bk3,wk,ii,eig,el,ello,evac,zmat=zmat)
     147             :                !CALL write_eig_DA(tmp_id,nk,jspin,ii,ii,nv,i,bk3,wk,eig,el,ello,evac,nlotot,zmat=zmat)
     148             :             ENDDO
     149             :          ENDDO
     150           0 :          CALL close_eig_DA(tmp_id)
     151           0 :          CALL eig66_remove_data(id)
     152           0 :       END SUBROUTINE priv_writetofile
     153             :    END SUBROUTINE close_eig
     154             : 
     155           0 :    SUBROUTINE read_eig(id, nk, jspin, neig, eig, list, zmat, smat)
     156             :       IMPLICIT NONE
     157             :       INTEGER, INTENT(IN)            :: id, nk, jspin
     158             :       INTEGER, INTENT(OUT), OPTIONAL  :: neig
     159             :       REAL, INTENT(OUT), OPTIONAL  :: eig(:)
     160             :       INTEGER, INTENT(IN), OPTIONAL   :: list(:)
     161             :       TYPE(t_mat), OPTIONAL  :: zmat, smat
     162             : 
     163             :       INTEGER::nrec, arrayStart, arrayStop, i
     164           0 :       INTEGER, ALLOCATABLE :: ind(:)
     165             :       TYPE(t_data_mem), POINTER:: d
     166           0 :       CALL priv_find_data(id, d)
     167             : 
     168           0 :       nrec = nk + (jspin - 1)*d%nkpts
     169             :       ! data from d%eig_int
     170           0 :       IF (PRESENT(neig)) THEN
     171           0 :          neig = d%eig_int(nrec)
     172             :       ENDIF
     173             : 
     174             :       !data from d%eig_eig
     175           0 :       IF (PRESENT(eig)) THEN
     176           0 :          eig = 0.0
     177           0 :          eig = d%eig_eig(:SIZE(eig), nrec)
     178             :       ENDIF
     179             : 
     180             :       !data from d%eig_vec
     181             : 
     182           0 :       IF (PRESENT(zmat)) THEN
     183           0 :          IF (PRESENT(list)) THEN
     184           0 :             ind = list
     185             :          ELSE
     186           0 :             ALLOCATE (ind(zmat%matsize2))
     187           0 :             ind = [(i, i=1, SIZE(ind))]
     188             :          END IF
     189           0 :          IF (zmat%l_real) THEN
     190           0 :             IF (.NOT. ALLOCATED(d%eig_vecr)) THEN
     191           0 :                IF (.NOT. ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
     192           0 :                DO i = 1, SIZE(ind)
     193           0 :                   arrayStart = (ind(i) - 1)*zMat%matsize1 + 1
     194           0 :                   arrayStop = ind(i)*zMat%matsize1
     195           0 :                   zmat%data_r(:, i) = REAL(d%eig_vecc(arrayStart:arrayStop, nrec))
     196             :                ENDDO
     197             :             ELSE
     198           0 :                DO i = 1, SIZE(ind)
     199           0 :                   arrayStart = (ind(i) - 1)*zMat%matsize1 + 1
     200           0 :                   arrayStop = ind(i)*zMat%matsize1
     201           0 :                   zmat%data_r(:, i) = d%eig_vecr(arrayStart:arrayStop, nrec)
     202             :                ENDDO
     203             :             ENDIF
     204             :          ELSE !TYPE is (COMPLEX)
     205           0 :             IF (.NOT. ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby="eig66_mem")
     206           0 :             DO i = 1, SIZE(ind)
     207           0 :                arrayStart = (ind(i) - 1)*zMat%matsize1 + 1
     208           0 :                arrayStop = ind(i)*zMat%matsize1
     209           0 :                zmat%data_c(:, i) = d%eig_vecc(arrayStart:arrayStop, nrec)
     210             :             END DO
     211             :          END IF
     212             :       ENDIF
     213             : 
     214             :       !data from d%eig_vec
     215             : 
     216           0 :       IF (PRESENT(smat)) THEN
     217           0 :          IF (PRESENT(list)) THEN
     218           0 :             ind = list
     219             :          ELSE
     220           0 :             ALLOCATE (ind(smat%matsize2))
     221           0 :             ind = [(i, i=1, SIZE(ind))]
     222             :          END IF
     223           0 :          IF (smat%l_real) THEN
     224           0 :             IF (.NOT. ALLOCATED(d%olap_r)) THEN
     225           0 :                IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
     226           0 :                DO i = 1, SIZE(ind)
     227           0 :                   arrayStart = (ind(i) - 1)*smat%matsize1 + 1
     228           0 :                   arrayStop = ind(i)*smat%matsize1
     229           0 :                   smat%data_r(:, i) = REAL(d%olap_c(arrayStart:arrayStop, nrec))
     230             :                ENDDO
     231             :             ELSE
     232           0 :                DO i = 1, SIZE(ind)
     233           0 :                   arrayStart = (ind(i) - 1)*smat%matsize1 + 1
     234           0 :                   arrayStop = ind(i)*smat%matsize1
     235           0 :                   smat%data_r(:, i) = d%olap_r(arrayStart:arrayStop, nrec)
     236             :                ENDDO
     237             :             ENDIF
     238             :          ELSE !TYPE is (COMPLEX)
     239           0 :             IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby="eig66_mem")
     240           0 :             DO i = 1, SIZE(ind)
     241           0 :                arrayStart = (ind(i) - 1)*smat%matsize1 + 1
     242           0 :                arrayStop = ind(i)*smat%matsize1
     243           0 :                smat%data_c(:, i) = d%olap_c(arrayStart:arrayStop, nrec)
     244             :             END DO
     245             :          END IF
     246             :       ENDIF
     247           0 :    END SUBROUTINE read_eig
     248             : 
     249           0 :    SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, n_size, n_rank, zmat, smat)
     250             :       INTEGER, INTENT(IN)          :: id, nk, jspin
     251             :       INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
     252             :       INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
     253             :       REAL, INTENT(IN), OPTIONAL :: eig(:)
     254             :       TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
     255             :       INTEGER::nrec
     256             :       TYPE(t_data_mem), POINTER:: d
     257           0 :       CALL priv_find_data(id, d)
     258             : 
     259           0 :       nrec = nk + (jspin - 1)*d%nkpts
     260             :       ! data from d%eig_int
     261           0 :       IF (PRESENT(neig)) THEN
     262           0 :          IF (PRESENT(neig_total)) THEN
     263           0 :             IF (neig .NE. neig_total) STOP "BUG in eig_mem"
     264           0 :             d%eig_int(nrec) = neig_total
     265             :          ELSE
     266           0 :             STOP "BUG2 in eig_mem"
     267             :          ENDIF
     268             :       ENDIF
     269             : 
     270             :       !data from d%eig_eig
     271           0 :       IF (PRESENT(eig)) THEN
     272           0 :          d%eig_eig(:SIZE(eig), nrec) = eig
     273             :       ENDIF
     274             :       !data from d%eig_vec
     275           0 :       IF (PRESENT(zmat)) THEN
     276           0 :          IF (zmat%l_real) THEN
     277           0 :             IF (.NOT. ALLOCATED(d%eig_vecr)) THEN
     278           0 :                IF (.NOT. ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
     279           0 :                d%eig_vecc(:SIZE(zmat%data_r), nrec) = RESHAPE(CMPLX(zmat%data_r), [SIZE(zmat%data_r)]) !Type cast here
     280             :             ELSE
     281           0 :                d%eig_vecr(:SIZE(zmat%data_r), nrec) = RESHAPE(REAL(zmat%data_r), [SIZE(zmat%data_r)])
     282             :             ENDIF
     283             :          ELSE
     284           0 :             IF (.NOT. ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
     285           0 :             d%eig_vecc(:SIZE(zmat%data_c), nrec) = RESHAPE(zmat%data_c, [SIZE(zmat%data_c)])
     286             :          END IF
     287             :       ENDIF
     288             : 
     289           0 :       IF (PRESENT(smat)) THEN
     290           0 :          IF (smat%l_real) THEN
     291           0 :             IF (.NOT. ALLOCATED(d%olap_r)) THEN
     292           0 :                IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not write complex vectors to memory (olap)")
     293           0 :                d%olap_c(:SIZE(smat%data_r), nrec) = RESHAPE(CMPLX(smat%data_r), [SIZE(smat%data_r)]) !Type cast here
     294             :             ELSE
     295           0 :                d%olap_r(:SIZE(smat%data_r), nrec) = RESHAPE(REAL(smat%data_r), [SIZE(smat%data_r)])
     296             :             ENDIF
     297             :          ELSE
     298           0 :             IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not write complex vectors to memory (olap)")
     299           0 :             d%olap_c(:SIZE(smat%data_c), nrec) = RESHAPE(smat%data_c, [SIZE(smat%data_c)])
     300             :          END IF
     301             :       ENDIF
     302           0 :    END SUBROUTINE write_eig
     303           0 : END MODULE m_eig66_mem