MED fichier: Fichier source de Unittest_MEDstructElement_4.f

MED fichier

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

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