[524] | 1 | ! $Header$ |
---|
[5099] | 2 | |
---|
[5103] | 3 | SUBROUTINE inigrads(if, im & |
---|
| 4 | , x, fx, xmin, xmax, jm, y, ymin, ymax, fy, lm, z, fz & |
---|
| 5 | , dt, file, titlel) |
---|
[524] | 6 | |
---|
[5113] | 7 | IMPLICIT NONE |
---|
[524] | 8 | |
---|
[5116] | 9 | INTEGER :: if, im, jm, lm, i, j, l |
---|
| 10 | REAL :: x(im), y(jm), z(lm), fx, fy, fz, dt |
---|
| 11 | REAL :: xmin, xmax, ymin, ymax |
---|
[524] | 12 | |
---|
[5117] | 13 | CHARACTER(LEN = *), INTENT(IN) :: file |
---|
| 14 | CHARACTER(LEN = *), INTENT(IN) :: titlel |
---|
[524] | 15 | |
---|
[5103] | 16 | INCLUDE "gradsdef.h" |
---|
[524] | 17 | |
---|
[5103] | 18 | ! data unit/66,32,34,36,38,40,42,44,46,48/ |
---|
[5116] | 19 | INTEGER :: nf |
---|
[5103] | 20 | save nf |
---|
| 21 | data nf/0/ |
---|
[524] | 22 | |
---|
[5103] | 23 | unit(1) = 66 |
---|
| 24 | unit(2) = 32 |
---|
| 25 | unit(3) = 34 |
---|
| 26 | unit(4) = 36 |
---|
| 27 | unit(5) = 38 |
---|
| 28 | unit(6) = 40 |
---|
| 29 | unit(7) = 42 |
---|
| 30 | unit(8) = 44 |
---|
| 31 | unit(9) = 46 |
---|
[524] | 32 | |
---|
[5117] | 33 | IF (if<=nf) stop 'verifier les appels a inigrads' |
---|
[524] | 34 | |
---|
[5103] | 35 | PRINT*, 'Entree dans inigrads' |
---|
[524] | 36 | |
---|
[5103] | 37 | nf = if |
---|
| 38 | title(if) = titlel |
---|
| 39 | ivar(if) = 0 |
---|
[524] | 40 | |
---|
[5103] | 41 | fichier(if) = trim(file) |
---|
[524] | 42 | |
---|
[5103] | 43 | firsttime(if) = .TRUE. |
---|
| 44 | dtime(if) = dt |
---|
[524] | 45 | |
---|
[5103] | 46 | iid(if) = 1 |
---|
| 47 | ifd(if) = im |
---|
| 48 | imd(if) = im |
---|
| 49 | do i = 1, im |
---|
| 50 | xd(i, if) = x(i) * fx |
---|
[5116] | 51 | IF(xd(i, if)<xmin) iid(if) = i + 1 |
---|
| 52 | IF(xd(i, if)<=xmax) ifd(if) = i |
---|
[5103] | 53 | enddo |
---|
| 54 | PRINT*, 'On stoke du point ', iid(if), ' a ', ifd(if), ' en x' |
---|
[524] | 55 | |
---|
[5103] | 56 | jid(if) = 1 |
---|
| 57 | jfd(if) = jm |
---|
| 58 | jmd(if) = jm |
---|
| 59 | do j = 1, jm |
---|
| 60 | yd(j, if) = y(j) * fy |
---|
[5116] | 61 | IF(yd(j, if)>ymax) jid(if) = j + 1 |
---|
| 62 | IF(yd(j, if)>=ymin) jfd(if) = j |
---|
[5103] | 63 | enddo |
---|
| 64 | PRINT*, 'On stoke du point ', jid(if), ' a ', jfd(if), ' en y' |
---|
[524] | 65 | |
---|
[5103] | 66 | PRINT*, 'Open de dat' |
---|
| 67 | PRINT*, 'file=', file |
---|
| 68 | PRINT*, 'fichier(if)=', fichier(if) |
---|
[524] | 69 | |
---|
[5103] | 70 | PRINT*, 4 * (ifd(if) - iid(if)) * (jfd(if) - jid(if)) |
---|
| 71 | PRINT*, trim(file) // '.dat' |
---|
[524] | 72 | |
---|
[5103] | 73 | OPEN (unit(if) + 1, FILE = trim(file) // '.dat' & |
---|
| 74 | , FORM = 'unformatted', & |
---|
| 75 | ACCESS = 'direct' & |
---|
| 76 | , RECL = 4 * (ifd(if) - iid(if) + 1) * (jfd(if) - jid(if) + 1)) |
---|
[524] | 77 | |
---|
[5103] | 78 | PRINT*, 'Open de dat ok' |
---|
[524] | 79 | |
---|
[5103] | 80 | lmd(if) = lm |
---|
| 81 | do l = 1, lm |
---|
| 82 | zd(l, if) = z(l) * fz |
---|
| 83 | enddo |
---|
[524] | 84 | |
---|
[5103] | 85 | irec(if) = 0 |
---|
[524] | 86 | |
---|
[5103] | 87 | PRINT*, if, imd(if), jmd(if), lmd(if) |
---|
| 88 | PRINT*, 'if,imd(if),jmd(if),lmd(if)' |
---|
[524] | 89 | |
---|
[5105] | 90 | |
---|
[5116] | 91 | END SUBROUTINE inigrads |
---|