MED fichier: Fichier source de Unittest_MEDstructElement_1.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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 - 2017 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 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
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
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
medstructelement1
program medstructelement1
Definition: Unittest_MEDstructElement_1.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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:551
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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, selon une séquence de calcul donnée.
Definition: medmesh.f:285