MED fichier: Fichier source de Unittest_MEDstructElement_7.f

MED fichier

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

Unittest_MEDstructElement_7.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 medstructelement7
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_7.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(2*2)
71 data aval1 /1,2,5,6/
72 real*8 aval2(2*1)
73 data aval2 /1., 3. /
74 character*64 aval3(2*1)
75 data aval3 /"VAL1","VAL3"/
76 character*64 pname
77 parameter(pname="profil name")
78 integer psize
79 parameter(psize=2)
80 integer profil(2)
81 data profil / 1,3 /
82 C
83 C
84 C file creation
85 call mfiope(fid,fname,med_acc_creat,cret)
86 print *,'Open file',cret
87 if (cret .ne. 0 ) then
88 print *,'ERROR : file 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 struct element creation
112 C
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 write profile
122 C
123 call mpfprw(fid,pname,psize,profil,cret)
124 print *,'Create a profile : ',pname, cret
125 if (cret .ne. 0) then
126 print *,'ERROR : profile creation'
127 call efexit(-1)
128 endif
129 C
130 C write constant attributes with profiles
131 C
132 call mseipw(fid,mname2,aname1,atype1,anc1,
133 & setype2,pname,aval1,cret)
134 print *,'Create a constant attribute with profile : ',aname1, cret
135 if (cret .ne. 0) then
136 print *,'ERROR : constant attribute with profile creation'
137 call efexit(-1)
138 endif
139 c
140 call mserpw(fid,mname2,aname2,atype2,anc2,
141 & setype2,pname,aval2,cret)
142 print *,'Create a constant attribute with profile : ',aname2, cret
143 if (cret .ne. 0) then
144 print *,'ERROR : constant attribute with profile creation'
145 call efexit(-1)
146 endif
147 c
148 call msespw(fid,mname2,aname3,atype3,anc3,
149 & setype2,pname,aval3,cret)
150 print *,'Create a constant attribute with profile : ',aname3, cret
151 if (cret .ne. 0) then
152 print *,'ERROR : constant attribute with profile creation'
153 call efexit(-1)
154 endif
155 C
156 C
157 C close file
158 call mficlo(fid,cret)
159 print *,'Close file',cret
160 if (cret .ne. 0 ) then
161 print *,'ERROR : close file'
162 call efexit(-1)
163 endif
164 C
165 C
166 C
167 end
168
mpfprw
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
Definition: medprofile.f:21
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
msespw
subroutine msespw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure...
Definition: medstructelement.f:321
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
mseipw
subroutine mseipw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure...
Definition: medstructelement.f:300
mserpw
subroutine mserpw(fid, mname, aname, atype, anc, setype, pname, val, cret)
Cette routine définit un attribut caractéristique constant d'un modèle d'éléments de structure...
Definition: medstructelement.f:279
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
medstructelement7
program medstructelement7
Definition: Unittest_MEDstructElement_7.f:22
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