GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: misc/formcoord.F Lines: 0 12 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 26 0.0 %

Line Branch Exec Source
1
!
2
! $Header$
3
!
4
      subroutine formcoord(unit,n,x,a,rev,text)
5
      implicit none
6
      integer n,unit,ndec
7
      logical rev
8
      real x(n),a
9
      character*4 text
10
11
      integer i,id,i1,i2,in
12
      real dx,dxmin
13
14
      if(rev) then
15
         id=-1
16
         i1=n
17
         i2=n-1
18
         in=1
19
         write(unit,3000) text(1:1)
20
      else
21
         id=1
22
         i1=1
23
         i2=2
24
         in=n
25
      endif
26
27
      if (n.lt.2) then
28
         ndec=1
29
         write(unit,1000) text,n,x(1)*a
30
      else
31
         dxmin=abs(x(2)-x(1))
32
         do i=2,n-1
33
            dx=abs(x(i+1)-x(i))
34
            if (dx.lt.dxmin) dxmin=dx
35
         enddo
36
37
         ndec=-log10(dxmin)+2
38
         if(mod(n,6).eq.1) then
39
            write(unit,1000) text,n,x(i1)*a
40
            write(unit,2000) (x(i)*a,i=i2,in,id)
41
         else
42
            write(unit,1000) text,n
43
            write(unit,2000) (x(i)*a,i=i1,in,id)
44
         endif
45
      endif
46
47
1000  format(a4,2x,i4,' LEVELS',43x,f12.2)
48
2000  format(6f12.2)
49
c1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
50
c2000  format(6f12.<ndec>)
51
3000  format('FORMAT ',a1,'REV')
52
      return
53
54
      end