MED fichier
Unittest_MEDstructElement_1.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_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/
73 C
74 C
75 C 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
82 C
83 C
84 C 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
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
113 C 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
121 C
122 C
123 C 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
131 C
132 C
133 C 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
140 C
141 C
142 C
143  end
144 
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
medstructelement1
program medstructelement1
Definition: Unittest_MEDstructElement_1.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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