MED fichier
Unittest_MEDstructElement_6.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_4.med")
32  character*64 mname2
33  parameter(mname2 = "model name 2")
34  integer dim2
35  parameter(dim2=2)
36  character*64 smname2
37  parameter(smname2="support mesh name")
38  integer setype2
39  parameter(setype2=med_node)
40  integer sgtype2
41  parameter(sgtype2=med_no_geotype)
42  integer mtype2
43  integer sdim1
44  parameter(sdim1=2)
45  character*200 description1
46  parameter(description1="support mesh1 description")
47  character*64 aname1, aname2, aname3
48  parameter(aname1="integer constant attribute name")
49  parameter(aname2="real constant attribute name")
50  parameter(aname3="string constant attribute name")
51  integer atype1,atype2,atype3
52  parameter(atype1=med_att_int)
53  parameter(atype2=med_att_float64)
54  parameter(atype3=med_att_name)
55  integer anc1,anc2,anc3
56  parameter(anc1=2)
57  parameter(anc2=1)
58  parameter(anc3=1)
59 c
60  integer mgtype,mdim,setype,snnode,sncell
61  integer sgtype,ncatt,nvatt,profile
62  character*64 pname,smname,aname
63  integer atype,anc,psize
64  integer i
65 C
66 C
67 C file creation
68  call mfiope(fid,fname,med_acc_rdonly,cret)
69  print *,'Open file',cret
70  if (cret .ne. 0 ) then
71  print *,'ERROR : file creation'
72  call efexit(-1)
73  endif
74 C
75 C read information about struct model
76 C
77  call msesin(fid,mname2,mgtype,mdim,smname,
78  & setype,snnode,sncell,sgtype,
79  & ncatt,profile,nvatt,cret)
80  print *,'Read information about struct element (by name)',cret
81  if (cret .ne. 0 ) then
82  print *,'ERROR : information about struct element (by name) '
83  call efexit(-1)
84  endif
85 C
86 C iteration on each constant attribute
87 C
88  do i=1,ncatt
89 C
90 C
91 C read information about constant attribute
92 C
93  call msecai(fid,mname2,i,aname,atype,anc,
94  & setype,pname,psize,cret)
95  print *,'Read information about constant attribute: ',aname1,cret
96  if (cret .ne. 0 ) then
97  print *,'ERROR : information about attribute'
98  call efexit(-1)
99  endif
100 c
101  if (i. eq. 1) then
102  if ( (atype .ne. atype1) .or.
103  & (anc .ne. anc1) .or.
104  & (setype .ne. setype2) .or.
105  & (pname .ne. med_no_profile) .or.
106  & (psize .ne. 0)
107  & ) then
108  print *,'ERROR : information about constant attribute '
109  call efexit(-1)
110  endif
111  endif
112 c
113  if (i .eq. 2) then
114  if ( (atype .ne. atype2) .or.
115  & (anc .ne. anc2) .or.
116  & (setype .ne. setype2) .or.
117  & (pname .ne. med_no_profile) .or.
118  & (psize .ne. 0)
119  & ) then
120  print *,'ERROR : information about constant attribute'
121  call efexit(-1)
122  endif
123  endif
124 c
125  if (i .eq. 3) then
126  if ( (atype .ne. atype3) .or.
127  & (anc .ne. anc3) .or.
128  & (setype .ne. setype2) .or.
129  & (pname .ne. med_no_profile) .or.
130  & (psize .ne. 0)
131  & ) then
132  print *,'ERROR : information about constant attribute'
133  call efexit(-1)
134  endif
135  endif
136 c
137  enddo
138 C
139 C
140 C close file
141  call mficlo(fid,cret)
142  print *,'Close file',cret
143  if (cret .ne. 0 ) then
144  print *,'ERROR : close file'
145  call efexit(-1)
146  endif
147 C
148 C
149 C
150  end
151 
program medstructelement6
subroutine msesin(fid, mname, mgtype, mdim, smname, setype, snnode, sncell, sgtype, ncatt, ap, nvatt, cret)
Cette routine décrit les caractéristiques d'un modèle d'élément de structure à partir de son nom...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
subroutine msecai(fid, mname, it, aname, atype, anc, setype, pname, psize, cret)
Cette routine décrit les caractéristiques d'un attribut constant de modèle d'élément de structure par...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41