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