Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
MakeNumberedKeys.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 !******************************************************************************
24 !
25 ! Purpose: Fills in a section of an array of strings with an input string
26 ! appended by a sequence of numbers.
27 !
28 ! Description:
29 !
30 ! Input: indBegin: first element of keys to write to
31 ! string: string to append numbers to
32 ! numBegin, numEnd, numSkip: DO loop specification of numbers to append
33 !
34 ! Output: keys: the array of strings with numbers appended
35 !
36 ! Notes: indBegin addresses keys as if it started at 1.
37 ! Does not check to see if strings written to are long enough.
38 ! Numbers appended must be between 0 and 10^7 - 1, inclusive.
39 !
40 !******************************************************************************
41 !
42 ! $Id: MakeNumberedKeys.F90,v 1.3 2008/12/06 08:44:09 mtcampbe Exp $
43 !
44 ! Copyright: (c) 2003 by the University of Illinois
45 !
46 !******************************************************************************
47 
48 SUBROUTINE makenumberedkeys(keys,indBegin,string,numBegin,numEnd,numSkip)
49 
50  IMPLICIT NONE
51 
52 ! ... parameters
53  CHARACTER(*) :: keys(:)
54  CHARACTER(*), INTENT(in) :: string
55  INTEGER, INTENT(in) :: indbegin,numbegin,numend,numskip
56 
57 ! ... loop variables
58  INTEGER :: num
59 
60 ! ... local variables
61  INTEGER :: nkeys, ikeys, skip
62 
63 !******************************************************************************
64 
65  nkeys = ubound(keys,1)
66 
67  ikeys = indbegin
68 
69  skip = numskip
70  IF (skip == 0) skip = 1
71 
72  DO num = numbegin,numend,skip
73 
74  IF (ikeys > nkeys) EXIT
75 
76  IF (ikeys > 0) THEN
77 
78  SELECT CASE (num)
79 
80  CASE ( 0: 9)
81  WRITE(keys(ikeys),'(A,I1)') trim(string), num
82 
83  CASE ( 10: 99)
84  WRITE(keys(ikeys),'(A,I2)') trim(string), num
85 
86  CASE ( 100: 999)
87  WRITE(keys(ikeys),'(A,I3)') trim(string), num
88 
89  CASE ( 1000: 9999)
90  WRITE(keys(ikeys),'(A,I4)') trim(string), num
91 
92  CASE ( 10000: 99999)
93  WRITE(keys(ikeys),'(A,I5)') trim(string), num
94 
95  CASE ( 100000: 999999)
96  WRITE(keys(ikeys),'(A,I6)') trim(string), num
97 
98  CASE (1000000:9999999)
99  WRITE(keys(ikeys),'(A,I7)') trim(string), num
100 
101  CASE default
102  WRITE(keys(ikeys),'(A)') trim(string)
103 
104  END SELECT ! num
105 
106  END IF ! iKeys
107 
108  ikeys = ikeys + 1
109 
110  END DO ! num
111 
112 END SUBROUTINE makenumberedkeys
113 
114 !******************************************************************************
115 !
116 ! RCS Revision history:
117 !
118 ! $Log: MakeNumberedKeys.F90,v $
119 ! Revision 1.3 2008/12/06 08:44:09 mtcampbe
120 ! Updated license.
121 !
122 ! Revision 1.2 2008/11/19 22:17:22 mtcampbe
123 ! Added Illinois Open Source License/Copyright
124 !
125 ! Revision 1.1 2004/12/01 16:48:45 haselbac
126 ! Initial revision after changing case
127 !
128 ! Revision 1.1 2003/02/11 22:52:50 jferry
129 ! Initial import of Rocsmoke
130 !
131 !
132 !******************************************************************************
133 
134 
135 
136 
137 
138 
subroutine makenumberedkeys(keys, indBegin, string, numBegin, numEnd, numSkip)
static const char * string()
Definition: CImg.h:2085