| 1 | #ifdef DPROCMAP
|
|---|
| 2 | c-----------------------------------------------------------------------
|
|---|
| 3 | c
|
|---|
| 4 | c gllnid and gllel are stored as a distributed array ordered by
|
|---|
| 5 | c the global element index. Access is provided by two
|
|---|
| 6 | c functions gllnid() and gllel(). Each ranks holds a local cache
|
|---|
| 7 | c for its local and some remote elements.
|
|---|
| 8 | c
|
|---|
| 9 | c-----------------------------------------------------------------------
|
|---|
| 10 | subroutine dProcmapInit()
|
|---|
| 11 |
|
|---|
| 12 | include 'mpif.h'
|
|---|
| 13 | include 'SIZE'
|
|---|
| 14 | include 'PARALLEL'
|
|---|
| 15 | include 'DPROCMAP'
|
|---|
| 16 |
|
|---|
| 17 | common /nekmpi/ nid_,np_,nekcomm,nekgroup,nekreal
|
|---|
| 18 |
|
|---|
| 19 | integer disp_unit
|
|---|
| 20 | integer*8 wsize
|
|---|
| 21 |
|
|---|
| 22 | #ifdef MPI
|
|---|
| 23 | disp_unit = ISIZE
|
|---|
| 24 | wsize = disp_unit*size(dProcmapWin)
|
|---|
| 25 | call MPI_Win_create(dProcmapWin,
|
|---|
| 26 | $ wsize,
|
|---|
| 27 | $ disp_unit,
|
|---|
| 28 | $ MPI_INFO_NULL,
|
|---|
| 29 | $ nekcomm,dProcmapH,ierr)
|
|---|
| 30 |
|
|---|
| 31 | if (ierr .ne. 0 ) call exitti('MPI_Win_allocate failed!$',0)
|
|---|
| 32 | #endif
|
|---|
| 33 |
|
|---|
| 34 | dProcmapCache = .false.
|
|---|
| 35 |
|
|---|
| 36 | return
|
|---|
| 37 | end
|
|---|
| 38 | c-----------------------------------------------------------------------
|
|---|
| 39 | subroutine dProcmapPut(ibuf,lbuf,ioff,ieg)
|
|---|
| 40 |
|
|---|
| 41 | include 'mpif.h'
|
|---|
| 42 | include 'SIZE'
|
|---|
| 43 | include 'PARALLEL'
|
|---|
| 44 | include 'DPROCMAP'
|
|---|
| 45 |
|
|---|
| 46 | integer ibuf(lbuf)
|
|---|
| 47 | integer*8 disp
|
|---|
| 48 |
|
|---|
| 49 | if (lbuf.lt.1 .or. lbuf.gt.2)
|
|---|
| 50 | $ call exitti('invalid lbuf!',lbuf)
|
|---|
| 51 |
|
|---|
| 52 | #ifdef MPI
|
|---|
| 53 | call dProcMapFind(iloc,nids,ieg)
|
|---|
| 54 | disp = 2*(iloc-1) + ioff
|
|---|
| 55 |
|
|---|
| 56 | call mpi_win_lock(MPI_LOCK_EXCLUSIVE,nids,0,dProcmapH,ierr)
|
|---|
| 57 | call mpi_put(ibuf,lbuf,MPI_INTEGER,nids,disp,lbuf,MPI_INTEGER,
|
|---|
| 58 | $ dProcmapH,ierr)
|
|---|
| 59 | call mpi_win_unlock(nids,dProcmapH,ierr)
|
|---|
| 60 | #else
|
|---|
| 61 | call icopy(dProcmapWin(2*(ieg-1) + ioff + 1),ibuf,lbuf)
|
|---|
| 62 | #endif
|
|---|
| 63 |
|
|---|
| 64 | return
|
|---|
| 65 | end
|
|---|
| 66 | c-----------------------------------------------------------------------
|
|---|
| 67 | subroutine dProcmapGet(ibuf,ieg)
|
|---|
| 68 |
|
|---|
| 69 | include 'mpif.h'
|
|---|
| 70 | include 'SIZE'
|
|---|
| 71 | include 'PARALLEL'
|
|---|
| 72 | include 'DPROCMAP'
|
|---|
| 73 |
|
|---|
| 74 | integer ibuf(2)
|
|---|
| 75 |
|
|---|
| 76 | integer*8 disp
|
|---|
| 77 |
|
|---|
| 78 | ! local cache
|
|---|
| 79 | parameter (lcr = lelt) ! remote elements
|
|---|
| 80 | parameter (lc = lelt+lcr+8-mod(lelt+lcr,8)) ! multiple of 8
|
|---|
| 81 | integer cache(lc,3)
|
|---|
| 82 | save cache
|
|---|
| 83 |
|
|---|
| 84 | save icalld
|
|---|
| 85 | data icalld /0/
|
|---|
| 86 |
|
|---|
| 87 | save iran
|
|---|
| 88 | parameter(im = 6075, ia = 106, ic = 1283)
|
|---|
| 89 |
|
|---|
| 90 | if (icalld .eq. 0) then
|
|---|
| 91 | call ifill(cache,-1,size(cache))
|
|---|
| 92 | icalld = 1
|
|---|
| 93 | endif
|
|---|
| 94 |
|
|---|
| 95 | ii = lsearch_ur(cache(1,3),lc,ieg)
|
|---|
| 96 | if (ii.gt.lc) call exitti('lsearch_ur returns invalid index$',ii)
|
|---|
| 97 | if (ii.gt.0 .and. ii.ne.lelt+lcr) then ! cache hit
|
|---|
| 98 | c write(6,*) nid, 'cache hit ', 'ieg:', ieg
|
|---|
| 99 | ibuf(1) = cache(ii,1)
|
|---|
| 100 | ibuf(2) = cache(ii,2)
|
|---|
| 101 | else
|
|---|
| 102 | #ifdef MPI
|
|---|
| 103 | call dProcmapFind(il,nidt,ieg)
|
|---|
| 104 | disp = 2*(il-1)
|
|---|
| 105 | call mpi_win_lock(MPI_LOCK_SHARED,nidt,0,dProcmapH,ierr)
|
|---|
| 106 | call mpi_get(ibuf,2,MPI_INTEGER,nidt,disp,2,MPI_INTEGER,
|
|---|
| 107 | $ dProcmapH,ierr)
|
|---|
| 108 | call mpi_win_unlock(nidt,dProcmapH,ierr)
|
|---|
| 109 | #else
|
|---|
| 110 | call icopy(ibuf,dProcmapWin(2*(ieg-1) + 1),2)
|
|---|
| 111 | #endif
|
|---|
| 112 | if (dProcmapCache) then
|
|---|
| 113 | if (ibuf(2).eq.nid) then
|
|---|
| 114 | ii = ibuf(1)
|
|---|
| 115 | else
|
|---|
| 116 | iran = mod(iran*ia+ic,im)
|
|---|
| 117 | ii = lelt + (lcr*iran)/im + 1 ! randomize array location
|
|---|
| 118 | endif
|
|---|
| 119 | cache(ii,1) = ibuf(1)
|
|---|
| 120 | cache(ii,2) = ibuf(2)
|
|---|
| 121 | cache(ii,3) = ieg
|
|---|
| 122 | endif
|
|---|
| 123 | endif
|
|---|
| 124 |
|
|---|
| 125 | return
|
|---|
| 126 | end
|
|---|
| 127 | c-----------------------------------------------------------------------
|
|---|
| 128 | subroutine dProcMapFind(il,nids,ieg)
|
|---|
| 129 |
|
|---|
| 130 | include 'SIZE'
|
|---|
| 131 | include 'PARALLEL'
|
|---|
| 132 |
|
|---|
| 133 | nstar = nelgt/np
|
|---|
| 134 | nids = (ieg-1)/nstar
|
|---|
| 135 | il = ieg - nids * nstar
|
|---|
| 136 | if (ieg .gt. np*nstar) then
|
|---|
| 137 | nids = mod(ieg,np) - 1
|
|---|
| 138 | il = nstar + 1
|
|---|
| 139 | endif
|
|---|
| 140 |
|
|---|
| 141 | return
|
|---|
| 142 | end
|
|---|
| 143 | c-----------------------------------------------------------------------
|
|---|
| 144 | integer function lsearch_ur(a,n,k)
|
|---|
| 145 |
|
|---|
| 146 | integer a(n), n, k
|
|---|
| 147 | parameter(lvec = 8) ! unroll factor
|
|---|
| 148 |
|
|---|
| 149 | lsearch_ur = 0
|
|---|
| 150 | do i = 1,n,lvec
|
|---|
| 151 | do j = 0,lvec-1
|
|---|
| 152 | if (a(i+j).eq.k) lsearch_ur = i + j
|
|---|
| 153 | enddo
|
|---|
| 154 | if (lsearch_ur.gt.0) goto 10
|
|---|
| 155 | enddo
|
|---|
| 156 |
|
|---|
| 157 | 10 continue
|
|---|
| 158 | end
|
|---|
| 159 | c-----------------------------------------------------------------------
|
|---|
| 160 | integer function gllnid(ieg)
|
|---|
| 161 |
|
|---|
| 162 | include 'mpif.h'
|
|---|
| 163 |
|
|---|
| 164 | integer iegl, nidl
|
|---|
| 165 | save iegl, nidl
|
|---|
| 166 | data iegl, nidl /0,0/
|
|---|
| 167 |
|
|---|
| 168 | integer ibuf(2)
|
|---|
| 169 |
|
|---|
| 170 | if (ieg.eq.0) iegl = 0
|
|---|
| 171 |
|
|---|
| 172 | if (ieg.eq.iegl) then
|
|---|
| 173 | ibuf(2) = nidl
|
|---|
| 174 | goto 100
|
|---|
| 175 | endif
|
|---|
| 176 | call dProcmapGet(ibuf,ieg)
|
|---|
| 177 |
|
|---|
| 178 | 100 iegl = ieg
|
|---|
| 179 | nidl = ibuf(2)
|
|---|
| 180 | gllnid = ibuf(2)
|
|---|
| 181 |
|
|---|
| 182 | end
|
|---|
| 183 | c-----------------------------------------------------------------------
|
|---|
| 184 | integer function gllel(ieg)
|
|---|
| 185 |
|
|---|
| 186 | include 'mpif.h'
|
|---|
| 187 |
|
|---|
| 188 | integer iegl, iell
|
|---|
| 189 | save iegl, iell
|
|---|
| 190 | data iegl, iell /0,0/
|
|---|
| 191 |
|
|---|
| 192 | integer ibuf(2)
|
|---|
| 193 |
|
|---|
| 194 | if (ieg.eq.0) iegl = 0
|
|---|
| 195 |
|
|---|
| 196 | if (ieg.eq.iegl) then
|
|---|
| 197 | ibuf(1) = iell
|
|---|
| 198 | goto 100
|
|---|
| 199 | endif
|
|---|
| 200 | call dProcmapGet(ibuf,ieg)
|
|---|
| 201 |
|
|---|
| 202 | 100 iegl = ieg
|
|---|
| 203 | iell = ibuf(1)
|
|---|
| 204 | gllel = ibuf(1)
|
|---|
| 205 |
|
|---|
| 206 | end
|
|---|
| 207 | #endif
|
|---|
