MED fichier
Unittest_MEDstructElement_4.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 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*16 nomcoo2d(2)
49  character*16 unicoo2d(2)
50  data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
51  real*8 coo(2*3)
52  data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
53  integer nnode
54  parameter(nnode=3)
55  integer nseg2
56  parameter(nseg2=2)
57  integer seg2(4)
58  data seg2 /1,2, 2,3/
59  character*64 aname1, aname2, aname3
60  parameter(aname1="integer constant attribute name")
61  parameter(aname2="real constant attribute name")
62  parameter(aname3="string constant attribute name")
63  integer atype1,atype2,atype3
64  parameter(atype1=med_att_int)
65  parameter(atype2=med_att_float64)
66  parameter(atype3=med_att_name)
67  integer anc1,anc2,anc3
68  parameter(anc1=2)
69  parameter(anc2=1)
70  parameter(anc3=1)
71  integer aval1(3*2)
72  data aval1 /1,2,3,4,5,6/
73  real*8 aval2(3)
74  data aval2 /1., 2., 3. /
75  character*64 aval3(3)
76  data aval3 /"VAL1","VAL2","VAL3"/
77  character*64 pname
78 C
79 C
80 C file creation
81  call mfiope(fid,fname,med_acc_creat,cret)
82  print *,'Open file',cret
83  if (cret .ne. 0 ) then
84  print *,'ERROR : file creation'
85  call efexit(-1)
86  endif
87 C
88 C
89 C support mesh creation : 2D
90  call msmcre(fid,smname2,dim2,dim2,description1,
91  & med_cartesian,nomcoo2d,unicoo2d,cret)
92  print *,'Support mesh creation : 2D space dimension',cret
93  if (cret .ne. 0 ) then
94  print *,'ERROR : support mesh creation'
95  call efexit(-1)
96  endif
97 c
98  call mmhcow(fid,smname2,med_no_dt,med_no_it,
99  & med_undef_dt,med_full_interlace,
100  & nnode,coo,cret)
101 c
102  call mmhcyw(fid,smname2,med_no_dt,med_no_it,
103  & med_undef_dt,med_cell,med_seg2,
104  & med_nodal,med_full_interlace,
105  & nseg2,seg2,cret)
106 C
107 C struct element creation
108 C
109  call msecre(fid,mname2,dim2,smname2,setype2,
110  & sgtype2,mtype2,cret)
111  print *,'Create struct element',mtype2, cret
112  if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
113  print *,'ERROR : struct element creation'
114  call efexit(-1)
115  endif
116 C
117 C write constant attributes
118 C
119  call mseiaw(fid,mname2,aname1,atype1,anc1,
120  & setype2,aval1,cret)
121  print *,'Create a constant attribute : ',aname1, cret
122  if (cret .ne. 0) then
123  print *,'ERROR : constant attribute creation'
124  call efexit(-1)
125  endif
126 c
127  call mseraw(fid,mname2,aname2,atype2,anc2,
128  & setype2,aval2,cret)
129  print *,'Create a constant attribute : ',aname2, cret
130  if (cret .ne. 0) then
131  print *,'ERROR : constant attribute creation'
132  call efexit(-1)
133  endif
134 c
135  call msesaw(fid,mname2,aname3,atype3,anc3,
136  & setype2,aval3,cret)
137  print *,'Create a constant attribute : ',aname3, cret
138  if (cret .ne. 0) then
139  print *,'ERROR : constant attribute creation'
140  call efexit(-1)
141  endif
142 C
143 C
144 C close file
145  call mficlo(fid,cret)
146  print *,'Close file',cret
147  if (cret .ne. 0 ) then
148  print *,'ERROR : close file'
149  call efexit(-1)
150  endif
151 C
152 C
153 C
154  end
155 
mseraw
subroutine mseraw(fid, mname, aname, atype, anc, setype, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:228
mmhcyw
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:578
msecre
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
Cette routine permet de créer un nouveau modèle d'éléments de structure dans un fichier MED.
Definition: medstructelement.f:20
msmcre
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
Definition: medsupport.f:20
medstructelement4
program medstructelement4
Definition: Unittest_MEDstructElement_4.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
msesaw
subroutine msesaw(fid, mname, aname, atype, anc, setype, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:270
mseiaw
subroutine mseiaw(fid, mname, aname, atype, anc, setype, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:249
mmhcow
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:299
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42