| 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 |
Parent Directory
| 
Revision Log