xref: /phasta/phSolver/common/cname.f (revision 16223cb9c3f88b34f2cb94151b5cf5ffc1aac5e2)
1      function cname (i)
2
3      logical beg
4      CHARACTER*5 cname,cc
5
6      ic0 = ICHAR("0")
7      cc = " "
8      ii = i
9
10      i0 = mod (ii,10)
11      ii = (ii - i0) / 10
12      i1 = mod (ii,10)
13      ii = (ii - i1) / 10
14      i2 = mod (ii,10)
15      ii = (ii - i2) / 10
16      i3 = mod (ii,10)
17
18      beg = .false.
19
20      IF (i3 .ne. 0) then
21        beg = .true.
22        cc  = CHAR(ic0 + i3)
23      ENDIF
24      IF (i2 .ne. 0 .or. beg) then
25        beg = .true.
26        cc = TRIM(cc)//CHAR(ic0 + i2)
27      ENDIF
28      IF (i1 .ne. 0 .or. beg) then
29        beg = .true.
30        cc = TRIM(cc)//CHAR(ic0 + i1)
31      ENDIF
32
33      cc = TRIM(cc)//CHAR(ic0 + i0)
34      cname = "." // cc
35
36      return
37      end
38
39
40      function cname2 (i)
41
42      logical      beg
43      character*10 cname2,cc
44      integer      il(0:8)
45
46      ic0 = ICHAR("0")
47      cc = " "
48      ii = i
49
50      il(0) = mod(ii,10)
51      do k = 1,8
52        ii = (ii - il(k-1)) / 10
53        il(k) = mod (ii,10)
54      enddo
55
56      beg = .false.
57
58      do k = 8,1,-1
59        if (il(k) .ne. 0 .or. beg) then
60          beg = .true.
61          cc  = TRIM(cc) // CHAR(ic0 + il(k))
62        endif
63      enddo
64
65      cc = TRIM(cc)//CHAR(ic0 + il(0))
66      cname2 = "." // cc
67
68      return
69      end
70