00001 !----------------------------------------------------------------------- 00002 ! Copyright 2006-2010, CERFACS, Toulouse, France. 00003 ! Copyright 2006-2010, SGI Germany, Munich, Germany. 00004 ! Copyright 2006-2010, NEC Europe Ltd., London, UK. 00005 ! Copyright 2006-2010, Centre National de la Recherche Scientifique, Paris, France. 00006 ! All rights reserved. Use is subject to OASIS4 license terms. 00007 !----------------------------------------------------------------------- 00008 !BOP 00009 ! 00010 ! !ROUTINE: PRISM_Get_nb_ranklists 00011 ! 00012 ! !INTERFACE: 00013 00014 subroutine prism_get_nb_ranklists ( comp_name, nb_ranklists, ierror ) 00015 ! 00016 ! !USES: 00017 ! 00018 use PRISM, dummy_interface => PRISM_Get_nb_ranklists 00019 ! 00020 use PSMILe 00021 use PSMILe_SCC 00022 implicit none 00023 00024 ! 00025 ! !INPUT PARAMETERS: 00026 ! 00027 character(len=*), Intent (In) :: comp_name 00028 00029 ! 00030 ! !OUTPUT PARAMETERS: 00031 ! 00032 integer, Intent (Out) :: nb_ranklists 00033 00034 ! Number of rank lists 00035 00036 integer, Intent (Out) :: ierror 00037 00038 ! Returns the error code of prism_get_nb_ranklists; 00039 ! ierror = 0 : No error 00040 ! ierror > 0 : Severe error 00041 ! 00042 ! !LOCAL VARIABLES 00043 ! 00044 Integer :: i 00045 ! 00046 ! !DESCRIPTION: 00047 ! 00048 ! Subroutine "prism_get_nb_ranklists" gives the number of rank lists set 00049 ! for the component in the scc file. 00050 ! 00051 ! !REVISION HISTORY: 00052 ! Date Programmer Description 00053 ! ---------- ---------- ----------- 00054 ! 23.08.04 D. Declat created 00055 ! 00056 !EOP 00057 !---------------------------------------------------------------------- 00058 ! 00059 ! $Id: prism_get_nb_ranklists.F90 2325 2010-04-21 15:00:07Z valcke $ 00060 ! $Author: valcke $ 00061 ! 00062 Character(len=len_cvs_string), save :: mycvs = 00063 '$Id: prism_get_nb_ranklists.F90 2325 2010-04-21 15:00:07Z valcke $' 00064 ! 00065 !---------------------------------------------------------------------- 00066 #ifdef VERBOSE 00067 print *, trim(ch_id), ': prism_get_nb_ranklists' 00068 call psmile_flushstd 00069 #endif /* VERBOSE */ 00070 00071 !----------------------------------------------------------------------- 00072 ! 1st Initialization 00073 !----------------------------------------------------------------------- 00074 00075 ierror = 0 00076 00077 !----------------------------------------------------------------------- 00078 ! 2nd get the info from the psmile info structure 00079 !----------------------------------------------------------------------- 00080 00081 do i = 1, noComponents 00082 if ( trim(comp_name) == trim(PRISM_compName(i)) ) then 00083 nb_ranklists = PRISM_compRankSets(i) 00084 exit 00085 endif 00086 enddo 00087 00088 #ifdef VERBOSE 00089 print *, trim(ch_id), ': prism_get_nb_ranklists: eof ierror ', ierror 00090 call psmile_flushstd 00091 #endif /* VERBOSE */ 00092 ! 00093 end subroutine prism_get_nb_ranklists
1.6.1