1 | SUBROUTINE readcoord(imx,jmx,lmx,imax,jmax,lmax,x,y,z,pathcoor) |
---|
2 | IMPLICIT NONE |
---|
3 | |
---|
4 | c======================================================================= |
---|
5 | c |
---|
6 | c Auteurs Jan Polcher, Frederic Hourdin |
---|
7 | c ------- |
---|
8 | c |
---|
9 | c Objet Lecture du fichier contenant des coordonnees x,y et z. |
---|
10 | c ----- |
---|
11 | c |
---|
12 | c Inteface |
---|
13 | c -------- |
---|
14 | c |
---|
15 | c Arguments: |
---|
16 | c ---------- |
---|
17 | c |
---|
18 | c input |
---|
19 | c ----- |
---|
20 | c imx \ |
---|
21 | c jmx dimensions des coordonnees |
---|
22 | c lmx / |
---|
23 | c pathcoor path absolu pour le fichier des coordonnees |
---|
24 | c CHARACTER*80 |
---|
25 | c |
---|
26 | c ouput |
---|
27 | c ----- |
---|
28 | c imax nombre de coordonnees x effectives |
---|
29 | c jmax nombre de coordonnees y effectives |
---|
30 | c lmax nombre de coordonnees z effectives |
---|
31 | c x(imx) |
---|
32 | c y(jmx) |
---|
33 | c z(lmx) |
---|
34 | c |
---|
35 | c======================================================================= |
---|
36 | c----------------------------------------------------------------------- |
---|
37 | c declarations: |
---|
38 | c ------------- |
---|
39 | |
---|
40 | c arguments: |
---|
41 | c ---------- |
---|
42 | |
---|
43 | INTEGER imx,jmx,lmx |
---|
44 | INTEGER imax,jmax,lmax |
---|
45 | |
---|
46 | REAL x(imx),y(jmx),z(lmx) |
---|
47 | |
---|
48 | CHARACTER*80 pathcoor |
---|
49 | |
---|
50 | c local |
---|
51 | c ----- |
---|
52 | |
---|
53 | INTEGER i,j,l |
---|
54 | |
---|
55 | CHARACTER*100 filecoor,messerr |
---|
56 | |
---|
57 | EXTERNAL lnblnk |
---|
58 | INTEGER lnblnk |
---|
59 | |
---|
60 | c----------------------------------------------------------------------- |
---|
61 | c Initialisations: |
---|
62 | c ---------------- |
---|
63 | |
---|
64 | messerr=' ' |
---|
65 | filecoor='coord.def' |
---|
66 | |
---|
67 | c----------------------------------------------------------------------- |
---|
68 | |
---|
69 | 100 IF(pathcoor(1:1).EQ.'/') THEN |
---|
70 | filecoor= pathcoor(:lnblnk(pathcoor))//filecoor |
---|
71 | ENDIF |
---|
72 | OPEN (99,file=filecoor,err=200,status='old',form='formatted') |
---|
73 | GO TO 300 |
---|
74 | |
---|
75 | 200 WRITE(*,*) messerr |
---|
76 | WRITE(*,*) 'entrer le nom du fichier des coordonnees puis RETURN' |
---|
77 | WRITE(*,*) 'ou seulement RETURN pour arreter le programme' |
---|
78 | READ(*,'(a)') filecoor |
---|
79 | IF(filecoor(1:1).EQ.' ') STOP |
---|
80 | CLOSE (99) |
---|
81 | GOTO 100 |
---|
82 | |
---|
83 | 300 CONTINUE |
---|
84 | |
---|
85 | READ(99,*,err=9999) imax |
---|
86 | IF(imax.GT.imx) THEN |
---|
87 | WRITE(6,1000) 'x',imx,imax |
---|
88 | STOP |
---|
89 | ENDIF |
---|
90 | READ(99,*) (x(i),i=1,imax) |
---|
91 | |
---|
92 | READ(99,*,err=9999) jmax |
---|
93 | IF(jmax.GT.jmx) THEN |
---|
94 | WRITE(6,1000) 'y',jmx,jmax |
---|
95 | STOP |
---|
96 | ENDIF |
---|
97 | READ(99,*,err=9999) (y(j),j=1,jmax) |
---|
98 | |
---|
99 | READ(99,*,err=9999) lmax |
---|
100 | IF(lmax.GT.lmx) THEN |
---|
101 | WRITE(6,1000) 'z',lmx,lmax |
---|
102 | STOP |
---|
103 | ENDIF |
---|
104 | READ(99,*) (z(l),l=1,lmax) |
---|
105 | |
---|
106 | CLOSE(99) |
---|
107 | |
---|
108 | c----------------------------------------------------------------------- |
---|
109 | |
---|
110 | RETURN |
---|
111 | |
---|
112 | 9999 PRINT*,'Le fichier ',filecoor,' que vous lisez est mal structure' |
---|
113 | PRINT*,'Il doit contenir :' |
---|
114 | PRINT*,' le nombre de points en x suivi des valeurs de x' |
---|
115 | PRINT*,' puis la meme chose pour y et z' |
---|
116 | STOP |
---|
117 | |
---|
118 | 1000 FORMAT(/, |
---|
119 | $ 'Probleme avec le fichier de coordonnees',/, |
---|
120 | $ 'Le tableau contenant ',a3,' est dimenssionne a ',i4,/, |
---|
121 | $ 'et le fichier de coordonnees contient ',i4,' valeurs.') |
---|
122 | |
---|
123 | END |
---|