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 - 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_1.med")
32  character*64 mname1, mname2, mname3
33  parameter(mname1 = "model name 1")
34  parameter(mname2 = "model name 2")
35  parameter(mname3 = "model name 3")
36  integer dim1, dim2, dim3
37  parameter(dim1=2)
38  parameter(dim2=2)
39  parameter(dim3=2)
40  character*64 smname1
41  parameter(smname1=med_no_name)
42  character*64 smname2
43  parameter(smname2="support mesh name")
44  integer setype1
45  parameter(setype1=med_none)
46  integer setype2
47  parameter(setype2=med_node)
48  integer setype3
49  parameter(setype3=med_cell)
50  integer sgtype1
51  parameter(sgtype1=med_no_geotype)
52  integer sgtype2
53  parameter(sgtype2=med_no_geotype)
54  integer sgtype3
55  parameter(sgtype3=med_seg2)
56  integer mtype1,mtype2,mtype3
57  integer sdim1
58  parameter(sdim1=2)
59  character*200 description1
60  parameter(description1="support mesh1 description")
61  character*16 nomcoo2D(2)
62  character*16 unicoo2D(2)
63  data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
64  real*8 coo(2*3)
65  data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
66  integer nnode
67  parameter(nnode=3)
68  integer nseg2
69  parameter(nseg2=2)
70  integer seg2(4)
71  data seg2 /1,2, 2,3/
72 C
73 C
74 C file creation
75  call mfiope(fid,fname,med_acc_creat,cret)
76  print *,'Open file',cret
77  if (cret .ne. 0 ) then
78  print *,'ERROR : file creation'
79  call efexit(-1)
80  endif
81 C
82 C
83 C first struct element model creation
84  call msecre(fid,mname1,dim1,smname1,setype1,
85  & sgtype1,mtype1, cret)
86  print *,'Create struct element',mtype1, cret
87  if ((cret .ne. 0) .or. (mtype1 .lt. 0) ) then
88  print *,'ERROR : struct element creation'
89  call efexit(-1)
90  endif
91 C
92 C
93 C support mesh creation : 2D
94  call msmcre(fid,smname2,dim2,dim2,description1,
95  & med_cartesian,nomcoo2d,unicoo2d,cret)
96  print *,'Support mesh creation : 2D space dimension',cret
97  if (cret .ne. 0 ) then
98  print *,'ERROR : support mesh creation'
99  call efexit(-1)
100  endif
101 c
102  call mmhcow(fid,smname2,med_no_dt,med_no_it,
103  & med_undef_dt,med_full_interlace,
104  & nnode,coo,cret)
105 c
106  call mmhcyw(fid,smname2,med_no_dt,med_no_it,
107  & med_undef_dt,med_cell,med_seg2,
108  & med_nodal,med_full_interlace,
109  & nseg2,seg2,cret)
110 C
111 C
112 C second struct element model creation
113  call msecre(fid,mname2,dim2,smname2,setype2,
114  & sgtype2,mtype2,cret)
115  print *,'Create struct element',mtype2, cret
116  if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
117  print *,'ERROR : struct element creation'
118  call efexit(-1)
119  endif
120 C
121 C
122 C third struct element model creation
123  call msecre(fid,mname3,dim3,smname2,setype3,
124  & sgtype3,mtype3,cret)
125  print *,'Create struct element',mtype3, cret
126  if ((cret .ne. 0) .or. (mtype3 .lt. 0) ) then
127  print *,'ERROR : struct element creation'
128  call efexit(-1)
129  endif
130 C
131 C
132 C close file
133  call mficlo(fid,cret)
134  print *,'Close file',cret
135  if (cret .ne. 0 ) then
136  print *,'ERROR : close file'
137  call efexit(-1)
138  endif
139 C
140 C
141 C
142  end
143 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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, selon une séquence de calcul donnée.
Definition: medmesh.f:285
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...
program medstructelement1
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)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:551
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41