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