MED fichier
Unittest_MEDfile_1.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2016 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17 
18 C******************************************************************************
19 C * Tests for file module
20 C *
21 C *****************************************************************************
22  program medfile
23 C
24  implicit none
25  include 'med.hf'
26 C
27 C
28  integer cret
29  integer fid
30  character*64 fname
31  parameter(fname = "Unittest_MEDfile_1.med")
32  character*200 cmt1
33  parameter(cmt1 = "My first comment")
34  character*200 cmt2
35  parameter(cmt2 = "My second comment")
36  character*200 cmtrd
37  integer hdfok, medok
38  character*32 version
39  integer major, minor, rel
40 C
41 C
42 C file creation
43  call mfiope(fid,fname,med_acc_creat,cret)
44  print *,cret
45  print *,fid
46  if (cret .ne. 0 ) then
47  print *,'ERROR : file creation'
48  call efexit(-1)
49  endif
50 C
51 C
52 C write a comment
53  call mficow(fid,cmt1,cret)
54  print *,cret
55  if (cret .ne. 0 ) then
56  print *,'ERROR : write a comment'
57  call efexit(-1)
58  endif
59 C
60 C
61 C close file
62  call mficlo(fid,cret)
63  print *,cret
64  if (cret .ne. 0 ) then
65  print *,'ERROR : close file'
66  call efexit(-1)
67  endif
68 C
69 C
70 C open file in read only access mode
71  call mfiope(fid,fname,med_acc_rdonly,cret)
72  print *,cret
73  print *,fid
74  if (cret .ne. 0 ) then
75  print *,'ERROR : open file in READ_ONLY access mode'
76  call efexit(-1)
77  endif
78 C
79 C
80 C read med library version in the file
81  call mfinvr(fid,major,minor,rel,cret)
82  print *,cret
83  print *,major,minor,rel
84  if (cret .ne. 0 ) then
85  print *,'ERROR : read MED (num) version in the file'
86  call efexit(-1)
87  endif
88 
89  call mfisvr(fid,version,cret)
90  print *,cret
91  print *,version
92  if (cret .ne. 0 ) then
93  print *,'ERROR : read MED (str) version in the file'
94  call efexit(-1)
95  endif
96 C
97 C
98 C read a comment
99  call mficor(fid,cmtrd,cret)
100  print *,cret
101  print *,cmtrd
102  if (cret .ne. 0 ) then
103  print *,'ERROR : read a comment'
104  call efexit(-1)
105  endif
106  if (cmtrd .ne. cmt1) then
107  print *,'ERROR : file comment is not the good one'
108  call efexit(-1)
109  endif
110 C
111 C
112 C close file
113  call mficlo(fid,cret)
114  print *,cret
115  if (cret .ne. 0 ) then
116  print *,'ERROR : close file'
117  call efexit(-1)
118  endif
119 C
120 C
121 C open file in read and write access mode
122  call mfiope(fid,fname,med_acc_rdwr,cret)
123  print *,cret
124  print *,fid
125  if (cret .ne. 0 ) then
126  print *,'ERROR : open file in READ and WRITE access mode'
127  call efexit(-1)
128  endif
129 C
130 C
131 C write a comment
132  call mficow(fid,cmt2,cret)
133  print *,cret
134  if (cret .ne. 0 ) then
135  print *,'ERROR : write a comment'
136  call efexit(-1)
137  endif
138 C
139 C
140 C close file
141  call mficlo(fid,cret)
142  print *,cret
143  if (cret .ne. 0 ) then
144  print *,'ERROR : close file'
145  call efexit(-1)
146  endif
147 C
148 C
149 C open file in read and extension access mode
150  call mfiope(fid,fname,med_acc_rdext,cret)
151  print *,cret
152  print *,fid
153  if (cret .ne. 0 ) then
154  print *,'ERROR : open file in READ and WRITE access mode'
155  call efexit(-1)
156  endif
157 C
158 C
159 C write a comment has to be impossible because it exits
160  call mficow(fid,cmt1,cret)
161  print *,cret
162  if (cret .eq. 0 ) then
163  print *,'ERROR : write a comment has to be impossible'
164  call efexit(-1)
165  endif
166 C
167 C
168 C close file
169  call mficlo(fid,cret)
170  print *,cret
171  if (cret .ne. 0 ) then
172  print *,'ERROR : close file'
173  call efexit(-1)
174  endif
175 C
176 C
177 C test file compatiblity with hdf-5 et med
178  print *,fname
179  call mficom(fname,hdfok,medok,cret)
180  print *,cret
181  print *,medok,hdfok
182  if (cret .ne. 0 ) then
183  print *,'ERROR : file compatibility'
184  call efexit(-1)
185  endif
186  if (hdfok .ne. 1) then
187  print *,'ERROR : the file must be in hdf5 format'
188  call efexit(-1)
189  endif
190  if (medok .ne. 1) then
191  print *,'ERROR : the file must be compatible'
192  call efexit(-1)
193  endif
194  end
195 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine mficom(fname, hdfok, medok, cret)
Vérification de la compatibilité d'un fichier avec HDF et MED.
Definition: medfile.f:163
subroutine mficor(fid, cmt, cret)
Lecture d'un descripteur dans un fichier MED.
Definition: medfile.f:112
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:96
subroutine mfinvr(fid, major, minor, rel, cret)
Lecture du numéro de version de la bibliothèque MED utilisée pour créer le fichier.
Definition: medfile.f:129
subroutine mfisvr(fid, version, cret)
Lecture du numéro de version de la bibliothèque MED utilisée pour créer le fichier (renvoyé sous la f...
Definition: medfile.f:145
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
program medfile