LCOV - code coverage report
Current view: top level - io - eig66_mem.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 115 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 7 0.0 %

          Line data    Source code
       1             : MODULE m_eig66_mem
       2             : #include "juDFT_env.h"
       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
      11             :   IMPLICIT NONE
      12             : CONTAINS
      13             : 
      14           0 :   SUBROUTINE priv_find_data(id,d)
      15             :     INTEGER,INTENT(IN)::id
      16             :     TYPE(t_data_mem),POINTER,INTENT(out):: d
      17             : 
      18             :     CLASS(t_data),POINTER   ::dp
      19           0 :     CALL eig66_find_data(dp,id)
      20             :     SELECT TYPE(dp)
      21             :     TYPE is (t_data_mem)
      22           0 :        d=>dp
      23             :        CLASS default
      24           0 :        CALL judft_error("BUG: wrong datatype in eig66_mem")
      25             :     END SELECT
      26           0 :   END SUBROUTINE priv_find_data
      27             : 
      28           0 :   SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,l_create,l_real,l_soc,l_noco,filename)
      29             :     INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins
      30             :     LOGICAL, INTENT(IN) :: l_noco,l_create,l_real,l_soc
      31             :     CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
      32             :     !locals
      33             :     INTEGER:: length
      34             :     TYPE(t_data_mem),POINTER:: d
      35           0 :     CALL priv_find_data(id,d)
      36             : 
      37           0 :     IF (ALLOCATED(d%eig_int)) THEN
      38           0 :        IF (.NOT.l_create) THEN
      39           0 :           IF (PRESENT(filename)) CALL priv_readfromfile()
      40           0 :           RETURN
      41             :        ENDIF
      42           0 :        CALL close_eig(id,.TRUE.)
      43             : 
      44             :     ENDIF
      45             : 
      46           0 :     CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
      47             : 
      48             :     !d%eig_int
      49           0 :     ALLOCATE(d%eig_int(jspins*nkpts))
      50             : 
      51             :     !d%eig_eig
      52           0 :     length=jspins
      53           0 :     IF (l_noco) length=1
      54           0 :     ALLOCATE(d%eig_eig(neig,2,jspins*nkpts)) !additional dimension for w_iks
      55             :     !d%eig_vec
      56           0 :     if (l_real.and..not.l_soc) THEN
      57           0 :        ALLOCATE(d%eig_vecr(nmat*neig,length*nkpts))
      58             :     else
      59           0 :        ALLOCATE(d%eig_vecc(nmat*neig,length*nkpts))
      60             :     endif
      61           0 :     length=length*nkpts
      62           0 :     IF (PRESENT(filename)) CALL priv_readfromfile()
      63             :   CONTAINS
      64           0 :     SUBROUTINE priv_readfromfile()
      65             :       USE m_eig66_da,ONLY:open_eig_IO=>open_eig,read_eig_IO=>read_eig,close_eig_IO=>close_eig
      66             :       INTEGER:: jspin,nk,i,ii,iii,nv,tmp_id
      67             :       REAL   :: wk,bk3(3),evac(2)
      68           0 :       REAL    :: eig(neig),w_iks(neig)
      69           0 :       TYPE(t_mat):: zmat
      70             : 
      71           0 :       zmat%l_real=l_real
      72           0 :       zmat%matsize1=nmat
      73           0 :       zmat%matsize2=neig
      74           0 :       ALLOCATE(zmat%data_r(nmat,neig),zmat%data_c(nmat,neig))
      75             :     
      76           0 :       tmp_id=eig66_data_newid(DA_mode)
      77           0 :       CALL open_eig_IO(tmp_id,nmat,neig,nkpts,jspins,.FALSE.,l_real,l_soc,filename)
      78           0 :       DO jspin=1,jspins
      79           0 :          DO nk=1,nkpts
      80           0 :             CALL read_eig_IO(tmp_id,nk,jspin,i,eig,w_iks,zmat=zmat)
      81             :             !CALL write_eig(id,nk,jspin,i,i,eig,w_iks,zmat=zmat)
      82             :          ENDDO
      83             :       ENDDO
      84           0 :       CALL close_eig_IO(tmp_id)
      85           0 :     END SUBROUTINE priv_readfromfile
      86             : 
      87             :   END SUBROUTINE open_eig
      88             : 
      89           0 :   SUBROUTINE close_eig(id,delete,filename)
      90             :     INTEGER,INTENT(in)         :: id
      91             :     LOGICAL,INTENT(in),OPTIONAL::delete
      92             :     CHARACTER(len=*),OPTIONAL,INTENT(in)::filename
      93             :     TYPE(t_data_mem),POINTER:: d
      94           0 :     CALL priv_find_data(id,d)
      95             : 
      96           0 :     IF (PRESENT(filename)) CALL priv_writetofile()
      97             : 
      98           0 :     IF (PRESENT(delete)) THEN
      99           0 :        IF (delete) THEN
     100           0 :           IF (ALLOCATED(d%eig_int)) DEALLOCATE(d%eig_int)
     101           0 :           IF (ALLOCATED(d%eig_eig)) DEALLOCATE(d%eig_eig)
     102           0 :           IF (ALLOCATED(d%eig_vecr)) DEALLOCATE(d%eig_vecr)
     103           0 :           IF (ALLOCATED(d%eig_vecc)) DEALLOCATE(d%eig_vecc)
     104             :        ENDIF
     105             :     ENDIF
     106             :   CONTAINS
     107           0 :     SUBROUTINE priv_writetofile()
     108             :       USE m_eig66_DA,ONLY:open_eig_DA=>open_eig,write_eig_DA=>write_eig,close_eig_DA=>close_eig
     109             :       IMPLICIT NONE
     110             : 
     111             :       INTEGER:: nk,jspin,nv,i,ii,tmp_id
     112             :       REAL   :: wk,bk3(3),evac(2)
     113             :       REAL    :: eig(SIZE(d%eig_eig,1)),w_iks(SIZE(d%eig_eig,1))
     114           0 :       TYPE(t_mat)::zmat
     115           0 :       zmat%l_real=d%l_real
     116           0 :       zmat%matsize1=d%nmat
     117           0 :       zmat%matsize2=SIZE(d%eig_eig,1)
     118           0 :       ALLOCATE(zmat%data_r(d%nmat,SIZE(d%eig_eig,1)),zmat%data_c(d%nmat,SIZE(d%eig_eig,1)))
     119           0 :       tmp_id=eig66_data_newid(DA_mode)
     120           0 :       CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,.FALSE.,d%l_real,d%l_soc,filename)
     121           0 :       DO jspin=1,d%jspins
     122           0 :          DO nk=1,d%nkpts
     123             :             !TODO this code is no longer working
     124           0 :             STOP "BUG"
     125             :                !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             :       ENDDO
     129           0 :       CALL close_eig_DA(tmp_id)
     130           0 :       CALL eig66_remove_data(id)
     131           0 :     END SUBROUTINE priv_writetofile
     132             :   END SUBROUTINE close_eig
     133             : 
     134           0 :   SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,list,zmat)
     135             :     IMPLICIT NONE
     136             :     INTEGER, INTENT(IN)            :: id,nk,jspin
     137             :     INTEGER, INTENT(OUT),OPTIONAL  :: neig
     138             :     REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
     139             :     INTEGER, INTENT(IN),OPTIONAL   :: list(:)
     140             :     TYPE(t_mat),OPTIONAL  :: zmat
     141             : 
     142             :     INTEGER::nrec, arrayStart,arrayStop,i
     143           0 :     INTEGER,ALLOCATABLE :: ind(:)
     144             :     TYPE(t_data_mem),POINTER:: d
     145           0 :     CALL priv_find_data(id,d)
     146             : 
     147           0 :     nrec=nk+(jspin-1)*d%nkpts
     148             :     ! data from d%eig_int
     149           0 :     IF (PRESENT(neig)) THEN
     150           0 :        neig=d%eig_int(nrec)
     151             :     ENDIF
     152             :   
     153             :     !data from d%eig_eig
     154           0 :     IF (PRESENT(eig)) THEN
     155           0 :        eig=0.0
     156           0 :        eig=d%eig_eig(:SIZE(eig),1,nrec)
     157             :     ENDIF
     158           0 :     IF (PRESENT(w_iks)) THEN
     159           0 :        w_iks=0.0
     160           0 :        w_iks=d%eig_eig(:SIZE(w_iks),2,nrec)
     161             :     ENDIF
     162             :     
     163             :     !data from d%eig_vec
     164             : 
     165             :    
     166             : 
     167           0 :     IF (PRESENT(zmat)) THEN
     168           0 :        IF(PRESENT(list)) THEN
     169           0 :           ind=list
     170             :        ELSE
     171           0 :           ALLOCATE(ind(zmat%matsize2))
     172           0 :           ind=[(i,i=1,SIZE(ind))]
     173             :        END IF
     174           0 :        IF (zmat%l_real) THEN
     175           0 :           IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
     176           0 :              IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
     177           0 :              DO i=1,SIZE(ind)
     178           0 :                 arrayStart=(ind(i)-1)*zMat%matsize1+1
     179           0 :                 arrayStop=ind(i)*zMat%matsize1
     180           0 :                 zmat%data_r(:,i)=REAL(d%eig_vecc(arrayStart:arrayStop,nrec))
     181             :              ENDDO
     182             :           ELSE
     183           0 :              DO i=1,SIZE(ind)
     184           0 :                 arrayStart=(ind(i)-1)*zMat%matsize1+1
     185           0 :                 arrayStop=ind(i)*zMat%matsize1
     186           0 :                 zmat%data_r(:,i)=d%eig_vecr(arrayStart:arrayStop,nrec)
     187             :              ENDDO
     188             :           ENDIF
     189             :        ELSE !TYPE is (COMPLEX)
     190           0 :           IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby = "eig66_mem")
     191           0 :           DO i=1,SIZE(ind)
     192           0 :              arrayStart=(ind(i)-1)*zMat%matsize1+1
     193           0 :              arrayStop=ind(i)*zMat%matsize1
     194           0 :              zmat%data_c(:,i)=d%eig_vecc(arrayStart:arrayStop,nrec)
     195             :           END DO
     196             :        END IF
     197             :     ENDIF
     198           0 :   END SUBROUTINE read_eig
     199             : 
     200             : 
     201           0 :   SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
     202             :     INTEGER, INTENT(IN)          :: id,nk,jspin
     203             :     INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
     204             :     INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
     205             :     REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
     206             :     TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
     207             :     INTEGER::nrec
     208             :     TYPE(t_data_mem),POINTER:: d
     209           0 :     CALL priv_find_data(id,d)
     210             : 
     211           0 :     nrec=nk+(jspin-1)*d%nkpts
     212             :     ! data from d%eig_int
     213           0 :     IF (PRESENT(neig)) THEN
     214           0 :        IF (PRESENT(neig_total)) THEN
     215           0 :           IF (neig.NE.neig_total) STOP "BUG in eig_mem"
     216           0 :           d%eig_int(nrec)=neig_total
     217             :        ELSE
     218           0 :           STOP "BUG2 in eig_mem"
     219             :        ENDIF
     220             :     ENDIF
     221             : 
     222             :   
     223             :     !data from d%eig_eig
     224           0 :     IF (PRESENT(eig)) THEN
     225           0 :        d%eig_eig(:SIZE(eig),1,nrec)=eig
     226             :     ENDIF
     227           0 :     IF (PRESENT(w_iks)) THEN
     228           0 :        d%eig_eig(:SIZE(w_iks),2,nrec)=w_iks
     229             :     ENDIF
     230             :     !data from d%eig_vec
     231           0 :     IF (PRESENT(zmat)) THEN
     232           0 :        IF (zmat%l_real) THEN
     233           0 :           IF (.NOT.ALLOCATED(d%eig_vecr)) THEN
     234           0 :              IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
     235           0 :              d%eig_vecc(:SIZE(zmat%data_r),nrec)=RESHAPE(CMPLX(zmat%data_r),(/SIZE(zmat%data_r)/)) !Type cast here
     236             :           ELSE
     237           0 :              d%eig_vecr(:SIZE(zmat%data_r),nrec)=RESHAPE(REAL(zmat%data_r),(/SIZE(zmat%data_r)/))
     238             :           ENDIF
     239             :        ELSE
     240           0 :           IF (.NOT.ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
     241           0 :           d%eig_vecc(:SIZE(zmat%data_c),nrec)=RESHAPE(zmat%data_c,(/SIZE(zmat%data_c)/))
     242             :        END IF
     243             :     ENDIF
     244             : 
     245             : 
     246           0 :   END SUBROUTINE write_eig
     247             : 
     248             : 
     249           0 : END MODULE m_eig66_mem

Generated by: LCOV version 1.13