31 parameter(fname =
"Unittest_MEDstructElement_4.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
46 parameter(description1=
"support mesh1 description")
47 character*16 nomcoo2D(2)
48 character*16 unicoo2D(2)
49 data nomcoo2d /
"x",
"y"/, unicoo2d /
"cm",
"cm"/
51 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
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
71 data aval1 /1,2,3,4,5,6/
73 data aval2 /1., 2., 3. /
75 data aval3 /
"VAL1",
"VAL2",
"VAL3"/
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'
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'
97 call mmhcow(fid,smname2,med_no_dt,med_no_it,
98 & med_undef_dt,med_full_interlace,
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,
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'
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'
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'
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'
145 print *,
'Close file',cret
146 if (cret .ne. 0 )
then
147 print *,
'ERROR : close file'
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 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...
program medstructelement4
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 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...
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...
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.