prism_get_ranklists.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! Copyright 2006-2010, SGI Germany, Munich, Germany.
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! Copyright 2006-2010, Centre National de la Recherche Scientifique, Paris, France.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PRISM_Get_ranklists
!
! !INTERFACE:

   subroutine prism_get_ranklists ( comp_name, nb_ranklists, ranklists, ierror )
!
! !USES:
!
      use PRISM, dummy_interface => PRISM_Get_ranklists
!
      use PSMILe_SCC
      use PSMILe
      implicit none

!
! !INPUT PARAMETERS:
!
      character(len=*), Intent (In)                    :: comp_name

      integer, Intent (In)                             :: nb_ranklists

!
! !OUTPUT PARAMETERS:
!
      integer, Dimension(nb_ranklists,3), Intent (Out) :: ranklists

!     Number of rank lists

      integer, Intent (Out)                            :: ierror

!     Returns the error code of prism_get_ranklists;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
  Integer :: begin_ranklists, end_ranklists

  Integer :: index

  Integer, Parameter :: nerrp = 2
  Integer            :: ierrp(nerrp)
!
! !DESCRIPTION:
!
!    Subroutine "prism_get_ranklists" gives the rank lists set
!    for the component in the scc file.
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 23.08.04    D. Declat    created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: prism_get_ranklists.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
  Character(len=len_cvs_string), save :: mycvs = 
      '$Id: prism_get_ranklists.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
#ifdef VERBOSE
      print *, trim(ch_id), ': prism_get_ranklists'
      call psmile_flushstd
#endif /* VERBOSE */

!-----------------------------------------------------------------------
! 1st Initialization
!-----------------------------------------------------------------------

      ierror = 0

!-----------------------------------------------------------------------
! 2nd get the info from the psmile info structure
!-----------------------------------------------------------------------
      
      do index = 1, noComponents
         if ( trim(comp_name) == trim(PRISM_compName(index)) ) then
            exit
         endif
      enddo

      begin_ranklists = sum(PRISM_compRankSets(1:index-1))+1
      end_ranklists = begin_ranklists-1+PRISM_compRankSets(index)
      ranklists = PRISM_rankSets(begin_ranklists:end_ranklists,1:3)

      if ( ( end_ranklists - begin_ranklists + 1 ) > nb_ranklists ) then

         ierrp(1) = nb_ranklists
         ierrp(2) = end_ranklists - begin_ranklists + 1

         call psmile_error ( PRISM_Error_Parameter, 'Sizes of ranklists do not match', &
              ierrp, nerrp, __FILE__, __LINE__ )
      endif

#ifdef VERBOSE
      print *, trim(ch_id), ': prism_get_ranklists: eof ierror ', ierror
      call psmile_flushstd
#endif /* VERBOSE */
!
   end subroutine prism_get_ranklists