1 |
guez |
3 |
|
2 |
guez |
81 |
! $Header: /home/cvsroot/LMDZ4/libf/bibio/formcoord.F,v 1.1.1.1 2004/05/19 |
3 |
|
|
! 12:53:05 lmdzadmin Exp $ |
4 |
guez |
3 |
|
5 |
guez |
81 |
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 |
guez |
3 |
|
12 |
guez |
81 |
INTEGER i, id, i1, i2, in |
13 |
|
|
REAL dx, dxmin |
14 |
guez |
3 |
|
15 |
guez |
81 |
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 |
guez |
3 |
|
28 |
guez |
81 |
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 |
guez |
3 |
|
38 |
guez |
81 |
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 |