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