32 integer,
intent(out) :: MYPE,NPES,INUMQ,MPI_COMM_COMP, &
34 integer comdup,ierr,npes_mod,iquilt_group,iqserver, &
35 istaq,iendq,icolor,istaxx,iendxx,ixx,irlr,icc,iss,issl, &
37 integer iworld,igroup,igroup_x,iworld_minus
38 integer,
allocatable :: irank ( : )
47 call mpi_comm_rank(mpi_comm_world,mype,ierr)
48 write(*,*)
' mype=',mype,
' ierr=',ierr
49 call mpi_comm_size(mpi_comm_world,npes,ierr)
50 write(*,*)
' npes=',npes,
' ierr=',ierr
68 IF ( npes < npes_mod )
THEN
69 print *,
' ***********************************************'
70 print *,
' ***********************************************'
71 print *,
' *************MAJOR PROBLEM*********************'
72 print *,
' *************MAJOR PROBLEM*********************'
73 print *,
' *************MAJOR PROBLEM*********************'
74 print *,
' *************MAJOR PROBLEM*********************'
76 print *,
' THERE ARE INSUFFICIENT MPI TASKS TO CONTINUE'
77 print *,
' YOU MUST SPECIFY AT LEAST ',npes_mod,
' TASKS'
78 print *,
' STOPPING NOW'
79 print *,
' HASTA LA VISTA BABY'
81 print *,
' *************MAJOR PROBLEM*********************'
82 print *,
' *************MAJOR PROBLEM*********************'
83 print *,
' *************MAJOR PROBLEM*********************'
84 print *,
' *************MAJOR PROBLEM*********************'
85 print *,
' ***********************************************'
86 print *,
' ***********************************************'
87 CALL mpi_abort(mpi_comm_world,1,ierr)
98 read(get,fmt=
'(i4)') iquilt_group
99 iquilt_group = max(iquilt_group,1)
103 if ( iquilt_group > 100 )
then
104 print *,
' ***** IQUILT_GROUP IS GREATER THAN 100'
105 print *,
' ***** DO YOU REALLY WANT THIS ?'
106 print *,
' ***** IF SO THEN INCREASE SIZE IN mpp.h'
107 print *,
' ***** ALSO, CHANGE IF CHECK IN SETUP_SERVERS'
108 print *,
' ***** RESETTING THE NUMBER OF SERVER GROUPS TO 100'
109 print *,
' ***** WE ARE CONTINUING .... '
112 if ( mype == 0 )
then
113 print *,
' we will try to run with ',iquilt_group,
' server groups'
125 iqserver = npes - npes_mod
126 if ( iqserver == 0 )
then
127 if ( mype == 0 )
then
128 print *,
' *** you specified 0 I/O servers '
129 print *,
' CHKOUT will write a file'
135 inumq = iendq-istaq+1
136 if ( mype == 0 ) print *,
' i, inumq = ',i+1,inumq
138 if ( iquilt_group > iqserver )
then
139 iquilt_group = iqserver
140 print *,
' ***** NOT ENOUGH SERVERS'
141 print *,
' ***** WE NEED TO REDUCE THE NUMB OF SERVER GROUPS'
142 print *,
' ***** NUMB OF SERVER GROUPS IS ', iquilt_group
158 if ( mype < npes_mod )
then
163 iendxx = istaxx + inumq - 1
164 if ( mype >= istaxx .and. mype <= iendxx )
then
176 call mpi_comm_dup(mpi_comm_world,comdup,ierr)
177 call mpi_comm_split(comdup,icolor,mype,mpi_comm_comp,ierr)
190 allocate ( irank( iqserver ) )
192 do i = 1, iquilt_group
194 if ( mype < npes_mod )
then
202 do jj = 1, iquilt_group
208 if ( mype == issl ) yes = .false.
222 iworld = mpi_comm_world
223 call mpi_comm_group(iworld,igroup,ierr)
224 call mpi_group_excl(igroup,icc,irank,igroup_x,ierr)
225 call mpi_comm_create(iworld,igroup_x,iworld_minus,ierr)
226 call mpi_group_free(igroup,ierr)
227 call mpi_group_free(igroup_x,ierr)
240 call mpi_intercomm_create(mpi_comm_comp,0,iworld_minus,irlr,0, &
244 call mpi_barrier(mpi_comm_world,ierr)
251 npes = npes - iqserver
252 print *,
'mype=',mype,
'npes_new=',npes
255 print *,
' The Posting is using ',npes,
' MPI task'
256 print *,
' There are ',iqserver,
' I/O servers'