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 - 2017 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 fid
30  character*64 fname
31  parameter(fname = "Unittest_MEDstructElement_9.med")
32  character*64 mname2
33  parameter(mname2 = "model name 2")
34  integer mtype2
35  character*64 aname1, aname2, aname3
36  parameter(aname1="integer attribute name")
37  parameter(aname2="real attribute name")
38  parameter(aname3="string attribute name")
39  integer atype1,atype2,atype3
40  parameter(atype1=med_att_int)
41  parameter(atype2=med_att_float64)
42  parameter(atype3=med_att_name)
43  integer anc1,anc2,anc3
44  parameter(anc1=2)
45  parameter(anc2=1)
46  parameter(anc3=2)
47  integer aval1(2)
48  data aval1 /1,2/
49  real*8 aval2(1)
50  data aval2 /1./
51  character*64 aval3(2)
52  data aval3 /"VAL1","VAL2"/
53  character*64 pname,cname
54  parameter(cname="computation mesh")
55  integer nentity
56  parameter(nentity=1)
57 c
58  integer atype,anc
59  integer rval1(2)
60  real*8 rval2(1)
61  character*64 rval3(2)
62 C
63 C
64 C open file
65  call mfiope(fid,fname,med_acc_rdonly,cret)
66  print *,'Open file',cret
67  if (cret .ne. 0 ) then
68  print *,'ERROR : file creation'
69  call efexit(-1)
70  endif
71 C
72 C informations about attributes
73 C
74  call msevni(fid,mname2,aname1,atype,anc,cret)
75  print *,'Read information about attribute',aname1, cret
76  if (cret .ne. 0) then
77  print *,'ERROR : attribute infromation'
78  call efexit(-1)
79  endif
80  if ( (atype .ne. atype1) .or.
81  & (anc .ne. anc1)
82  & ) then
83  print *,'ERROR : attribute information'
84  call efexit(-1)
85  endif
86 c
87  call msevni(fid,mname2,aname2,atype,anc,cret)
88  print *,'Read information about attribute',aname2, cret
89  if (cret .ne. 0) then
90  print *,'ERROR : attribute infromation'
91  call efexit(-1)
92  endif
93  if ( (atype .ne. atype2) .or.
94  & (anc .ne. anc2)
95  & ) then
96  print *,'ERROR : attribute information'
97  call efexit(-1)
98  endif
99 c
100  call msevni(fid,mname2,aname3,atype,anc,cret)
101  print *,'Read information about attribute',aname3, cret
102  if (cret .ne. 0) then
103  print *,'ERROR : attribute information'
104  call efexit(-1)
105  endif
106  if ( (atype .ne. atype3) .or.
107  & (anc .ne. anc3)
108  & ) then
109  print *,'ERROR : attribute information'
110  call efexit(-1)
111  endif
112 
113 C
114 C read attributes values
115 C
116  call msesgt(fid,mname2,mtype2,cret)
117  print *,'Read struct element type (by name) : ',mtype2, cret
118  if (cret .ne. 0 ) then
119  print *,'ERROR : struct element type (by name)'
120  call efexit(-1)
121  endif
122 c
123  call mmhiar(fid,cname,med_no_dt,med_no_it,
124  & mtype2,aname1,rval1,cret)
125  print *,'Read attribute values',cret
126  if (cret .ne. 0) then
127  print *,'ERROR : read attribute values'
128  call efexit(-1)
129  endif
130  if ( (aval1(1) .ne. rval1(1)) .or.
131  & (aval1(2) .ne. rval1(2))
132  & ) then
133  print *,'ERROR : attribute information'
134  call efexit(-1)
135  endif
136 c
137  call mmhrar(fid,cname,med_no_dt,med_no_it,
138  & mtype2,aname2,rval2,cret)
139  print *,'Read attribute values',cret
140  if (cret .ne. 0) then
141  print *,'ERROR : read attribute values'
142  call efexit(-1)
143  endif
144  if ( (aval2(1) .ne. rval2(1))
145  & ) then
146  print *,'ERROR : attribute information'
147  call efexit(-1)
148  endif
149 c
150  call mmhsar(fid,cname,med_no_dt,med_no_it,
151  & mtype2,aname3,rval3,cret)
152  print *,'Read attribute values',cret
153  if (cret .ne. 0) then
154  print *,'ERROR : read attribute values'
155  call efexit(-1)
156  endif
157  if ( (aval3(1) .ne. rval3(1)) .or.
158  & (aval3(2) .ne. rval3(2))
159  & ) then
160  print *,'ERROR : attribute information'
161  call efexit(-1)
162  endif
163 C
164 C
165 C close file
166  call mficlo(fid,cret)
167  print *,'Close file',cret
168  if (cret .ne. 0 ) then
169  print *,'ERROR : close file'
170  call efexit(-1)
171  endif
172 C
173 C
174 C
175  end
176 
program medstructelement10
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:1152
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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 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:1132
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:1112
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41