LCOV - code coverage report
Current view: top level - io - eig66_mpi.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 248 299 82.9 %
Date: 2024-03-29 04:21:46 Functions: 7 10 70.0 %

          Line data    Source code
       1             : MODULE m_eig66_mpi
       2             : use m_juDFT
       3             :    USE m_eig66_data
       4             :    USE m_types_mat
       5             :    USE m_judft
       6             : #ifdef CPP_MPI
       7             :    USE mpi
       8             : #endif
       9             :    IMPLICIT NONE
      10             :    PRIVATE
      11             :    PUBLIC open_eig, read_eig, write_eig, close_eig, reset_eig, priv_find_data
      12             : CONTAINS
      13             : 
      14       20462 :    SUBROUTINE priv_find_data(id, d)
      15             :       INTEGER, INTENT(IN)::id
      16             :       TYPE(t_data_mpi), POINTER, ASYNCHRONOUS:: d
      17             : 
      18             :       CLASS(t_data), POINTER   ::dp
      19       20462 :       CALL eig66_find_data(dp, id)
      20             :       SELECT TYPE (dp)
      21             :       TYPE is (t_data_mpi)
      22       20462 :          d => dp
      23             :       CLASS default
      24           0 :          CALL judft_error("BUG: wrong datatype in eig66_mpi")
      25             :       END SELECT
      26       20462 :    END SUBROUTINE priv_find_data
      27             : 
      28         616 :    SUBROUTINE open_eig(id, mpi_comm, nmat, neig, nkpts, jspins, create, l_real, l_soc, l_noco, l_olap, n_size_opt, filename)
      29             :       USE, INTRINSIC::iso_c_binding
      30             :       IMPLICIT NONE
      31             :       INTEGER, INTENT(IN) :: id, mpi_comm, nmat, neig, nkpts, jspins
      32             :       LOGICAL, INTENT(IN) :: l_noco, create, l_real, l_soc, l_olap
      33             :       INTEGER, INTENT(IN), OPTIONAL:: n_size_opt
      34             :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
      35             : #ifdef CPP_MPI
      36             :       CHARACTER(len=20):: arg
      37             :       INTEGER:: isize, e, slot_size, local_slots
      38             :       INTEGER, PARAMETER::mcored = 27 !there should not be more that 27 core states
      39             :       TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
      40             : 
      41         154 :       CALL priv_find_data(id, d)
      42         242 :       CALL eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real .AND. .NOT. l_soc, l_soc)
      43             : 
      44         154 :       IF (PRESENT(n_size_opt)) d%n_size = n_size_opt
      45         154 :       IF (ALLOCATED(d%pe_ev)) THEN
      46           0 :          IF (create) CALL reset_eig(id, l_soc)
      47           0 :          IF (PRESENT(filename)) CALL judft_error("Storing of data not implemented for MPI case", calledby="eig66_mpi.F")
      48           0 :          RETURN !everything already done!
      49             :       ENDIF
      50             : 
      51         154 :       CALL timestart("create data spaces in ei66_mpi")
      52         154 :       CALL MPI_COMM_RANK(MPI_COMM, d%irank, e)
      53         154 :       CALL MPI_COMM_SIZE(MPI_COMM, isize, e)
      54             : 
      55         154 :       CALL create_maps(d, isize, nkpts, jspins, neig, d%n_size, nmat)
      56        2628 :       local_slots = COUNT(d%pe_basis == d%irank)
      57             :       !Now create the windows
      58             : 
      59             :       !Window for neig
      60             :       slot_size = 1
      61         154 :       CALL priv_create_memory(1, local_slots, d%neig_handle, d%neig_data)
      62        1306 :       d%neig_data = 0
      63             : 
      64             :       !The eigenvalues
      65         154 :       d%size_eig = neig
      66         154 :       CALL priv_create_memory(d%size_eig, local_slots, d%eig_handle, real_data_ptr=d%eig_data)
      67       56666 :       d%eig_data = 1E99
      68             : 
      69             :       !The eigenvectors
      70      139334 :       local_slots = COUNT(d%pe_ev == d%irank)
      71         154 :       slot_size = nmat
      72         154 :       IF (l_real .AND. .NOT. l_soc) THEN
      73          66 :          CALL priv_create_memory(slot_size, local_slots, d%zr_handle, real_data_ptr=d%zr_data)
      74             :       ELSE
      75          88 :          CALL priv_create_memory(slot_size, local_slots, d%zc_handle, cmplx_data_ptr=d%zc_data)
      76             :       ENDIF
      77             : 
      78             :       !The eigenvectors
      79         154 :       IF (l_olap) THEN   
      80        6320 :          local_slots = COUNT(d%pe_olap == d%irank)
      81             :          slot_size = nmat
      82           6 :          IF (l_real .AND. .NOT. l_soc) THEN
      83           4 :             CALL priv_create_memory(slot_size, local_slots, d%olap_r_handle, real_data_ptr=d%olap_r_data)
      84             :          ELSE
      85           2 :             CALL priv_create_memory(slot_size, local_slots, d%olap_c_handle, cmplx_data_ptr=d%olap_c_data)
      86             :          ENDIF
      87             :       ENDIF
      88             : 
      89         154 :       IF (PRESENT(filename) .AND. .NOT. create) CALL judft_error("Storing of data not implemented for MPI case", calledby="eig66_mpi.F")
      90         154 :       CALL MPI_BARRIER(MPI_COMM, e)
      91         154 :       CALL timestop("create data spaces in ei66_mpi")
      92             : 
      93         154 :       IF (d%irank==0) THEN
      94          77 :         arg=TRIM(juDFT_string_for_argument("-eig"))
      95          77 :         IF (index(arg,"init")>0) CALL priv_readfromfileDA()
      96             :       ENDIF
      97             : 
      98             :    CONTAINS
      99         468 :       SUBROUTINE priv_create_memory(slot_size, local_slots, handle, int_data_ptr, real_data_ptr, cmplx_data_ptr)
     100             :          use m_types_mpi, only: judft_win_create
     101             :          IMPLICIT NONE
     102             :          INTEGER, INTENT(IN)           :: slot_size, local_slots
     103             :          INTEGER, POINTER, OPTIONAL, ASYNCHRONOUS  :: int_data_ptr(:)
     104             :          REAL, POINTER, OPTIONAL, ASYNCHRONOUS  :: real_data_ptr(:)
     105             :          COMPLEX, POINTER, OPTIONAL, ASYNCHRONOUS  :: cmplx_data_ptr(:)
     106             :          INTEGER, INTENT(OUT)          :: handle
     107             : #ifdef CPP_MPI
     108             :          TYPE(c_ptr)::ptr
     109             :          INTEGER:: e, iError
     110             :          INTEGER(MPI_ADDRESS_KIND) :: length
     111             :          INTEGER                   :: type_size
     112             :          CHARACTER(LEN=150)        :: errorString
     113             : 
     114         468 :          length = 0
     115         468 :          IF (PRESENT(real_data_ptr)) THEN
     116         224 :             length = length + 1
     117         224 :             CALL MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION, type_size, e)
     118             :          ENDIF
     119         468 :          IF (PRESENT(cmplx_data_ptr)) THEN
     120          90 :             length = length + 1
     121          90 :             CALL MPI_TYPE_SIZE(MPI_DOUBLE_COMPLEX, type_size, e)
     122             :          ENDIF
     123         468 :          IF (PRESENT(int_data_ptr)) THEN
     124         154 :             length = length + 1
     125         154 :             CALL MPI_TYPE_SIZE(MPI_INTEGER, type_size, e)
     126             :          ENDIF
     127         468 :          IF (length .NE. 1) CALL judft_error("Bug in eig66_mpi:create_memory")
     128             :          
     129             :          ! Note: In the following lines there are two assignments to length. The reason why
     130             :          !       this is split up into two lines is that the product in the 2nd line otherwise
     131             :          !       would contain only two "normal" integers. length is an integer of a different
     132             :          !       kind and has a larger value range. If it would not be part of the product there
     133             :          !       would be integer overflows under certain workloads.
     134         468 :          length = local_slots
     135         468 :          length = MAX(1, length*slot_size)
     136             : 
     137         468 :          iError = 0
     138             : #ifdef CPP_MPI_ALLOC
     139             :          length = length*type_size
     140             :          CALL MPI_ALLOC_MEM(length, MPI_INFO_NULL, ptr, e)
     141             :          IF (e .NE. 0) CPP_error("Could not allocated MPI-Data in eig66_mpi")
     142             : #endif
     143         468 :          IF (PRESENT(real_data_ptr)) THEN
     144             : #ifdef CPP_MPI_ALLOC
     145             :             CALL C_F_POINTER(ptr, real_data_ptr, (/length/type_size/))
     146             :             call judft_error("hmm damn")
     147             : #else
     148             :             ! In the following allocate a too large length may lead to a segmentation fault in the allocate statement
     149             :             ! with before being able to return of an error code.
     150     3183849 :             ALLOCATE (real_data_ptr(length), source=0.0, STAT=iError)
     151             : #endif
     152         224 :             IF (iError.EQ.0) call judft_win_create(real_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
     153         244 :          ELSEIF (PRESENT(int_data_ptr)) THEN
     154             : #ifdef CPP_MPI_ALLOC
     155             :             CALL C_F_POINTER(ptr, int_data_ptr, (/length/type_size/))
     156             : #else
     157             :             ! In the following allocate a too large length may lead to a segmentation fault in the allocate statement
     158             :             ! with before being able to return of an error code.
     159        1614 :             ALLOCATE (int_data_ptr(length), source=0, STAT=iError)
     160             : #endif
     161         154 :             IF (iError.EQ.0) call judft_win_create(int_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
     162             :          ELSE
     163             : #ifdef CPP_MPI_ALLOC
     164             :             CALL C_F_POINTER(ptr, cmplx_data_ptr, (/length/type_size/))
     165             : #else
     166             :             ! In the following allocate a too large length may lead to a segmentation fault in the allocate statement
     167             :             ! with before being able to return of an error code.
     168    10338562 :             ALLOCATE (cmplx_data_ptr(length), source=CMPLX(0.0,0.0), STAT=iError)
     169             : #endif
     170          90 :             IF (iError.EQ.0) call judft_win_create(cmplx_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
     171             :          ENDIF
     172             : #endif
     173             :          IF(iError.NE.0) THEN
     174             :             ! See comment above the related allocate statements. This error handler is not always reached.
     175           0 :             WRITE(errorString,'(a,i13,a,i13,a)') 'Allocation of array for communication failed. Needed number of elements:  slot_size ',&
     176           0 :                                  slot_size, ' x ', local_slots, ' local slots.'
     177           0 :             CALL juDFT_error(TRIM(ADJUSTL(errorString)), calledby='eig66_mpi')
     178             :          END IF
     179             : 
     180         468 :       END SUBROUTINE priv_create_memory
     181             : 
     182           0 :       SUBROUTINE priv_readfromfileDA()
     183             :          USE m_eig66_DA, ONLY: open_eig_DA => open_eig, read_eig_DA => read_eig, close_eig_DA => close_eig
     184             :          IMPLICIT NONE
     185             : 
     186             :          INTEGER:: nk, jspin, neig, tmp_id
     187           0 :          REAL    :: eig(d%size_eig)
     188           0 :          TYPE(t_mat)::zmat
     189             : 
     190           0 :          CALL zmat%alloc(d%l_real,d%nmat,d%size_eig)
     191             : 
     192           0 :          tmp_id = eig66_data_newid(DA_mode)
     193           0 :          CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, .false., filename)
     194           0 :          DO jspin = 1, d%jspins
     195           0 :             DO nk = 1, d%nkpts
     196           0 :                CALL read_eig_DA(id,nk,jspin,neig,eig,zmat=zmat)
     197           0 :                CALL write_eig(tmp_id,nk,jspin,neig,eig=eig,zmat=zmat)
     198             :             ENDDO
     199             :          ENDDO
     200           0 :          CALL close_eig_DA(tmp_id)
     201           0 :       END SUBROUTINE priv_readfromfileDA
     202             : #endif
     203             : 
     204             :    END SUBROUTINE open_eig
     205         132 :    SUBROUTINE close_eig(id, delete, filename)
     206             :       INTEGER, INTENT(IN)         :: id
     207             :       LOGICAL, INTENT(IN), OPTIONAL:: delete
     208             :       CHARACTER(LEN=*), INTENT(IN), OPTIONAL::filename
     209             :       TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
     210             : 
     211             :       character(len=20):: arg
     212         132 :       CALL priv_find_data(id, d)
     213             : 
     214         132 :       IF (PRESENT(delete)) THEN
     215           0 :          IF (delete) WRITE (*, *) "No deallocation of memory implemented in eig66_mpi"
     216             :       ENDIF
     217             : 
     218         132 :       IF (d%irank==0) THEN
     219          66 :         arg=TRIM(juDFT_string_for_argument("-eig"))
     220          66 :         IF (index(arg,"save")>0) CALL priv_writetofileDA()
     221             :       ENDIF
     222             :       CONTAINS
     223           0 :       SUBROUTINE priv_writetofileDA()
     224             :          USE m_eig66_DA, ONLY: open_eig_DA => open_eig, write_eig_DA => write_eig, close_eig_DA => close_eig
     225             :          IMPLICIT NONE
     226             : 
     227             :          INTEGER:: nk, jspin, neig, tmp_id
     228           0 :          REAL    :: eig(d%size_eig)
     229           0 :          TYPE(t_mat)::zmat
     230             : 
     231           0 :          CALL zmat%alloc(d%l_real,d%nmat,d%size_eig)
     232             : 
     233           0 :          tmp_id = eig66_data_newid(DA_mode)
     234           0 :          CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, .false.)
     235           0 :          DO jspin = 1, d%jspins
     236           0 :             DO nk = 1, d%nkpts
     237           0 :                CALL read_eig(id,nk,jspin,neig,eig,zmat=zmat)
     238           0 :                CALL write_eig_DA(tmp_id,nk,jspin,neig,eig=eig,zmat=zmat)
     239             :             ENDDO
     240             :          ENDDO
     241           0 :          CALL close_eig_DA(tmp_id)
     242           0 :       END SUBROUTINE priv_writetofileDA
     243             :    END SUBROUTINE close_eig
     244             : 
     245       11532 :    SUBROUTINE read_eig(id, nk, jspin, neig, eig, list, zmat, smat)
     246             :       IMPLICIT NONE
     247             :       INTEGER, INTENT(IN)            :: id, nk, jspin
     248             :       INTEGER, INTENT(OUT), OPTIONAL  :: neig
     249             :       REAL, INTENT(OUT), OPTIONAL  :: eig(:)
     250             :       INTEGER, INTENT(IN), OPTIONAL   :: list(:)
     251             :       TYPE(t_mat), OPTIONAL  :: zmat, smat
     252             : 
     253             : #ifdef CPP_MPI
     254             :       INTEGER                   :: pe, tmp_size, e, req
     255             :       INTEGER(MPI_ADDRESS_KIND) :: slot
     256             :       INTEGER                   :: n1, n2, n3, n
     257             :       INTEGER, ALLOCATABLE, ASYNCHRONOUS       :: tmp_int(:)
     258       11532 :       REAL, ALLOCATABLE, ASYNCHRONOUS          :: tmp_real(:)
     259       11532 :       COMPLEX, ALLOCATABLE, ASYNCHRONOUS       :: tmp_cmplx(:)
     260             :       TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
     261       11532 :       CALL priv_find_data(id, d)
     262       11532 :       pe = d%pe_basis(nk, jspin)
     263       11532 :       slot = d%slot_basis(nk, jspin)
     264       11532 :       IF (PRESENT(neig)) THEN
     265        8758 :          CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%neig_handle, e)
     266             :          ! Get current values
     267        8758 :          CALL MPI_GET(neig, 1, MPI_INTEGER, pe, slot, 1, MPI_INTEGER, d%neig_handle, e)
     268        8758 :          CALL MPI_WIN_UNLOCK(pe, d%neig_handle, e)
     269             :       ENDIF
     270       11532 :       IF (PRESENT(eig)) THEN
     271        4710 :          ALLOCATE (tmp_real(MIN(SIZE(eig), d%size_eig)))
     272        1570 :          IF (PRESENT(eig)) THEN
     273        1570 :             CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%eig_handle, e)
     274        1570 :             CALL MPI_GET(tmp_real, SIZE(tmp_real), MPI_DOUBLE_PRECISION, pe, slot, SIZE(tmp_real), MPI_DOUBLE_PRECISION, d%eig_handle, e)
     275        1570 :             CALL MPI_WIN_UNLOCK(pe, d%eig_handle, e)
     276       86358 :             eig(:SIZE(tmp_real)) = tmp_real
     277             :          END IF
     278        1570 :          DEALLOCATE (tmp_real)
     279             :       ENDIF
     280             : 
     281       11532 :       IF (PRESENT(zmat)) THEN
     282       10444 :          tmp_size = zmat%matsize1
     283       31332 :          ALLOCATE (tmp_real(tmp_size))
     284       31332 :          ALLOCATE (tmp_cmplx(tmp_size))
     285      176323 :          DO n = 1, zmat%matsize2
     286      165879 :             n1 = n
     287      165879 :             IF (PRESENT(list)) THEN
     288      165879 :                IF (n > SIZE(list)) CYCLE
     289      165879 :                n1 = list(n)
     290             :             END IF
     291      165879 :             slot = d%slot_ev(nk, jspin, n1)
     292      165879 :             pe = d%pe_ev(nk, jspin, n1)
     293             : 
     294      176323 :             IF (zmat%l_real) THEN
     295       48424 :                IF (.NOT. d%l_real) THEN
     296         212 :                   CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%zc_handle, e)
     297         212 :                   CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
     298         212 :                   CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
     299             :                   !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
     300       46832 :                   zmat%data_r(:, n) = REAL(tmp_cmplx)
     301             :                ELSE
     302       48212 :                   CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%zr_handle, e)
     303       48212 :                   CALL MPI_GET(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%zr_handle, e)
     304       48212 :                   CALL MPI_WIN_UNLOCK(pe, d%zr_handle, e)
     305             :                   !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_real(1)
     306     6146299 :                   zmat%data_r(:, n) = tmp_real
     307             :                ENDIF
     308             :             ELSE
     309      117455 :                IF (d%l_real) CALL judft_error("Could not read complex data, only real data is stored", calledby="eig66_mpi%read_eig")
     310      117455 :                CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%zc_handle, e)
     311      117455 :                CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
     312      117455 :                CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
     313             :                !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
     314    18910603 :                zmat%data_c(:, n) = tmp_cmplx
     315             :             ENDIF
     316             :          ENDDO
     317             :       ENDIF
     318             : 
     319       11532 :       IF(allocated(tmp_real))  deallocate(tmp_real)
     320       11532 :       IF(allocated(tmp_cmplx)) deallocate(tmp_cmplx)
     321             : 
     322       11532 :       IF (PRESENT(smat)) THEN
     323          24 :          tmp_size = smat%matsize1
     324          72 :          ALLOCATE (tmp_real(tmp_size))
     325          72 :          ALLOCATE (tmp_cmplx(tmp_size))
     326        3628 :          DO n = 1, smat%matsize2
     327        3604 :             n1 = n
     328        3604 :             IF (PRESENT(list)) THEN
     329           0 :                IF (n > SIZE(list)) CYCLE
     330           0 :                n1 = list(n)
     331             :             END IF
     332        3604 :             slot = d%slot_olap(nk, jspin, n1)
     333        3604 :             pe = d%pe_olap(nk, jspin, n1)
     334             : 
     335        3628 :             IF (smat%l_real) THEN
     336        2522 :                IF (.NOT. d%l_real) THEN
     337           0 :                   CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_c_handle, e)
     338           0 :                   CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
     339           0 :                   CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
     340             :                   !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
     341           0 :                   smat%data_r(:, n) = REAL(tmp_cmplx)
     342             :                ELSE
     343        2522 :                   CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_r_handle, e)
     344        2522 :                   CALL MPI_GET(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%olap_r_handle, e)
     345        2522 :                   CALL MPI_WIN_UNLOCK(pe, d%olap_r_handle, e)
     346             :                   !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_real(1)
     347      461424 :                   smat%data_r(:, n) = tmp_real
     348             :                ENDIF
     349             :             ELSE
     350        1082 :                IF (d%l_real) CALL judft_error("Could not read complex data, only real data is stored", calledby="eig66_mpi%read_eig")
     351        1082 :                CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_c_handle, e)
     352        1082 :                CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
     353        1082 :                CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
     354             :                !print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
     355      196244 :                smat%data_c(:, n) = tmp_cmplx
     356             :             ENDIF
     357             :          ENDDO
     358             :       ENDIF
     359             : 
     360             : #endif
     361       11532 :    END SUBROUTINE read_eig
     362             : 
     363        8596 :    SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, n_size, n_rank, zmat, smat)
     364             :       INTEGER, INTENT(IN)          :: id, nk, jspin
     365             :       INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
     366             :       INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
     367             :       REAL, INTENT(IN), OPTIONAL :: eig(:)
     368             :       TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
     369             : 
     370             : #ifdef CPP_MPI
     371             :       INTEGER                   :: pe, tmp_size, e
     372             :       INTEGER(MPI_ADDRESS_KIND) :: slot
     373             :       INTEGER                   :: n1, n2, n3, n, nn
     374        8596 :       INTEGER, ALLOCATABLE, ASYNCHRONOUS       :: tmp_int(:)
     375        8596 :       REAL, ALLOCATABLE, ASYNCHRONOUS          :: tmp_real(:)
     376        8596 :       COMPLEX, ALLOCATABLE, ASYNCHRONOUS       :: tmp_cmplx(:)
     377             :       LOGICAL                   :: acc
     378             :       TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
     379             : 
     380             :       INTEGER:: irank, ierr
     381             : 
     382        8596 :       CALL priv_find_data(id, d)
     383             : 
     384        8596 :       CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
     385             : 
     386        8596 :       pe = d%pe_basis(nk, jspin)
     387        8596 :       slot = d%slot_basis(nk, jspin)
     388             :       !write the number of eigenvalues
     389             :       !only one process needs to do it
     390        8596 :       IF (PRESENT(neig_total)) THEN
     391        5440 :          CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%neig_handle, e)
     392        5440 :          ALLOCATE (tmp_int(1))
     393        5440 :          tmp_int(1) = neig_total
     394        5440 :          CALL MPI_PUT(tmp_int, 1, MPI_INTEGER, pe, slot, 1, MPI_INTEGER, d%neig_handle, e)
     395        5440 :          CALL MPI_WIN_UNLOCK(pe, d%neig_handle, e)
     396        5440 :          DEALLOCATE (tmp_int)
     397             :       ENDIF
     398             : 
     399             :       !write the eigenvalues
     400             :       !only one process needs to do it
     401        8596 :       IF (PRESENT(eig)) THEN
     402       16320 :          ALLOCATE (tmp_real(d%size_eig))
     403      247574 :          tmp_real = 1E99
     404        5440 :          IF (PRESENT(EIG)) THEN
     405      213400 :             tmp_real(:SIZE(eig)) = eig(:SIZE(eig))
     406        5440 :             CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%eig_handle, e)
     407        5440 :             CALL MPI_PUT(tmp_real, d%size_eig, MPI_DOUBLE_PRECISION, pe, slot, d%size_eig, MPI_DOUBLE_PRECISION, d%eig_handle, e)
     408        5440 :             CALL MPI_WIN_UNLOCK(pe, d%eig_handle, e)
     409             :          END IF
     410        5440 :          DEALLOCATE (tmp_real)
     411             :       ENDIF
     412             : 
     413             :       !write the eigenvectors
     414             :       !all procceses participate
     415        8596 :       IF (PRESENT(zmat)) THEN
     416        7876 :          tmp_size = zmat%matsize1
     417       23628 :          ALLOCATE (tmp_real(tmp_size))
     418       23628 :          ALLOCATE (tmp_cmplx(tmp_size))
     419      246310 :          DO n = 1, zmat%matsize2
     420      242956 :             n1 = n - 1
     421      242956 :             IF (PRESENT(n_size)) n1 = n_size*n1
     422      242956 :             IF (PRESENT(n_rank)) n1 = n1 + n_rank
     423      242956 :             IF (n1 + 1 > SIZE(d%slot_ev, 3)) EXIT
     424      238434 :             slot = d%slot_ev(nk, jspin, n1 + 1)
     425      238434 :             pe = d%pe_ev(nk, jspin, n1 + 1)
     426      246310 :             IF (zmat%l_real) THEN
     427       69029 :                IF (.NOT. d%l_real) THEN
     428       48630 :                   tmp_cmplx = zmat%data_r(:, n)
     429         238 :                   CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%zc_handle, e)
     430         238 :                   CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
     431         238 :                   CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
     432             :                ELSE
     433     8939879 :                   tmp_real = zmat%data_r(:, n)
     434       68791 :                   CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%zr_handle, e)
     435       68791 :                   CALL MPI_PUT(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%zr_handle, e)
     436       68791 :                   CALL MPI_WIN_UNLOCK(pe, d%zr_handle, e)
     437             :                ENDIF
     438             :             ELSE
     439      169405 :                IF (d%l_real) CALL juDFT_error("Could not write complex data to file prepared for real data", calledby="eig66_mpi%write_eig")
     440    27713170 :                tmp_cmplx = zmat%data_c(:, n)
     441      169405 :                CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%zc_handle, e)
     442      169405 :                CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, e)
     443      169405 :                CALL MPI_WIN_UNLOCK(pe, d%zc_handle, e)
     444             :             ENDIF
     445             :          ENDDO
     446             :       ENDIF
     447             : 
     448        8596 :       IF(allocated(tmp_real))  deallocate(tmp_real)
     449        8596 :       IF(allocated(tmp_cmplx)) deallocate(tmp_cmplx)
     450             :       !write the overlap
     451             :       !all procceses participate
     452        8596 :       IF (PRESENT(smat)) THEN
     453         720 :          tmp_size = smat%matsize1
     454        2160 :          ALLOCATE (tmp_real(tmp_size))
     455        2160 :          ALLOCATE (tmp_cmplx(tmp_size))
     456       56068 :          DO n = 1, smat%matsize2
     457       55348 :             n1 = n - 1
     458       55348 :             if((.not. present(n_size)) .and. (.not. present(n_rank)) ) then
     459           0 :                call juDFT_error("smat needs n_size & n_rank")
     460             :             endif
     461       55348 :             IF (PRESENT(n_size)) n1 = n_size*n1
     462       55348 :             IF (PRESENT(n_rank)) n1 = n1 + n_rank
     463       55348 :             IF (n1 + 1 > SIZE(d%slot_olap, 3)) EXIT
     464       55348 :             slot = d%slot_olap(nk, jspin, n1 + 1)
     465       55348 :             pe = d%pe_olap(nk, jspin, n1 + 1)
     466       56068 :             IF (smat%l_real) THEN
     467       34790 :                IF (.NOT. d%l_real) THEN
     468           0 :                   tmp_cmplx = smat%data_r(:, n)
     469           0 :                   CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%olap_c_handle, e)
     470           0 :                   CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
     471           0 :                   CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
     472             :                ELSE
     473     6449198 :                   tmp_real = smat%data_r(:, n)
     474       34790 :                   CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%olap_r_handle, e)
     475       34790 :                   CALL MPI_PUT(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%olap_r_handle, e)
     476       34790 :                   CALL MPI_WIN_UNLOCK(pe, d%olap_r_handle, e)
     477             :                ENDIF
     478             :             ELSE
     479       20558 :                IF (d%l_real) CALL juDFT_error("Could not write complex data to file prepared for real data", calledby="eig66_mpi%write_eig")
     480     3749194 :                tmp_cmplx = smat%data_c(:, n)
     481       20558 :                CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE, pe, 0, d%olap_c_handle, e)
     482       20558 :                CALL MPI_PUT(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
     483       20558 :                CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
     484             :             ENDIF
     485             :          ENDDO
     486             :       ENDIF
     487             : 
     488             : #endif
     489        8596 :    END SUBROUTINE write_eig
     490             : 
     491           0 :    SUBROUTINE reset_eig(id, l_soc)
     492             :       INTEGER, INTENT(IN)        :: id
     493             :       LOGICAL, INTENT(IN)        :: l_soc
     494             : #ifdef CPP_MPI
     495             :       TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
     496           0 :       CALL priv_find_data(id, d)
     497             : 
     498           0 :       d%neig_data = 0
     499           0 :       d%eig_data = 1E99
     500           0 :       IF (d%l_real .AND. .NOT. l_soc) THEN
     501           0 :          d%zr_data = 0.0
     502             :       ELSE
     503           0 :          d%zc_data = 0.0
     504             :       ENDIF
     505             : #endif
     506           0 :    END SUBROUTINE reset_eig
     507             : 
     508             : #ifdef CPP_MPI
     509         154 :    SUBROUTINE create_maps(d, isize, nkpts, jspins, neig, n_size, nmat)
     510             :       IMPLICIT NONE
     511             :       TYPE(t_data_MPI), INTENT(INOUT), ASYNCHRONOUS:: d
     512             :       INTEGER, INTENT(IN):: isize, nkpts, jspins, neig, n_size, nmat
     513             : 
     514             :       INTEGER:: nk, j, n1, n2, n, pe, n_members
     515         154 :       INTEGER::used(0:isize)
     516             : 
     517        3090 :       allocate (d%pe_basis(nkpts, jspins), source=-1)
     518        2936 :       allocate (d%slot_basis(nkpts, jspins), source=-1)
     519             : 
     520      139950 :       allocate (d%pe_ev(nkpts, jspins, neig), source=-1)
     521      139796 :       allocate (d%slot_ev(nkpts, jspins, neig), source=-1)
     522             : 
     523      662708 :       allocate (d%pe_olap(nkpts, jspins, nmat), source=-1)
     524      662554 :       allocate (d%slot_olap(nkpts, jspins, nmat), source=-1)
     525             : 
     526             :       !basis contains a total of nkpts*jspins entries
     527        2628 :       d%pe_basis = -1
     528      139334 :       d%pe_ev    = -1
     529      662092 :       d%pe_olap  = -1
     530         616 :       used = 0
     531         154 :       n_members = isize/n_size !no of k-points in parallel
     532         410 :       DO j = 1, jspins
     533        2628 :          DO nk = 1, nkpts
     534        2218 :             n1 = nk + (j - 1)*nkpts - 1
     535        2218 :             pe = MOD(n1, n_members)*n_size
     536        2218 :             d%pe_basis(nk, j) = pe
     537        2218 :             d%slot_basis(nk, j) = used(pe)
     538        2474 :             used(pe) = used(pe) + 1
     539             :          ENDDO
     540             :       ENDDO
     541             : 
     542         616 :       used = 0
     543        9498 :       DO n = 1, neig
     544       26396 :          DO j = 1, jspins
     545      139180 :             DO nk = 1, nkpts
     546      112938 :                n1 = nk + (j - 1)*nkpts - 1
     547             :                !eigenvectors have more entries
     548             :                !pe=MOD(n1,n_members)*n_size+MOD(n,n_size)
     549      112938 :                pe = MOD(n1, n_members)*n_size + MOD(n - 1, n_size)
     550      112938 :                d%pe_ev(nk, j, n) = pe
     551      112938 :                d%slot_ev(nk, j, n) = used(pe)
     552      129836 :                used(pe) = used(pe) + 1
     553             :             ENDDO
     554             :          ENDDO
     555             :       ENDDO
     556             : 
     557         616 :       used = 0
     558       56150 :       DO n = 1, nmat
     559      148304 :          DO j = 1, jspins
     560      661938 :             DO nk = 1, nkpts
     561      513788 :                n1 = nk + (j - 1)*nkpts - 1
     562      513788 :                pe = MOD(n1, n_members)*n_size + MOD(n - 1, n_size)
     563      513788 :                d%pe_olap(nk, j, n) = pe
     564      513788 :                d%slot_olap(nk, j, n) = used(pe)
     565      605942 :                used(pe) = used(pe) + 1
     566             :             ENDDO
     567             :          ENDDO
     568             :       ENDDO
     569         154 :    END SUBROUTINE create_maps
     570             : #endif
     571             : 
     572       20462 : END MODULE m_eig66_mpi

Generated by: LCOV version 1.14