! ! Copyright (C) 2002 FPMD group ! This file is distributed under the terms of the ! GNU General Public License. See the file `License' ! in the root directory of the present distribution, ! or http://www.gnu.org/copyleft/gpl.txt . ! MODULE descriptors ! IMPLICIT NONE SAVE INTEGER ldim_block, ldim_cyclic, ldim_block_cyclic, ldim_block_sca INTEGER gind_block, gind_cyclic, gind_block_cyclic, gind_block_sca EXTERNAL ldim_block, ldim_cyclic, ldim_block_cyclic, ldim_block_sca EXTERNAL gind_block, gind_cyclic, gind_block_cyclic, gind_block_sca ! Descriptor for linear algebra data distribution (like in Cannon's algorithm) ! ! Remember here we use square matrixes block distributed on a square grid of processors ! TYPE la_descriptor INTEGER :: ir = 0 ! globla index of the first row in the local block of the distributed matrix INTEGER :: nr = 0 ! number of row in the local block of the distributed matrix INTEGER :: ic = 0 ! global index of the first column in the local block of the distributed matrix INTEGER :: nc = 0 ! number of column in the local block of the distributed matrix INTEGER :: nrcx = 0 ! leading dimension of the distribute matrix (greather than nr and nc) INTEGER :: active_node = 0 ! if > 0 the proc holds a block of the lambda matrix INTEGER :: n = 0 ! global dimension of the matrix INTEGER :: nx = 0 ! global leading dimension ( >= n ) INTEGER :: npr = 0 ! number of row processors INTEGER :: npc = 0 ! number of column processors INTEGER :: myr = 0 ! processor row index INTEGER :: myc = 0 ! processor column index INTEGER :: comm = 0 ! communicator INTEGER :: mype = 0 ! processor index ( from 0 to desc( la_npr_ ) * desc( la_npc_ ) - 1 ) INTEGER :: nrl = 0 ! number of local rows, when the matrix rows are cyclically distributed across proc INTEGER :: nrlx = 0 ! leading dimension, when the matrix is distributed by row END TYPE ! CONTAINS !------------------------------------------------------------------------ ! SUBROUTINE descla_local_dims( i2g, nl, n, nx, np, me ) IMPLICIT NONE INTEGER, INTENT(OUT) :: i2g ! global index of the first local element INTEGER, INTENT(OUT) :: nl ! local number of elements INTEGER, INTENT(IN) :: n ! number of actual element in the global array INTEGER, INTENT(IN) :: nx ! dimension of the global array (nx>=n) to be distributed INTEGER, INTENT(IN) :: np ! number of processors INTEGER, INTENT(IN) :: me ! taskid for which i2g and nl are computed ! ! note that we can distribute a global array larger than the ! number of actual elements. This could be required for performance ! reasons, and to have an equal partition of matrix having different size ! like matrixes of spin-up and spin-down ! #if __SCALAPACK nl = ldim_block_sca( nx, np, me ) i2g = gind_block_sca( 1, nx, np, me ) #else nl = ldim_block( nx, np, me ) i2g = gind_block( 1, nx, np, me ) #endif ! This is to try to keep a matrix N * N into the same ! distribution of a matrix NX * NX, useful to have ! the matrix of spin-up distributed in the same way ! of the matrix of spin-down ! IF( i2g + nl - 1 > n ) nl = n - i2g + 1 IF( nl < 0 ) nl = 0 RETURN ! END SUBROUTINE descla_local_dims ! ! SUBROUTINE descla_init( descla, n, nx, np, me, comm, includeme ) ! IMPLICIT NONE TYPE(la_descriptor), INTENT(OUT) :: descla INTEGER, INTENT(IN) :: n ! the size of this matrix INTEGER, INTENT(IN) :: nx ! the max among different matrixes sharing ! this descriptor or the same data distribution INTEGER, INTENT(IN) :: np(2), me(2), comm INTEGER, INTENT(IN) :: includeme INTEGER :: ir, nr, ic, nc, lnode, nrcx, nrl, nrlx INTEGER :: ip, npp IF( np(1) /= np(2) ) & CALL errore( ' descla_init ', ' only square grid of proc are allowed ', 2 ) IF( n < 0 ) & CALL errore( ' descla_init ', ' dummy argument n less than 1 ', 3 ) IF( nx < n ) & CALL errore( ' descla_init ', ' dummy argument nx less than n ', 4 ) IF( np(1) < 1 ) & CALL errore( ' descla_init ', ' dummy argument np less than 1 ', 5 ) ! find the block maximum dimensions #if __SCALAPACK nrcx = ldim_block_sca( nx, np(1), 0 ) #else nrcx = ldim_block( nx, np(1), 0 ) DO ip = 1, np(1) - 1 nrcx = MAX( nrcx, ldim_block( nx, np(1), ip ) ) END DO #endif ! ! find local dimensions, if appropriate ! IF( includeme == 1 ) THEN ! CALL descla_local_dims( ir, nr, n, nx, np(1), me(1) ) CALL descla_local_dims( ic, nc, n, nx, np(2), me(2) ) ! lnode = 1 ! ELSE ! nr = 0 nc = 0 ! ir = 0 ic = 0 ! lnode = -1 ! END IF descla%ir = ir ! globla index of the first row in the local block of lambda descla%nr = nr ! number of row in the local block of lambda ( the "2" accounts for spin) descla%ic = ic ! global index of the first column in the local block of lambda descla%nc = nc ! number of column in the local block of lambda descla%nrcx = nrcx ! leading dimension of the distribute lambda matrix descla%active_node = lnode ! if > 0 the proc holds a block of the lambda matrix descla%n = n ! global dimension of the matrix descla%nx = nx ! global leading dimension descla%npr = np(1) ! number of row processors descla%npc = np(2) ! number of column processors descla%myr = me(1) ! processor row index descla%myc = me(2) ! processor column index descla%comm = comm ! communicator descla%mype = descla%myc + descla%myr * descla%npr ! processor index ( from 0 to desc( la_npr_ ) * desc( la_npc_ ) - 1 ) npp = np(1) * np(2) ! Compute local dimension of the cyclically distributed matrix ! IF( includeme == 1 ) THEN nrl = ldim_cyclic( n, npp, descla%mype ) ELSE nrl = 0 END IF nrlx = n / npp + 1 descla%nrl = nrl ! number of local rows, when the matrix rows are cyclically distributed across procs descla%nrlx = nrlx ! leading dimension IF( nr < 0 .OR. nc < 0 ) & CALL errore( ' descla_init ', ' wrong valune for computed nr and nc ', 1 ) IF( nrcx < 1 ) & CALL errore( ' descla_init ', ' wrong value for computed nrcx ', 2 ) IF( nrcx < nr ) & CALL errore( ' descla_init ', ' nrcx < nr ', ( nr - nrcx ) ) IF( nrcx < nc ) & CALL errore( ' descla_init ', ' nrcx < nc ', ( nc - nrcx ) ) IF( nrlx < nrl ) & CALL errore( ' descla_init ', ' nrlx < nrl ', ( nrl - nrlx ) ) IF( nrl < 0 ) & CALL errore( ' descla_init ', ' nrl < 0 ', ABS( nrl ) ) RETURN END SUBROUTINE descla_init END MODULE descriptors