MED fichier: Fichier source de Unittest_MEDstructElement_1.f

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 *****************************************************************************
22 program medstructelement1
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