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 - 2021 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 
mmhrar
subroutine mmhrar(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:1165
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
msesgt
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...
Definition: medstructelement.f:127
mmhiar
subroutine mmhiar(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:1186
mmhsar
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
msevni
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...
Definition: medstructelement.f:169
medstructelement10
program medstructelement10
Definition: Unittest_MEDstructElement_10.f:22