1! 2! Copyright (C) 2013 Quantum ESPRESSO group 3! This file is distributed under the terms of the 4! GNU General Public License. See the file `License' 5! in the root directory of the present distribution, 6! or http://www.gnu.org/copyleft/gpl.txt . 7! 8!---------------------------------------------------------------------------- 9MODULE mp_images 10 !---------------------------------------------------------------------------- 11 ! 12 USE mp, ONLY : mp_barrier, mp_bcast, mp_size, mp_rank, mp_comm_split 13 USE io_global, ONLY : ionode, ionode_id 14 USE parallel_include 15 ! 16 IMPLICIT NONE 17 SAVE 18 ! 19 ! ... Image groups (processors within an image). Images are used for 20 ! ... coarse-grid parallelization of semi-independent calculations, 21 ! ... e.g. points along the reaction path (NEB) or phonon irreps 22 ! 23 INTEGER :: nimage = 1 ! number of images 24 INTEGER :: nproc_image=1 ! number of processors within an image 25 INTEGER :: me_image = 0 ! index of the processor within an image 26 INTEGER :: root_image= 0 ! index of the root processor within an image 27 INTEGER :: my_image_id=0 ! index of my image 28 INTEGER :: inter_image_comm = 0 ! inter image communicator 29 INTEGER :: intra_image_comm = 0 ! intra image communicator 30CONTAINS 31 ! 32 !----------------------------------------------------------------------- 33 SUBROUTINE mp_start_images ( nimage_, parent_comm ) 34 !----------------------------------------------------------------------- 35 ! 36 ! ... Divide processors (of the "parent_comm" group) into "images". 37 ! ... Requires: nimage_, read from command line 38 ! ... parent_comm, typically world_comm = group of all processors 39 ! 40 IMPLICIT NONE 41 INTEGER, INTENT(IN) :: nimage_, parent_comm 42 ! 43#if defined (__MPI) 44 INTEGER :: parent_nproc, parent_mype 45 ! 46 ! ... nothing needed to be done in serial calculation 47 ! 48 parent_nproc = mp_size( parent_comm ) 49 parent_mype = mp_rank( parent_comm ) 50 ! 51 ! ... nimage_ must have been previously read from command line argument 52 ! ... by a call to routine get_command_line 53 ! 54 nimage = nimage_ 55 ! 56 IF ( nimage < 1 .OR. nimage > parent_nproc ) & 57 CALL errore( 'mp_start_images', 'invalid number of images, out of range', 1 ) 58 IF ( MOD( parent_nproc, nimage ) /= 0 ) & 59 CALL errore( 'mp_start_images', 'n. of images must be divisor of nproc', 1 ) 60 ! 61 ! ... set number of cpus per image 62 ! 63 nproc_image = parent_nproc / nimage 64 ! 65 ! ... set index of image for this processor ( 0 : nimage - 1 ) 66 ! 67 my_image_id = parent_mype / nproc_image 68 ! 69 ! ... set index of processor within the image ( 0 : nproc_image - 1 ) 70 ! 71 me_image = MOD( parent_mype, nproc_image ) 72 ! 73 CALL mp_barrier( parent_comm ) 74 ! 75 ! ... the intra_image_comm communicator is created 76 ! 77 CALL mp_comm_split ( parent_comm, my_image_id, parent_mype, & 78 intra_image_comm ) 79 ! 80 CALL mp_barrier( parent_comm ) 81 ! 82 ! ... the inter_image_comm communicator is created 83 ! 84 CALL mp_comm_split ( parent_comm, me_image, parent_mype, & 85 inter_image_comm ) 86 ! 87 ! ... set processor that performs I/O 88 ! 89 ionode = ( me_image == root_image ) 90 ionode_id = root_image 91 ! 92#endif 93 RETURN 94 ! 95 END SUBROUTINE mp_start_images 96 ! 97 SUBROUTINE mp_init_image ( parent_comm ) 98 ! 99 ! ... There is just one image: set it to the same as parent_comm (world) 100 ! 101 IMPLICIT NONE 102 INTEGER, INTENT(IN) :: parent_comm 103 ! 104 intra_image_comm = parent_comm 105 nproc_image = mp_size( parent_comm ) 106 me_image = mp_rank( parent_comm ) 107 ! 108 ! ... no need to set inter_image_comm, my_image_id, root_image 109 ! ... set processor that performs I/O 110 ! 111 ionode = ( me_image == root_image ) 112 ionode_id = root_image 113 ! 114 END SUBROUTINE mp_init_image 115 ! 116END MODULE mp_images 117