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