31 parameter(fname =
"Unittest_MEDstructElement_9.med")
33 parameter(mname2 =
"model name 2")
37 parameter(smname2=
"support mesh name")
39 parameter(setype2=med_node)
41 parameter(sgtype2=med_no_geotype)
45 character*200 description1,description2
46 parameter(description1=
"support mesh1 description")
47 parameter(description2=
"computation mesh 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), ccoo(2*3)
52 data coo /0.0, 0.0, 1.0,1.0, 2.0,2.0/
53 data ccoo /0.1, 0.1, 1.1,1.1, 2.1,2.1/
58 integer seg2(4), mcon(1)
61 character*64 aname1, aname2, aname3
62 parameter(aname1=
"integer attribute name")
63 parameter(aname2=
"real attribute name")
64 parameter(aname3=
"string attribute name")
65 integer atype1,atype2,atype3
66 parameter(atype1=med_att_int)
67 parameter(atype2=med_att_float64)
68 parameter(atype3=med_att_name)
69 integer anc1,anc2,anc3
78 data aval3 /
"VAL1",
"VAL2"/
79 character*64 pname,cname
80 parameter(cname=
"computation mesh")
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'
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'
103 call mmhcow(fid,smname2,med_no_dt,med_no_it,
104 & med_undef_dt,med_full_interlace,
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,
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'
124 call msevac(fid,mname2,aname1,atype1,anc1,cret)
125 print *,
'Create attribute',aname1, cret
126 if (cret .ne. 0)
then
127 print *,
'ERROR : attribute creation'
131 call msevac(fid,mname2,aname2,atype2,anc2,cret)
132 print *,
'Create attribute',aname2, cret
133 if (cret .ne. 0)
then
134 print *,
'ERROR : attribute creation'
138 call msevac(fid,mname2,aname3,atype3,anc3,cret)
139 print *,
'Create attribute',aname3, cret
140 if (cret .ne. 0)
then
141 print *,
'ERROR : attribute creation'
147 call mmhcre(fid,cname,dim2,dim2,med_unstructured_mesh,
148 & description2,
"",med_sort_dtit,med_cartesian,
149 & nomcoo2d,unicoo2d,cret)
150 print *,
'Create computation mesh',cname, cret
151 if (cret .ne. 0)
then
152 print *,
'ERROR : computation mesh creation'
156 call mmhcow(fid,cname,med_no_dt,med_no_it,med_undef_dt,
157 & med_full_interlace,nnode,ccoo,cret)
158 print *,
'Write nodes coordinates',cret
159 if (cret .ne. 0)
then
160 print *,
'ERROR : write nodes coordinates'
164 call mmhcyw(fid,cname,med_no_dt,med_no_it,med_undef_dt,
165 & med_struct_element,mtype2,med_nodal,
166 & med_no_interlace,nentity,mcon,cret)
167 print *,
'Write cells connectivity',cret
168 if (cret .ne. 0)
then
169 print *,
'ERROR : write cells connectivity'
175 call mmhiaw(fid,cname,med_no_dt,med_no_it,
176 & mtype2,aname1,nentity,
178 print *,
'Write attribute values',cret
179 if (cret .ne. 0)
then
180 print *,
'ERROR : write attribute values'
184 call mmhraw(fid,cname,med_no_dt,med_no_it,
185 & mtype2,aname2,nentity,
187 print *,
'Write attribute values',cret
188 if (cret .ne. 0)
then
189 print *,
'ERROR : write attribute values'
193 call mmhsaw(fid,cname,med_no_dt,med_no_it,
194 & mtype2,aname3,nentity,
196 print *,
'Write attribute values',cret
197 if (cret .ne. 0)
then
198 print *,
'ERROR : write attribute values'
205 print *,
'Close file',cret
206 if (cret .ne. 0 )
then
207 print *,
'ERROR : close file'
subroutine mmhsaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
program medstructelement9
subroutine mmhraw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
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...
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Cette routine permet de créer un maillage dans un fichier.
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 ...
subroutine mmhiaw(fid, name, numdt, numit, geotype, aname, n, val, cret)
Cette routine écrit les valeurs d'un attribut caractéristique variable sur les éléments de structure ...
subroutine msevac(fid, mname, aname, atype, anc, cret)
Cette routine déclare la présence d'un attribut caractéristique variable attaché aux éléments de type...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
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.