MED fichier
Unittest_MEDstructElement_11.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2016 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 c
48  integer atype,anc
49  character*64 aname
50  integer it,natt
51  parameter(natt=3)
52 C
53 C
54 C open file
55  call mfiope(fid,fname,med_acc_rdonly,cret)
56  print *,'Open file',cret
57  if (cret .ne. 0 ) then
58  print *,'ERROR : file creation'
59  call efexit(-1)
60  endif
61 C
62 C
63 C
64  do it=1,natt
65  call msevai(fid,mname2,it,aname,atype,anc,cret)
66  print *,'Read informations about attribute : ',aname,cret
67  if (cret .ne. 0) then
68  print *,'ERROR : attribute information'
69  call efexit(-1)
70  endif
71 c
72  if (it .eq. 1) then
73  if ( (atype .ne. atype1) .or.
74  & (anc .ne. anc1)
75  & ) then
76  print *,'ERROR : attribute information'
77  call efexit(-1)
78  endif
79  endif
80 c
81  if (it .eq. 2) then
82  if ( (atype .ne. atype2) .or.
83  & (anc .ne. anc2)
84  & ) then
85  print *,'ERROR : attribute information'
86  call efexit(-1)
87  endif
88  endif
89 c
90  if (it .eq. 3) then
91  if ( (atype .ne. atype3) .or.
92  & (anc .ne. anc3)
93  & ) then
94  print *,'ERROR : attribute information'
95  call efexit(-1)
96  endif
97  endif
98 c
99  enddo
100 C
101 C
102 C close file
103  call mficlo(fid,cret)
104  print *,'Close file',cret
105  if (cret .ne. 0 ) then
106  print *,'ERROR : close file'
107  call efexit(-1)
108  endif
109 C
110 C
111 C
112  end
113 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
program medstructelement11
subroutine msevai(fid, mname, it, aname, atype, anc, cret)
Cette routine décrit les caractéristiques d'un attribut variable de modèle d'élément de structure par...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41