MED fichier: Fichier source de Unittest_MEDstructElement_4.f

MED fichier

Unittest_MEDstructElement_4.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 medstructelement4
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_4.med")
33 character*64 mname2
34 parameter(mname2 = "model name 2")
35 integer dim2
36 parameter(dim2=2)
37 character*64 smname2
38 parameter(smname2="support mesh name")
39 integer setype2
40 parameter(setype2=med_node)
41 integer sgtype2
42 parameter(sgtype2=med_no_geotype)
43 integer mtype2
44 integer sdim1
45 parameter(sdim1=2)
46 character*200 description1
47 parameter(description1="support mesh1 description")
48 character*16 nomcoo2d(2)
49 character*16 unicoo2d(2)
50 data nomcoo2d /"x","y"/, unicoo2d /"cm","cm"/
51 real*8 coo(2*3)
52 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
53 integer nnode
54 parameter(nnode=3)
55 integer nseg2
56 parameter(nseg2=2)
57 integer seg2(4)
58 data seg2 /1,2, 2,3/
59 character*64 aname1, aname2, aname3
60 parameter(aname1="integer constant attribute name")
61 parameter(aname2="real constant attribute name")
62 parameter(aname3="string constant attribute name")
63 integer atype1,atype2,atype3
64 parameter(atype1=med_att_int)
65 parameter(atype2=med_att_float64)
66 parameter(atype3=med_att_name)
67 integer anc1,anc2,anc3
68 parameter(anc1=2)
69 parameter(anc2=1)
70 parameter(anc3=1)
71 integer aval1(3*2)
72 data aval1 /1,2,3,4,5,6/
73 real*8 aval2(3)
74 data aval2 /1., 2., 3. /
75 character*64 aval3(3)
76 data aval3 /"VAL1","VAL2","VAL3"/
77 character*64 pname
78 C
79 C
80 C file creation
81 call mfiope(fid,fname,med_acc_creat,cret)
82 print *,'Open file',cret
83 if (cret .ne. 0 ) then
84 print *,'ERROR : file creation'
85 call efexit(-1)
86 endif
87 C
88 C
89 C support mesh creation : 2D
90 call msmcre(fid,smname2,dim2,dim2,description1,
91 & med_cartesian,nomcoo2d,unicoo2d,cret)
92 print *,'Support mesh creation : 2D space dimension',cret
93 if (cret .ne. 0 ) then
94 print *,'ERROR : support mesh creation'
95 call efexit(-1)
96 endif
97 c
98 call mmhcow(fid,smname2,med_no_dt,med_no_it,
99 & med_undef_dt,med_full_interlace,
100 & nnode,coo,cret)
101 c
102 call mmhcyw(fid,smname2,med_no_dt,med_no_it,
103 & med_undef_dt,med_cell,med_seg2,
104 & med_nodal,med_full_interlace,
105 & nseg2,seg2,cret)
106 C
107 C struct element creation
108 C
109 call msecre(fid,mname2,dim2,smname2,setype2,
110 & sgtype2,mtype2,cret)
111 print *,'Create struct element',mtype2, cret
112 if ((cret .ne. 0) .or. (mtype2 .lt. 0) ) then
113 print *,'ERROR : struct element creation'
114 call efexit(-1)
115 endif
116 C
117 C write constant attributes
118 C
119 call mseiaw(fid,mname2,aname1,atype1,anc1,
120 & setype2,aval1,cret)
121 print *,'Create a constant attribute : ',aname1, cret
122 if (cret .ne. 0) then
123 print *,'ERROR : constant attribute creation'
124 call efexit(-1)
125 endif
126 c
127 call mseraw(fid,mname2,aname2,atype2,anc2,
128 & setype2,aval2,cret)
129 print *,'Create a constant attribute : ',aname2, cret
130 if (cret .ne. 0) then
131 print *,'ERROR : constant attribute creation'
132 call efexit(-1)
133 endif
134 c
135 call msesaw(fid,mname2,aname3,atype3,anc3,
136 & setype2,aval3,cret)
137 print *,'Create a constant attribute : ',aname3, cret
138 if (cret .ne. 0) then
139 print *,'ERROR : constant attribute creation'
140 call efexit(-1)
141 endif
142 C
143 C
144 C close file
145 call mficlo(fid,cret)
146 print *,'Close file',cret
147 if (cret .ne. 0 ) then
148 print *,'ERROR : close file'
149 call efexit(-1)
150 endif
151 C
152 C
153 C
154 end
155
mseraw
subroutine mseraw(fid, mname, aname, atype, anc, setype, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:228
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
medstructelement4
program medstructelement4
Definition: Unittest_MEDstructElement_4.f:22
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
msesaw
subroutine msesaw(fid, mname, aname, atype, anc, setype, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:270
mseiaw
subroutine mseiaw(fid, mname, aname, atype, anc, setype, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure....
Definition: medstructelement.f:249
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