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

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_eig66_da
       8             : #include "juDFT_env.h"
       9             :   ! Do the IO of the eig-file in fortran direct-access
      10             :   ! The eig-file is split into two parts:
      11             :   ! eig.bas contains the basis-set information
      12             :   ! eig.vec contains the eigenvalues and the eigenvectors
      13             :   ! The record number is given by nrec=nk+(jspin-1)*nkpts
      14             :   ! each record contains:
      15             :   ! eig.bas: el,evac,ello,bkpt,wtkpt,nv,nmat
      16             :   ! eig.vec: ne,eig,z**
      17             :   !**: real or complex depending on calculation type
      18             :   USE m_eig66_data
      19             :   USE m_types
      20             :   IMPLICIT NONE
      21             : 
      22             : CONTAINS
      23           0 :   SUBROUTINE priv_find_data(id,d)
      24             :     INTEGER,INTENT(IN)            :: id
      25             :     TYPE(t_data_DA),POINTER,INTENT(out)   :: d
      26             : 
      27             :     CLASS(t_data),POINTER   ::dp
      28           0 :     CALL eig66_find_data(dp,id)
      29             :     SELECT TYPE(dp)
      30             :     TYPE is (t_data_da)
      31           0 :        d=>dp
      32             :        CLASS default
      33           0 :        CALL judft_error("BUG: wrong datatype in eig66_da")
      34             :     END SELECT
      35           0 :   END SUBROUTINE priv_find_data
      36             : 
      37           0 :   SUBROUTINE open_eig(id,nmat,neig,nkpts,jspins,create,l_real,l_soc,filename)
      38             :     INTEGER, INTENT(IN) :: id,nmat,neig,nkpts,jspins
      39             :     LOGICAL, INTENT(IN) :: create,l_real,l_soc
      40             :     CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
      41             :     !locals
      42             :     LOGICAL :: l_file
      43             :     INTEGER :: i1,recl_z,recl_eig
      44             :     REAL    :: r1,r3(3)
      45             :     COMPLEX :: c1
      46             :     TYPE(t_data_DA),POINTER:: d
      47             : 
      48           0 :     CALL priv_find_data(id,d)
      49             : 
      50           0 :     IF (PRESENT(filename)) d%fname=filename
      51           0 :     CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
      52             : 
      53             :     !Calculate the record length
      54             : 
      55           0 :     INQUIRE(IOLENGTH=recl_eig) r1
      56           0 :     d%recl_wiks=recl_eig*neig
      57             :     
      58           0 :     recl_eig=recl_eig*(neig+2) ! add a 2 for integer 'neig'
      59           0 :     if (l_real.and..not.l_soc ) THEN
      60           0 :        INQUIRE(IOLENGTH=recl_z) r1
      61             :     else
      62           0 :        INQUIRE(IOLENGTH=recl_z) c1
      63             :     endif
      64           0 :     recl_z=recl_z*nmat*neig
      65             :     
      66           0 :     d%recl_vec=recl_eig+recl_z
      67             : 
      68           0 :     IF (create) THEN
      69           0 :        INQUIRE(file=TRIM(d%fname),opened=l_file)
      70           0 :        DO WHILE(l_file)
      71           0 :           write(*,*) "eig66_open_da:",d%fname," in use"
      72           0 :           d%fname=TRIM(d%fname)//"6"
      73           0 :           INQUIRE(file=TRIM(d%fname),opened=l_file)
      74             :        ENDDO
      75           0 :        d%file_io_id_vec=priv_free_uid()
      76           0 :        OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='unknown')
      77           0 :        d%file_io_id_wiks=priv_free_uid()
      78           0 :        OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='unknown')
      79             :     ELSE
      80           0 :        d%file_io_id_vec=priv_free_uid()
      81           0 :        OPEN(d%file_io_id_vec,FILE=TRIM(d%fname),ACCESS='direct',FORM='unformatted',RECL=d%recl_vec,STATUS='old')
      82           0 :        d%file_io_id_wiks=priv_free_uid()
      83           0 :        OPEN(d%file_io_id_wiks,FILE=TRIM(d%fname)//".wiks",ACCESS='direct',FORM='unformatted',RECL=d%recl_wiks,STATUS='old')
      84             :     ENDIF
      85             :   CONTAINS
      86           0 :     INTEGER FUNCTION priv_free_uid() RESULT(uid)
      87             :       IMPLICIT NONE
      88             :       LOGICAL::used
      89           0 :       used=.TRUE.
      90           0 :       uid=665
      91           0 :       DO WHILE(used)
      92           0 :          uid=uid+1
      93           0 :          INQUIRE(UNIT=uid,OPENED=used)
      94             :       END DO
      95           0 :     END FUNCTION priv_free_uid
      96             :   END SUBROUTINE open_eig
      97           0 :   SUBROUTINE close_eig(id,filename)
      98             :     INTEGER,INTENT(IN)::id
      99             :     CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: filename
     100             :     TYPE(t_data_DA),POINTER:: d
     101             : 
     102           0 :     CALL priv_find_data(id,d)
     103             : 
     104           0 :     CLOSE(d%file_io_id_vec)
     105           0 :     CLOSE(d%file_io_id_wiks)
     106           0 :     d%recl_vec=0
     107           0 :     d%recl_wiks=0
     108             : 
     109             :     !If a filename was given and the name is not the current filename then rename
     110           0 :     IF (PRESENT(filename)) THEN
     111           0 :        IF (filename.NE.d%fname) THEN
     112           0 :           CALL system("mv "//TRIM(d%fname)//" "//TRIM(filename))
     113             :        ENDIF
     114             :     ENDIF
     115           0 :     d%fname="eig"
     116           0 :     CALL eig66_remove_data(id)
     117           0 :   END SUBROUTINE close_eig
     118           0 :   SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,list,zmat)
     119             :     IMPLICIT NONE
     120             :     INTEGER, INTENT(IN)            :: id,nk,jspin
     121             :     INTEGER, INTENT(OUT),OPTIONAL  :: neig
     122             :     REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
     123             :     INTEGER, INTENT(IN),OPTIONAL   :: list(:)
     124             :     TYPE(t_mat),OPTIONAL  :: zmat
     125             : 
     126             :     !Local variables
     127             :     INTEGER:: nv_s,nmat_s,n,nrec,neig_s
     128             :     REAL   :: bkpt(3),wtkpt
     129           0 :     REAL,ALLOCATABLE::eig_s(:),zr_s(:,:)
     130             :     COMPLEX,ALLOCATABLE::zc_s(:,:)
     131             :     TYPE(t_data_DA),POINTER:: d
     132             : 
     133             : 
     134             : 
     135           0 :     CALL priv_find_data(id,d)
     136             :     ! check if io is performed correctly
     137           0 :     IF (PRESENT(list)) THEN
     138           0 :        IF (list(1)/=1) &
     139           0 :             CALL juDFT_error("In direct access mode only all eigenstates can be read")
     140             :     ENDIF
     141             : 
     142           0 :     nrec=nk+(jspin-1)*d%nkpts
     143             :   
     144           0 :     IF (PRESENT(w_iks)) THEN
     145           0 :        print *, "R:w_iks:",nrec
     146           0 :         read(d%file_io_id_wiks,REC=nrec) w_iks
     147             :     ENDIF
     148             :   
     149             :     
     150           0 :     IF (.NOT.(PRESENT(eig).OR.PRESENT(neig).OR.PRESENT(zmat))) RETURN
     151           0 :     READ(d%file_io_id_vec,REC=nrec) neig_s
     152           0 :     IF (PRESENT(neig)) THEN
     153           0 :        neig=neig_s
     154             :     ENDIF
     155           0 :     IF (.NOT.(PRESENT(eig).OR.PRESENT(zmat))) RETURN
     156           0 :     ALLOCATE(eig_s(neig_s))
     157           0 :     IF (PRESENT(zmat)) THEN
     158           0 :        IF (zmat%l_real) THEN
     159           0 :           INQUIRE(IOLENGTH=n) neig_s,eig_s,REAL(zmat%data_r)
     160           0 :           IF (n>d%recl_vec) THEN
     161           0 :              CALL juDFT_error("BUG: Too long record")
     162             :           END IF
     163           0 :           READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%data_r
     164             :        ELSE
     165           0 :           INQUIRE(IOLENGTH=n) neig_s,eig_s,CMPLX(zmat%data_c)
     166           0 :           IF (n>d%recl_vec) THEN
     167           0 :              CALL juDFT_error("BUG: Too long record")
     168             :           END IF
     169           0 :           READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s,zmat%data_c
     170             :        ENDIF
     171             :     ELSE
     172           0 :        INQUIRE(IOLENGTH=n) neig_s,eig_s
     173           0 :        IF (n>d%recl_vec) CALL juDFT_error("BUG: Too long record")
     174           0 :        READ(d%file_io_id_vec,REC=nrec) neig_s,eig_s
     175             :     ENDIF
     176           0 :     IF (PRESENT(eig)) eig(:min(size(eig),neig_s))=eig_s(:min(size(eig),neig_s))
     177             :    
     178           0 :   END SUBROUTINE read_eig
     179             : 
     180           0 :   SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
     181             :     INTEGER, INTENT(IN)          :: id,nk,jspin
     182             :     INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
     183             :     INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
     184             :     REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
     185             :     TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
     186             : 
     187             :     INTEGER:: nrec,r_len
     188             :     INTEGER:: nv_s,nmat_s
     189             :     REAL   :: bkpt(3),wtkpt
     190             :     TYPE(t_data_DA),POINTER:: d
     191             : 
     192           0 :     CALL priv_find_data(id,d)
     193             :     !This mode requires all data to be written at once!!
     194             : 
     195           0 :     IF (PRESENT(n_size).AND.PRESENT(n_rank)) THEN
     196           0 :        IF (n_size/=1.OR.n_rank/=0) &
     197           0 :             CALL juDFT_error("Direct Access IO not possible in eigenvalue parallel code")
     198             :     ENDIF
     199             :     !check record length
     200             :     !INQUIRE(iolength=r_len) nmat,el,evac,ello,bk,wk,nv,d%kvec_s,kveclo
     201             :     !if (r_len>recl_bas) call juDFT_error("BUG: too long record")
     202             : 
     203             :     !Now it is time for the IO :-)
     204           0 :     nrec=nk+(jspin-1)*d%nkpts
     205           0 :     IF (PRESENT(neig).AND.PRESENT(neig_total)) THEN
     206           0 :        IF (neig.NE.neig_total) THEN
     207           0 :           CALL juDFT_error("Neig and neig_total have to be equal in DA mode",calledby="eig66_da")
     208             :        ENDIF
     209             :     ENDIF
     210           0 :     IF (PRESENT(w_iks)) THEN
     211           0 :        write(d%file_io_id_wiks,REC=nrec) w_iks
     212             :     ENDIF
     213             :  
     214             : 
     215           0 :     IF (.NOT.PRESENT(eig).OR..NOT.PRESENT(neig)) RETURN
     216             :     !Now the IO of the eigenvalues/vectors
     217           0 :     IF (PRESENT(zmat)) THEN
     218           0 :        IF (zmat%l_real) THEN
     219           0 :           INQUIRE(IOLENGTH=r_len) neig,eig,REAL(zmat%data_r)
     220           0 :           IF (r_len>d%recl_vec) CALL juDFT_error("BUG: too long record")
     221           0 :           WRITE(d%file_io_id_vec,REC=nrec) neig,eig,REAL(zmat%data_r)
     222             :        ELSE
     223           0 :           INQUIRE(IOLENGTH=r_len) neig,eig(:neig),CMPLX(zmat%data_c)
     224           0 :           IF (r_len>d%recl_vec) CALL juDFT_error("BUG: too long record")
     225           0 :           WRITE(d%file_io_id_vec,REC=nrec) neig,eig(:neig),CMPLX(zmat%data_c)
     226             :        ENDIF
     227             :     ELSE
     228           0 :        INQUIRE(IOLENGTH=r_len) neig,eig
     229           0 :        IF (r_len>d%recl_vec) CALL juDFT_error("BUG: too long record")
     230           0 :        WRITE(d%file_io_id_vec,REC=nrec) neig,eig
     231             :     ENDIF
     232             : 
     233             :   END SUBROUTINE write_eig
     234             : 
     235           0 : END MODULE m_eig66_da

Generated by: LCOV version 1.13