trunk/bibio/formcoord.f


! $Header: /home/cvsroot/LMDZ4/libf/bibio/formcoord.F,v 1.1.1.1 2004/05/19
! 12:53:05 lmdzadmin Exp $

SUBROUTINE formcoord(unit, n, x, a, rev, text)
  IMPLICIT NONE
  INTEGER n, unit, ndec
  LOGICAL rev
  REAL x(n), a
  CHARACTER *4 text

  INTEGER i, id, i1, i2, in
  REAL dx, dxmin

  IF (rev) THEN
    id = -1
    i1 = n
    i2 = n - 1
    in = 1
    WRITE (unit, 3000) text(1:1)
  ELSE
    id = 1
    i1 = 1
    i2 = 2
    in = n
  END IF

  IF (n<2) THEN
    ndec = 1
    WRITE (unit, 1000) text, n, x(1)*a
  ELSE
    dxmin = abs(x(2)-x(1))
    DO i = 2, n - 1
      dx = abs(x(i+1)-x(i))
      IF (dx<dxmin) dxmin = dx
    END DO

    ndec = -log10(dxmin) + 2
    IF (mod(n,6)==1) THEN
      WRITE (unit, 1000) text, n, x(i1)*a
      WRITE (unit, 2000)(x(i)*a, i=i2, in, id)
    ELSE
      WRITE (unit, 1000) text, n
      WRITE (unit, 2000)(x(i)*a, i=i1, in, id)
    END IF
  END IF

1000 FORMAT (A4, 2X, I4, ' LEVELS', 43X, F12.2)
2000 FORMAT (6F12.2)
  ! 1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
  ! 2000  format(6f12.<ndec>)
3000 FORMAT ('FORMAT ', A1, 'REV')
  RETURN

END SUBROUTINE formcoord
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