1 |
|
2 |
! $Header: /home/cvsroot/LMDZ4/libf/bibio/formcoord.F,v 1.1.1.1 2004/05/19 |
3 |
! 12:53:05 lmdzadmin Exp $ |
4 |
|
5 |
SUBROUTINE formcoord(unit, n, x, a, rev, text) |
6 |
IMPLICIT NONE |
7 |
INTEGER n, unit, ndec |
8 |
LOGICAL rev |
9 |
REAL x(n), a |
10 |
CHARACTER *4 text |
11 |
|
12 |
INTEGER i, id, i1, i2, in |
13 |
REAL dx, dxmin |
14 |
|
15 |
IF (rev) THEN |
16 |
id = -1 |
17 |
i1 = n |
18 |
i2 = n - 1 |
19 |
in = 1 |
20 |
WRITE (unit, 3000) text(1:1) |
21 |
ELSE |
22 |
id = 1 |
23 |
i1 = 1 |
24 |
i2 = 2 |
25 |
in = n |
26 |
END IF |
27 |
|
28 |
IF (n<2) THEN |
29 |
ndec = 1 |
30 |
WRITE (unit, 1000) text, n, x(1)*a |
31 |
ELSE |
32 |
dxmin = abs(x(2)-x(1)) |
33 |
DO i = 2, n - 1 |
34 |
dx = abs(x(i+1)-x(i)) |
35 |
IF (dx<dxmin) dxmin = dx |
36 |
END DO |
37 |
|
38 |
ndec = -log10(dxmin) + 2 |
39 |
IF (mod(n,6)==1) THEN |
40 |
WRITE (unit, 1000) text, n, x(i1)*a |
41 |
WRITE (unit, 2000)(x(i)*a, i=i2, in, id) |
42 |
ELSE |
43 |
WRITE (unit, 1000) text, n |
44 |
WRITE (unit, 2000)(x(i)*a, i=i1, in, id) |
45 |
END IF |
46 |
END IF |
47 |
|
48 |
1000 FORMAT (A4, 2X, I4, ' LEVELS', 43X, F12.2) |
49 |
2000 FORMAT (6F12.2) |
50 |
! 1000 format(a4,2x,i4,' LEVELS',43x,f12.<ndec>) |
51 |
! 2000 format(6f12.<ndec>) |
52 |
3000 FORMAT ('FORMAT ', A1, 'REV') |
53 |
RETURN |
54 |
|
55 |
END SUBROUTINE formcoord |