SUBROUTINE SETUP_SERVERS(NPES_MOD,
* MYPE,
* NPES,
* IQUILT_GROUP,
* INUMQ,
* MPI_COMM_COMP,
* MPI_COMM_INTER,
* MPI_COMM_INTER_ARRAY )
C
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . .
C SUBROUTINE: SETUP_SERVERS SETUP I/O SERVERS
C PRGRMMR: TUCCILLO ORG: IBM DATE: 00-03-20
C
C ABSTRACT: SETUP I/O SERVERS
C
C PROGRAM HISTORY LOG:
C 00-03-11 TUCCILLO - ORIGINATOR
C
C USAGE: CALL SETUP_SERVERS(NPES_MOD,
C * MYPE,
C * NPES,
C * IQUILT_GROUP,
C * INUMQ,
C * MPI_COMM_COMP,
C * MPI_COMM_INTER,
C * MPI_COMM_INTER_ARRAY )
C
C INPUT ARGUMENT LIST:
C NPES_MOD - NUMBER OF MPI TASKS FOR MODEL INTEGRATION FROM INPES AND JNPES
C THIS IS THE NUMBER OF MPI TASKS THE EXECUTABLE HAS BEEN BUILT FOR.
C NPES, RETURNED FROM MPI_COMM_SIZE, MUST BE AT LEAST THIS SIZE
C OTHERWISE THE INTEGRATION CANNOT PROCEED. THE DIFFERENCE BETWEEN
C NPES_MOD AND NPES IS THE NUMBER OF MPI TASKS THAT ARE AVAILABLE
C FOR I/O SERVING. THIS CAN BE ZERO, IN WHICH CASE CHKOUT WILL
C WRITE A DIRECT ACCESS FILE THAT CAN BE SEPARTELY "QUILTED".
C IN ORDER TO SKIP THE SEPARATE QUILTING STEP, MAKE SURE THAT
C THE NUMBER OF MPI TASKS THAT THE CODE IS INITIATED WITH IS AT
C LEAST ONE GREATER THAN NPES_MOD.
C
C OUTPUT ARGUMENT LIST:
C NPES - NUMBER OF MPI TASKS FOR MODEL INTEGRATION
C MYPE - MY RANK
C IQUILT_GROUP - NUMBER OF I/O SERVER GROUPS
C INUMQ - ARRAY THAT HOLDS THE NUMBER OF SERVERS IN EACH GROUP
C NPES - NUMBER OF MPI TASKS FOR MODEL INTEGRATION
C MPI_COMM_COMP - THE NEW INTRACOMMUNICATOR FOR ALL TASKS
C MPI_COMM_INTER - THE INTERCOMMUNICATOR FOR THE I/O SERVERS
C MPI_COMM_INTER_ARRAY - THE ARRAY OF INTERCOMMUNICATORS FOR THE INTEGRATION TASKS
C
C INPUT FILES: NONE
C
C OUTPUT FILES:
C NONE BUT THE CODE DOES ATTEMPT TO READ THE ENVIRONMENT VARIABLE "SERVER_GROUPS".
C THIS IS THE NUMBER OF INDEPENDENT GROUPS OF SERVER TASKS. THE DEFAULT IS ONE
C AND SHOULD BE OK FOR MOST APPLICATIONS OF THE ETA CODE. IF ONE SET OF I/O
C SERVERS CAN NOT COMPLETE BEFORE THE NEXT OUPUT TIME THEN ADDITIONAL I/O SERVER
C GROUPS WOULD BE USEFUL.
C
C SUBPROGRAMS CALLED:
C UNIQUE:
C PARA_RANGE
C MPI_INIT
C MPI_COMM_RANK
C MPI_COMM_SIZE
C MPI_COMM_DUP
C MPI_COMM_SPLIT
C MPI_COMM_GROUP
C MPI_GROUP_EXCL
C MPI_COMM_CREATE
C MPI_GROUP_FREE
C MPI_INTERCOMM_CREATE
C MPI_BARRIER
C
C EXIT STATES:
C COND = 0 - NORMAL EXIT
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE : IBM SP
C
C$$$
include 'mpif.h'
integer comdup
integer, allocatable :: irank ( : )
integer MPI_COMM_INTER_ARRAY(*), INUMQ(*)
logical yes
character*4 get
C-----------------------------------------------------------------------
C
C INITIALIZE MPI
C RETRIEVE THE NUMBER OF TOTAL MPI TASKS AND MY RANK
C
call mpi_init(ierr)
call mpi_comm_rank(MPI_COMM_WORLD,mype,ierr)
call mpi_comm_size(MPI_COMM_WORLD,npes,ierr)
C
C AT THIS POINT NPES IS THE TOTAL NUMBER OF MPI TASKS. WE WILL
C RESET THIS AT THE END OF THE SUBROUTINE TO THE NUMBER OF MPI
C TASKS THAT ARE WORKING ON THE MODEL INTGRATION.
C
C FIRST, HOWEVER, WE NEED TO MAKE SURE THAT A SUFFICIENT NUMBER
C OF MPI TASKS HAVE BEEN INITIATED. IF NOT, WE WILL STOP.
C
IF ( NPES .LT. NPES_MOD ) THEN
PRINT *, ' ***********************************************'
PRINT *, ' ***********************************************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *
PRINT *, ' THERE ARE INSUFFICIENT MPI TASKS TO CONTINUE'
PRINT *, ' YOU MUST SPECIFY AT LEAST ',NPES_MOD,' TASKS'
PRINT *, ' STOPPING NOW'
PRINT *, ' HASTA LA VISTA BABY'
PRINT *
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' *************MAJOR PROBLEM*********************'
PRINT *, ' ***********************************************'
PRINT *, ' ***********************************************'
CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
END IF
C
C OK, WE HAVE A SUFFICIENT NUMBER OF MPI TASKS TO CONTINUE
C
C HOW MANY GROUPS OF SERVERS ? THE DEFAULT IS 1 GROUP
C THE ENVIRONMENT VARIABLE, SERVER_GROUPS, CAN BE USED TO
C SPECIFY MORE SERVER GROUPS
C
get = '1'
call get_environment_variable('SERVER_GROUPS',get)
read(get,fmt='(i4)') iquilt_group
iquilt_group = max(iquilt_group,1)
C
C ERROR CHECK NUMBER OF GROUPS - THE MAXIMUM IS 100 - THIS IS A LOT
C
if ( iquilt_group .gt. 100 ) then
print *, ' ***** IQUILT_GROUP IS GREATER THAN 100'
print *, ' ***** DO YOU REALLY WANT THIS ?'
print *, ' ***** IF SO THEN INCREASE SIZE IN mpp.h'
print *, ' ***** ALSO, CHANGE IF CHECK IN SETUP_SERVERS'
print *, ' ***** RESETTING THE NUMBER OF SERVER GROUPS TO 100'
print *, ' ***** WE ARE CONTINUING .... '
iquilt_group = 100
end if
if ( mype .eq. 0 ) then
print *, ' we will try to run with ',iquilt_group,' server groups'
end if
C
C COMPUTE THE NUMBER OF SERVERS PER GROUP
C ALL MPI TASKS BEYOND NPES_MOD WILL BE SERVERS
C IF THE NUMBER OF SERVERS IS NOT EQUALLY DIVISIBLE BY
C THE NUMBER OF GROUPS OF SERVERS THEN SOME GROUPS MAY HAVE
C MORE SERVERS THEN OTHERS - THIS IS FINE
C NOTE THAT WE REQUIRE AT LEAST ONE SERVER PER GROUP
C WE MAY NEED TO REDUCE THE NUMBER OF SERVER GROUPS IF
C IT EXCEEDS THE NUMBER OF SERVERS
C
iqserver = NPES - NPES_MOD
if ( iqserver .eq. 0 ) then
if ( mype .eq. 0 ) then
print *, ' *** you specified 0 I/O servers '
print *, ' CHKOUT will write a file'
end if
iquilt_group = 0
end if
if ( iquilt_group .gt. iqserver ) then
iquilt_group = iqserver
print *, ' ***** NOT ENOUGH SERVERS'
print *, ' ***** WE NEED TO REDUCE THE NUMB OF SERVER GROUPS'
print *, ' ***** NUMB OF SERVER GROUPS IS ', iquilt_group
end if
do i = 0, iquilt_group - 1
call para_range(1,iqserver,iquilt_group,i,istaq,iendq)
inumq(i+1) = iendq-istaq+1
if ( mype .eq. 0 ) print *, ' i, inumq = ',i+1,inumq(i+1)
end do
C
C SETUP THE "COLOR" FOR MPI_COMM_SPLIT
C THOSE TASKS WHICH WILL DO MODEL INTEGRATION WILL BE COLOR 0
C THE SERVER TASKS WILL HAVE THE COLOR OF THE GROUP NUMBER THAT
C THEY WILL BELONG
C
if ( mype .lt. NPES_MOD ) then
icolor = 0
else
istaxx = NPES_MOD
do i = 1, iquilt_group
iendxx = istaxx + inumq(i) - 1
if ( mype .ge. istaxx .and. mype .le. iendxx ) then
icolor = i
end if
istaxx = iendxx + 1
end do
end if
C
C SPLIT THE COMMUNICATOR - THE NEW INTRACOMMUNICATOR FOR ALL TASKS
C IS MPI_COMM_COMP. MPI_COMM_WORLD IS STILL AVAILABLE BUT IT DOES
C REFER TO ALL THE MPI TASKS ( MODEL INTEGRATION AND I/O SERVING )
C
call mpi_comm_dup(MPI_COMM_WORLD,comdup,ierr)
call mpi_comm_split(comdup,icolor,mype,mpi_comm_comp,ierr)
C
C AT THIS POINT WE HAVE A NEW COMMUNICATOR, MPI_COMM_COMP,
C THAT CAN BE USED BY THE FORECASTS TASKS AND THE I/O SERVER TASKS
C FOR THEIR INTERNAL COMMUNICATIONS. ONTO THE INTERCOMMUNICATORS ...
C
C NOW WE MUST CREATE THE INTERCOMMUNICATORS FOR USE BETWEEN THE MPI
C TASKS DOING THE MODEL INTEGRATION AND THE MPI TASKS FOR EACH
C SERVER GROUP. THE FIRST STEP IS TO EXCLUDE THE TASKS THAT DONT
C BELONG. WE WILL DO THIS FOR EACH SERVER GROUP BY EXCLUDING THE TASKS
C FROM ALL OF THE OTHER SERVER GROUPS.
C
allocate ( irank ( iqserver ) )
ixx = NPES_MOD
do i = 1, iquilt_group
yes = .true.
if ( mype .lt. NPES_MOD ) then
irlr = ixx
else
irlr = 0
end if
icc = 0
iss = NPES_MOD
C THIS IS THE FIRST POSSIBLE TASK ID THAT COULD BE EXCLUDED
do jj = 1, iquilt_group
if ( jj .ne. i ) then
issl = iss
do kk = 1, inumq(jj)
icc = icc + 1
irank(icc)= issl
if ( mype .eq. issl ) yes = .false.
issl = issl + 1
end do
end if
iss = iss + inumq(jj)
end do
C
C AT THIS POINT WE HAVE AN ARRAY, IRANK, WITH TASK IDS TO EXCLUDE
C THERE ARE ICC OF THEM.
C CREATE A NEW GROUP WITH THE TASKS FROM THE OTHER SERVER GROUPS
C EXCLUDED AND THEN CREATE A NEW COMMUNICATOR ( IWORLD_MINUS ) THAT
C CONTAINS ONLY THE MPI TASKS DOING THE MODEL INTEGRATION AND THE
C TASKS THAT BLONG TO THE SERVER GROUP WE ARE CONSIDERING.
C
iworld = MPI_COMM_WORLD
call mpi_comm_group(iworld,igroup,ierr)
call mpi_group_excl(igroup,icc,irank,igroup_x,ierr)
call mpi_comm_create(iworld,igroup_x,iworld_minus,ierr)
call mpi_group_free(igroup,ierr)
call mpi_group_free(igroup_x,ierr)
C
C AT THIS POINT WE HAVE A COMMUNICATOR THAT EXCLUDES THE TASKS WE DONT WANT.
C CREATE AN INTERCOMMUNICATOR FOR USE BETWEEN THE MPI TASKS DOING THE MODEL
C INTEGRATION AND THE I/O SERVER GROUP WE ARE CONSIDERING. THIS PROCESS IS
C A COLLECTIVE ROUTINE SO IT CAN ONLY BE DONE BY THE TASKS THAT HAVE NOT
C BEEN EXCLUDED. SAVE THIS NEW COMMUNICATOR IN MPI_COMM_INTER FOR USE BY
C THE TASKS THAT BELONG TO THE SERVER GROUP THAT WE ARE CONSIDERING. THE
C TASKS THAT ARE PERFORMING THE MODEL INTEGRATION WILL REFERENCE
C MPI_COMM_INTER_ARRAY() SINCE WE WILL NEED TO SELECT WHICH SERVER
C GROUP WE WISH TO COMMUNICATE WITH.
c
if ( yes ) then
call mpi_intercomm_create(mpi_comm_comp,0,iworld_minus,irlr,0,
* mpi_comm_inter_array(i),ierr)
mpi_comm_inter = mpi_comm_inter_array(i)
end if
C
call mpi_barrier(MPI_COMM_WORLD,ierr)
C
end do ! end do for loop over the number of server groups
C
C***
C*** NPES IS REALLY THE NUMBER OF TASKS WORKING ON THE MODEL INTEGRATION
C***
NPES = NPES - IQSERVER
C
IF(MYPE.EQ.0) THEN
print *, ' The Model integration is using ',npes,' MPI task'
print *, ' There are ',iqserver,' I/O servers'
END IF
C***
deallocate ( irank )
C
END