psmile_io_derive_pelist.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, SGI Germany, Munich, Germany.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 ! !ROUTINE: PSMILE_IO_Derive_Pelist
00007 !
00008 ! !INTERFACE:
00009 !
00010 subroutine psmile_io_derive_pelist(id_comm_appl,id_comp_id,  &
00011                                    comp_info, pelist,ierror)
00012 !
00013 ! !USES:
00014 
00015       USE PSMILe, dummy_interface =>  psmile_io_derive_pelist
00016       implicit none
00017 !
00018 ! !INPUT PARAMETERS:
00019 
00020       Integer,Intent(In)                  :: id_comm_appl
00021       integer, Intent (In)                :: id_comp_id
00022       Type (Enddef_comp), Intent (In)     :: comp_info
00023 !
00024 ! !OUTPUT PARAMETERS:
00025 
00026       Integer,Intent(Out):: pelist(*)
00027       Integer,Intent(Out):: ierror
00028 !
00029 ! !LOCAL VARIABLES
00030 
00031       Integer,allocatable::comp_grp_ranks(:)
00032       Integer,allocatable::appl_grp_ranks(:)
00033       Integer::appl_grp,comp_grp,comp_grp_size
00034       Integer::ierrp(2)
00035       Integer::i,  irank
00036 !
00037 ! !DESCRIPTION:
00038 ! This routine derives a list of ranks (pelist) owned by a component.
00039 ! The mapping of the ranks is within the ranks of the application
00040 ! communicator.
00041 ! So, a valid application communicator and a component communicator is needed.
00042 ! This is only way - via lists of ranks _ to tell the mpp package on which
00043 ! component it should work.
00044 !
00045 ! !REVISION HISTORY:
00046 !
00047 !   Date      Programmer    Description
00048 ! ----------  -----------   -----------
00049 ! 10.31.2003  R.Vogelsang   created
00050 ! 19.08.2010  J. Latour      get pelist from information in comp_info strucutre
00051 !
00052 !EOP
00053 !------------------------------------------------------------------------------
00054    Character(len=len_cvs_string), save :: mycvs = 
00055    '$Id: psmile_io_derive_pelist.F90 2719 2010-11-10 14:37:21Z valcke $'
00056 
00057       ierror=0
00058 #ifdef __PSMILE_WITH_IO
00059 !     
00060 !     Get the group of the application
00061 !
00062       call MPI_Comm_group(id_comm_appl,appl_grp,ierror)
00063 
00064       if ( appl_grp.eq.MPI_GROUP_EMPTY.or.ierror.ne.MPI_SUCCESS) then
00065          call psmile_error(ierror,'MPI_Comm_group', &
00066                            ierrp,0, __FILE__, __LINE__)
00067       endif
00068 !
00069 !     Get the group of the component and its size
00070 !
00071       call MPI_Comm_group(Comps(id_comp_id)%comm,comp_grp,ierror)
00072       call MPI_Comm_rank(Comps(id_comp_id)%comm,i,ierror)
00073 
00074       if ( comp_grp.eq.MPI_GROUP_EMPTY.or.ierror.ne.MPI_SUCCESS) then
00075          call psmile_error(ierror,'MPI_Comm_group', &
00076                            ierrp,0, __FILE__, __LINE__)
00077       endif
00078 
00079       call MPI_Group_size(comp_grp,comp_grp_size,ierror)
00080 
00081       if(Comps(id_comp_id)%size.ne.comp_grp_size.or.ierror.ne.MPI_SUCCESS) then
00082         call psmile_flushstd()
00083         call psmile_assert ( __FILE__, __LINE__, &
00084                              "Group size non equal to component size  ")
00085       endif
00086 !
00087 !     Remap the ranks 0 up to comp_grp_size-1 back onto the ranks 
00088 !     of the application (translate ranks of one group into another group)
00089 !
00090       
00091       Allocate(comp_grp_ranks(0:comp_grp_size-1),STAT=ierror)
00092       Allocate(appl_grp_ranks(1:comp_grp_size),STAT=ierror)
00093 
00094       if(ierror.ne.0)then
00095          call psmile_error(ierror,'Allocate', &
00096                            ierrp,0, __FILE__, __LINE__)
00097       endif
00098 
00099       comp_grp_ranks=(/(i-1,i=1,comp_grp_size)/)
00100 
00101       call MPI_Group_translate_ranks(comp_grp,comp_grp_size,comp_grp_ranks &
00102                                    ,appl_grp,appl_grp_ranks,ierror)
00103 !
00104 !     extract pelist values from grids_vector nonzero values
00105 !
00106       irank = 0
00107       do i = 1, comp_grp_size
00108          if (comp_info%Number_of_grids_vector(i) .ne. 0 ) then
00109             irank = irank + 1
00110             pelist(irank) = appl_grp_ranks(i)
00111          endif
00112       enddo
00113 
00114 #ifdef DEBUG
00115       print*, 'In PSMILE_IO_derive_pelist'
00116       PRINT*, 'comp_grp_size,pelist(1:irank):',comp_grp_size,pelist(1:irank)
00117       call psmile_flushstd()
00118 #endif
00119       if(ierror.ne.MPI_SUCCESS) then
00120          call psmile_error(ierror,'MPI_Comm_group_translate_ranks', &
00121                            ierrp,0, __FILE__, __LINE__)
00122       endif
00123       
00124       Deallocate(comp_grp_ranks)
00125       Deallocate(appl_grp_ranks)
00126        
00127 #endif  /*  __PSMILE_WITH_IO  */
00128       
00129 end subroutine  psmile_io_derive_pelist