MED fichier
Unittest_MEDstructElement_7.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_7.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(2*2)
72  data aval1 /1,2,5,6/
73  real*8 aval2(2*1)
74  data aval2 /1., 3. /
75  character*64 aval3(2*1)
76  data aval3 /"VAL1","VAL3"/
77  character*64 pname
78  parameter(pname="profil name")
79  integer psize
80  parameter(psize=2)
81  integer profil(2)
82  data profil / 1,3 /
83 C
84 C
85 C file creation
86  call mfiope(fid,fname,med_acc_creat,cret)
87  print *,'Open file',cret
88  if (cret .ne. 0 ) then
89  print *,'ERROR : file creation'
90  call efexit(-1)
91  endif
92 C
93 C
94 C support mesh creation : 2D
95  call msmcre(fid,smname2,dim2,dim2,description1,
96  & med_cartesian,nomcoo2d,unicoo2d,cret)
97  print *,'Support mesh creation : 2D space dimension',cret
98  if (cret .ne. 0 ) then
99  print *,'ERROR : support mesh creation'
100  call efexit(-1)
101  endif
102 c
103  call mmhcow(fid,smname2,med_no_dt,med_no_it,
104  & med_undef_dt,med_full_interlace,
105  & nnode,coo,cret)
106 c
107  call mmhcyw(fid,smname2,med_no_dt,med_no_it,
108  & med_undef_dt,med_cell,med_seg2,
109  & med_nodal,med_full_interlace,
110  & nseg2,seg2,cret)
111 C
112 C struct element creation
113 C
114  call msecre(fid,mname2,dim2,smname2,setype2,
115  & sgtype2,mtype2,cret)
116  print *,'Create struct element',mtype2, cret
117  if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
118  print *,'ERROR : struct element creation'
119  call efexit(-1)
120  endif
121 C
122 C write profile
123 C
124  call mpfprw(fid,pname,psize,profil,cret)
125  print *,'Create a profile : ',pname, cret
126  if (cret .ne. 0) then
127  print *,'ERROR : profile creation'
128  call efexit(-1)
129  endif
130 C
131 C write constant attributes with profiles
132 C
133  call mseipw(fid,mname2,aname1,atype1,anc1,
134  & setype2,pname,aval1,cret)
135  print *,'Create a constant attribute with profile : ',aname1, cret
136  if (cret .ne. 0) then
137  print *,'ERROR : constant attribute with profile creation'
138  call efexit(-1)
139  endif
140 c
141  call mserpw(fid,mname2,aname2,atype2,anc2,
142  & setype2,pname,aval2,cret)
143  print *,'Create a constant attribute with profile : ',aname2, cret
144  if (cret .ne. 0) then
145  print *,'ERROR : constant attribute with profile creation'
146  call efexit(-1)
147  endif
148 c
149  call msespw(fid,mname2,aname3,atype3,anc3,
150  & setype2,pname,aval3,cret)
151  print *,'Create a constant attribute with profile : ',aname3, cret
152  if (cret .ne. 0) then
153  print *,'ERROR : constant attribute with profile creation'
154  call efexit(-1)
155  endif
156 C
157 C
158 C close file
159  call mficlo(fid,cret)
160  print *,'Close file',cret
161  if (cret .ne. 0 ) then
162  print *,'ERROR : close file'
163  call efexit(-1)
164  endif
165 C
166 C
167 C
168  end
169 
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
mpfprw
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
Definition: medprofile.f:21
msespw
subroutine msespw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:335
mseipw
subroutine mseipw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:313
medstructelement7
program medstructelement7
Definition: Unittest_MEDstructElement_7.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mserpw
subroutine mserpw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:291
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