32 parameter(fname =
"Unittest_MEDstructElement_4.med")
34 parameter(mname2 =
"model name 2")
38 parameter(smname2=
"support mesh name")
40 parameter(setype2=med_node)
42 parameter(sgtype2=med_no_geotype)
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"/
52 data coo / 0.0, 0.0, 1.0,1.0, 2.0,2.0 /
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
72 data aval1 /1,2,3,4,5,6/
74 data aval2 /1., 2., 3. /
76 data aval3 /
"VAL1",
"VAL2",
"VAL3"/
81 call mfiope(fid,fname,med_acc_creat,cret)
82 print *,
'Open file',cret
83 if (cret .ne. 0 )
then
84 print *,
'ERROR : file creation'
90 call msmcre(fid,smname2,dim2,dim2,description1,
91 & med_cartesian,nomcoo2d,unicoo2d,cret)
92 print *,
'Support mesh creation : 2D space dimension',cret
93 if (cret .ne. 0 )
then
94 print *,
'ERROR : support mesh creation'
98 call mmhcow(fid,smname2,med_no_dt,med_no_it,
99 & med_undef_dt,med_full_interlace,
102 call mmhcyw(fid,smname2,med_no_dt,med_no_it,
103 & med_undef_dt,med_cell,med_seg2,
104 & med_nodal,med_full_interlace,
109 call msecre(fid,mname2,dim2,smname2,setype2,
110 & sgtype2,mtype2,cret)
111 print *,
'Create struct element',mtype2, cret
112 if ((cret .ne. 0) .or. (mtype2 .lt. 0) )
then
113 print *,
'ERROR : struct element creation'
119 call mseiaw(fid,mname2,aname1,atype1,anc1,
120 & setype2,aval1,cret)
121 print *,
'Create a constant attribute : ',aname1, cret
122 if (cret .ne. 0)
then
123 print *,
'ERROR : constant attribute creation'
127 call mseraw(fid,mname2,aname2,atype2,anc2,
128 & setype2,aval2,cret)
129 print *,
'Create a constant attribute : ',aname2, cret
130 if (cret .ne. 0)
then
131 print *,
'ERROR : constant attribute creation'
135 call msesaw(fid,mname2,aname3,atype3,anc3,
136 & setype2,aval3,cret)
137 print *,
'Create a constant attribute : ',aname3, cret
138 if (cret .ne. 0)
then
139 print *,
'ERROR : constant attribute creation'
146 print *,
'Close file',cret
147 if (cret .ne. 0 )
then
148 print *,
'ERROR : close file'
program medstructelement4
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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 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 msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
Cette routine permet de créer un maillage support.
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
subroutine mseiaw(fid, mname, aname, atype, anc, setype, val, cret)
subroutine mseraw(fid, mname, aname, atype, anc, setype, val, cret)