MED fichier: Fichier source de Unittest_MEDstructElement_10.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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 *****************************************************************************
22 program medstructelement10
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
medstructelement10
program medstructelement10
Definition: Unittest_MEDstructElement_10.f:22
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:1152
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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:122
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:162
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:1132
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:1112
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41