Changeset 1019 for codes/icosagcm/trunk
- Timestamp:
- 03/09/20 14:27:24 (5 years ago)
- Location:
- codes/icosagcm/trunk/src/parallel
- Files:
-
- 1 added
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/parallel/mpipara.F90
r953 r1019 14 14 INTEGER,SAVE :: id_mpi ! id for profiling 15 15 16 INTEGER, SAVE :: device_id 17 18 INTERFACE allocate_mpi_buffer 16 INTERFACE allocate_mpi_buffer 19 17 MODULE PROCEDURE allocate_mpi_buffer_r2, allocate_mpi_buffer_r3,allocate_mpi_buffer_r4 20 18 END INTERFACE allocate_mpi_buffer … … 49 47 #endif 50 48 USE abort_mod 49 USE openacc_mod 51 50 IMPLICIT NONE 52 51 CHARACTER(LEN=256) :: required_mode_str … … 58 57 #endif 59 58 59 CALL set_openacc_device 60 60 61 IF (using_mpi) THEN 61 62 … … 127 128 128 129 129 #ifdef _OPENACC 130 device_id = setDevice(mpi_size, mpi_rank) 131 PRINT *, 'GPU device ', device_id 132 #else 133 device_id = -1 134 #endif 130 CALL set_openacc_device(mpi_size, mpi_rank) 131 PRINT *, 'GPU device ', openacc_device_id 135 132 136 133 END SUBROUTINE init_mpipara … … 247 244 END SUBROUTINE free_mpi_buffer_r4 248 245 249 #ifdef _OPENACC 250 FUNCTION setDevice(nprocs, myrank) 251 use iso_c_binding 252 use openacc 253 USE mpi_mod 254 implicit none 255 256 interface 257 function gethostid() bind(C) 258 use iso_c_binding 259 integer(C_INT) :: gethostid 260 end function gethostid 261 end interface 262 263 integer, intent(in) :: nprocs, myrank 264 integer :: hostids(nprocs), localprocs(nprocs) 265 integer :: hostid, ierr, numdev, mydev, i, numlocal 266 integer :: setDevice 267 268 ! get the hostids so we can determine what other processes are on this node 269 hostid = gethostid() 270 call mpi_allgather(hostid,1,MPI_INTEGER,hostids,1,MPI_INTEGER, MPI_COMM_WORLD, ierr) 271 272 ! determine which processors are on this node 273 numlocal = 0 274 localprocs(:) = 0 275 do i = 1, nprocs 276 if (hostid == hostids(i)) then 277 localprocs(i) = numlocal 278 numlocal = numlocal + 1 279 end if 280 end do 281 282 ! get the number of device on this node 283 numdev = acc_get_num_devices(ACC_DEVICE_NVIDIA) 284 285 if (numdev < 1) then 286 print *, "Error: there are no devices available on this host. ABORTING", myrank 287 stop 288 end if 289 290 ! print a warning if the number of devices is less than the number of processes on this node. Having multiple processes share a devices is not recommended 291 if (numdev < numlocal) then 292 if (localprocs(myrank+1) == 1) then 293 ! print warning message only once per node 294 print *, "WARNING: the number of process is greater than the number of GPUs.", myrank 295 end if 296 mydev = mod(localprocs(myrank+1), numdev) 297 else 298 mydev = localprocs(myrank+1) 299 end if 300 301 call acc_set_device_num(mydev,ACC_DEVICE_NVIDIA) 302 call acc_init(ACC_DEVICE_NVIDIA) 303 setDevice = acc_get_device_num(ACC_DEVICE_NVIDIA) 304 END FUNCTION setDevice 305 306 #endif 307 308 246 309 247 310 248 END MODULE mpipara
Note: See TracChangeset
for help on using the changeset viewer.