MED fichier
Unittest_MEDstructElement_1.f
Aller à la documentation de ce fichier.
1C* This file is part of MED.
2C*
3C* COPYRIGHT (C) 1999 - 2020 EDF R&D, CEA/DEN
4C* MED is free software: you can redistribute it and/or modify
5C* it under the terms of the GNU Lesser General Public License as published by
6C* the Free Software Foundation, either version 3 of the License, or
7C* (at your option) any later version.
8C*
9C* MED is distributed in the hope that it will be useful,
10C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12C* GNU Lesser General Public License for more details.
13C*
14C* You should have received a copy of the GNU Lesser General Public License
15C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16C*
17
18C******************************************************************************
19C * Tests for struct element module
20C *
21C *****************************************************************************
23C
24 implicit none
25 include 'med.hf'
26C
27C
28 integer cret
29 integer*8 fid
30
31 character*64 fname
32 parameter(fname = "Unittest_MEDstructElement_1.med")
33 character*64 mname1, mname2, mname3
34 parameter(mname1 = "model name 1")
35 parameter(mname2 = "model name 2")
36 parameter(mname3 = "model name 3")
37 integer dim1, dim2, dim3
38 parameter(dim1=2)
39 parameter(dim2=2)
40 parameter(dim3=2)
41 character*64 smname1
42 parameter(smname1=med_no_name)
43 character*64 smname2
44 parameter(smname2="support mesh name")
45 integer setype1
46 parameter(setype1=med_none)
47 integer setype2
48 parameter(setype2=med_node)
49 integer setype3
50 parameter(setype3=med_cell)
51 integer sgtype1
52 parameter(sgtype1=med_no_geotype)
53 integer sgtype2
54 parameter(sgtype2=med_no_geotype)
55 integer sgtype3
56 parameter(sgtype3=med_seg2)
57 integer mtype1,mtype2,mtype3
58 integer sdim1
59 parameter(sdim1=2)
60 character*200 description1
61 parameter(description1="support mesh1 description")
62 character*16 nomcoo2d(2)
63 character*16 unicoo2d(2)
64 data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
65 real*8 coo(2*3)
66 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
67 integer nnode
68 parameter(nnode=3)
69 integer nseg2
70 parameter(nseg2=2)
71 integer seg2(4)
72 data seg2 /1,2, 2,3/
73C
74C
75C file creation
76 call mfiope(fid,fname,med_acc_creat,cret)
77 print *,'Open file',cret
78 if (cret .ne. 0 ) then
79 print *,'ERROR : file creation'
80 call efexit(-1)
81 endif
82C
83C
84C first struct element model creation
85 call msecre(fid,mname1,dim1,smname1,setype1,
86 & sgtype1,mtype1, cret)
87 print *,'Create struct element',mtype1, cret
88 if ((cret .ne. 0) .or. (mtype1 .lt. 0) ) then
89 print *,'ERROR : struct element creation'
90 call efexit(-1)
91 endif
92C
93C
94C 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
102c
103 call mmhcow(fid,smname2,med_no_dt,med_no_it,
104 & med_undef_dt,med_full_interlace,
105 & nnode,coo,cret)
106c
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)
111C
112C
113C second struct element model creation
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
121C
122C
123C third struct element model creation
124 call msecre(fid,mname3,dim3,smname2,setype3,
125 & sgtype3,mtype3,cret)
126 print *,'Create struct element',mtype3, cret
127 if ((cret .ne. 0) .or. (mtype3 .lt. 0) ) then
128 print *,'ERROR : struct element creation'
129 call efexit(-1)
130 endif
131C
132C
133C close file
134 call mficlo(fid,cret)
135 print *,'Close file',cret
136 if (cret .ne. 0 ) then
137 print *,'ERROR : close file'
138 call efexit(-1)
139 endif
140C
141C
142C
143 end
144
program medstructelement1
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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.
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
Definition: medsupport.f:20
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Definition: medmesh.f:578
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Definition: medmesh.f:299