MED fichier: Fichier source de Unittest_MEDstructElement_7.f

MED fichier

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