MED fichier
Unittest_MEDstructElement_10.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2020 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 struct element module
20 C *
21 C *****************************************************************************
23 C
24  implicit none
25  include 'med.hf'
26 C
27 C
28  integer cret
29  integer*8 fid
30 
31  character*64 fname
32  parameter(fname = "Unittest_MEDstructElement_9.med")
33  character*64 mname2
34  parameter(mname2 = "model name 2")
35  integer mtype2
36  character*64 aname1, aname2, aname3
37  parameter(aname1="integer attribute name")
38  parameter(aname2="real attribute name")
39  parameter(aname3="string attribute name")
40  integer atype1,atype2,atype3
41  parameter(atype1=med_att_int)
42  parameter(atype2=med_att_float64)
43  parameter(atype3=med_att_name)
44  integer anc1,anc2,anc3
45  parameter(anc1=2)
46  parameter(anc2=1)
47  parameter(anc3=2)
48  integer aval1(2)
49  data aval1 /1,2/
50  real*8 aval2(1)
51  data aval2 /1./
52  character*64 aval3(2)
53  data aval3 /"VAL1","VAL2"/
54  character*64 pname,cname
55  parameter(cname="computation mesh")
56  integer nentity
57  parameter(nentity=1)
58 c
59  integer atype,anc
60  integer rval1(2)
61  real*8 rval2(1)
62  character*64 rval3(2)
63 C
64 C
65 C open file
66  call mfiope(fid,fname,med_acc_rdonly,cret)
67  print *,'Open file',cret
68  if (cret .ne. 0 ) then
69  print *,'ERROR : file creation'
70  call efexit(-1)
71  endif
72 C
73 C informations about attributes
74 C
75  call msevni(fid,mname2,aname1,atype,anc,cret)
76  print *,'Read information about attribute',aname1, cret
77  if (cret .ne. 0) then
78  print *,'ERROR : attribute infromation'
79  call efexit(-1)
80  endif
81  if ( (atype .ne. atype1) .or.
82  & (anc .ne. anc1)
83  & ) then
84  print *,'ERROR : attribute information'
85  call efexit(-1)
86  endif
87 c
88  call msevni(fid,mname2,aname2,atype,anc,cret)
89  print *,'Read information about attribute',aname2, cret
90  if (cret .ne. 0) then
91  print *,'ERROR : attribute infromation'
92  call efexit(-1)
93  endif
94  if ( (atype .ne. atype2) .or.
95  & (anc .ne. anc2)
96  & ) then
97  print *,'ERROR : attribute information'
98  call efexit(-1)
99  endif
100 c
101  call msevni(fid,mname2,aname3,atype,anc,cret)
102  print *,'Read information about attribute',aname3, cret
103  if (cret .ne. 0) then
104  print *,'ERROR : attribute information'
105  call efexit(-1)
106  endif
107  if ( (atype .ne. atype3) .or.
108  & (anc .ne. anc3)
109  & ) then
110  print *,'ERROR : attribute information'
111  call efexit(-1)
112  endif
113 
114 C
115 C read attributes values
116 C
117  call msesgt(fid,mname2,mtype2,cret)
118  print *,'Read struct element type (by name) : ',mtype2, cret
119  if (cret .ne. 0 ) then
120  print *,'ERROR : struct element type (by name)'
121  call efexit(-1)
122  endif
123 c
124  call mmhiar(fid,cname,med_no_dt,med_no_it,
125  & mtype2,aname1,rval1,cret)
126  print *,'Read attribute values',cret
127  if (cret .ne. 0) then
128  print *,'ERROR : read attribute values'
129  call efexit(-1)
130  endif
131  if ( (aval1(1) .ne. rval1(1)) .or.
132  & (aval1(2) .ne. rval1(2))
133  & ) then
134  print *,'ERROR : attribute information'
135  call efexit(-1)
136  endif
137 c
138  call mmhrar(fid,cname,med_no_dt,med_no_it,
139  & mtype2,aname2,rval2,cret)
140  print *,'Read attribute values',cret
141  if (cret .ne. 0) then
142  print *,'ERROR : read attribute values'
143  call efexit(-1)
144  endif
145  if ( (aval2(1) .ne. rval2(1))
146  & ) then
147  print *,'ERROR : attribute information'
148  call efexit(-1)
149  endif
150 c
151  call mmhsar(fid,cname,med_no_dt,med_no_it,
152  & mtype2,aname3,rval3,cret)
153  print *,'Read attribute values',cret
154  if (cret .ne. 0) then
155  print *,'ERROR : read attribute values'
156  call efexit(-1)
157  endif
158  if ( (aval3(1) .ne. rval3(1)) .or.
159  & (aval3(2) .ne. rval3(2))
160  & ) then
161  print *,'ERROR : attribute information'
162  call efexit(-1)
163  endif
164 C
165 C
166 C close file
167  call mficlo(fid,cret)
168  print *,'Close file',cret
169  if (cret .ne. 0 ) then
170  print *,'ERROR : close file'
171  call efexit(-1)
172  endif
173 C
174 C
175 C
176  end
177 
program medstructelement10
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
subroutine mmhsar(fid, name, numdt, numit, geotype, aname, val, cret)
Cette routine lit les valeurs d'un attribut caractéristique variable sur les éléments de structure d'...
Definition: medmesh.f:1207
subroutine msesgt(fid, mname, gtype, cret)
Cette routine renvoie le type géométrique mgeotype associé au modèle d'éléments de structure de nom m...
subroutine msevni(fid, mname, aname, atype, anc, cret)
Cette routine décrit les caractéristiques d'un attribut variable de modèle d'élément de structure à p...
subroutine mmhrar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1165
subroutine mmhiar(fid, name, numdt, numit, geotype, aname, val, cret)
Definition: medmesh.f:1186