| 1 | MODULE lmdz_formcoord |
|---|
| 2 | IMPLICIT NONE; PRIVATE |
|---|
| 3 | PUBLIC formcoord |
|---|
| 4 | CONTAINS |
|---|
| 5 | |
|---|
| 6 | SUBROUTINE formcoord(unit, n, x, a, rev, text) |
|---|
| 7 | IMPLICIT NONE |
|---|
| 8 | INTEGER :: n, unit, ndec |
|---|
| 9 | LOGICAL :: rev |
|---|
| 10 | REAL :: x(n), a |
|---|
| 11 | CHARACTER(LEN = 4) :: text |
|---|
| 12 | |
|---|
| 13 | INTEGER :: i, id, i1, i2, in |
|---|
| 14 | REAL :: dx, dxmin |
|---|
| 15 | |
|---|
| 16 | IF(rev) THEN |
|---|
| 17 | id = -1 |
|---|
| 18 | i1 = n |
|---|
| 19 | i2 = n - 1 |
|---|
| 20 | in = 1 |
|---|
| 21 | WRITE(unit, 3000) text(1:1) |
|---|
| 22 | else |
|---|
| 23 | id = 1 |
|---|
| 24 | i1 = 1 |
|---|
| 25 | i2 = 2 |
|---|
| 26 | in = n |
|---|
| 27 | endif |
|---|
| 28 | |
|---|
| 29 | IF (n<2) THEN |
|---|
| 30 | ndec = 1 |
|---|
| 31 | WRITE(unit, 1000) text, n, x(1) * a |
|---|
| 32 | else |
|---|
| 33 | dxmin = abs(x(2) - x(1)) |
|---|
| 34 | DO i = 2, n - 1 |
|---|
| 35 | dx = abs(x(i + 1) - x(i)) |
|---|
| 36 | IF (dx<dxmin) dxmin = dx |
|---|
| 37 | enddo |
|---|
| 38 | |
|---|
| 39 | ndec = -log10(dxmin) + 2 |
|---|
| 40 | IF(mod(n, 6)==1) THEN |
|---|
| 41 | WRITE(unit, 1000) text, n, x(i1) * a |
|---|
| 42 | WRITE(unit, 2000) (x(i) * a, i=i2, in, id) |
|---|
| 43 | else |
|---|
| 44 | WRITE(unit, 1000) text, n |
|---|
| 45 | WRITE(unit, 2000) (x(i) * a, i=i1, in, id) |
|---|
| 46 | endif |
|---|
| 47 | endif |
|---|
| 48 | |
|---|
| 49 | 1000 format(a4, 2x, i4, ' LEVELS', 43x, f12.2) |
|---|
| 50 | 2000 format(6f12.2) |
|---|
| 51 | 3000 format('FORMAT ', a1, 'REV') |
|---|
| 52 | |
|---|
| 53 | END SUBROUTINE formcoord |
|---|
| 54 | END MODULE lmdz_formcoord |
|---|
