32 parameter(fname =
"Unittest_MEDstructElement_7.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
75 character*64 aval3(2*1)
76 data aval3 /
"VAL1",
"VAL3"/
78 parameter(pname=
"profil name")
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 mpfprw(fid,pname,psize,profil,cret)
125 print *,
'Create a profile : ',pname, cret
126 if (cret .ne. 0)
then
127 print *,
'ERROR : profile creation'
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'
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'
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'
160 print *,
'Close file',cret
161 if (cret .ne. 0 )
then
162 print *,
'ERROR : close file'
program medstructelement7
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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....
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 mpfprw(fid, pname, psize, profil, cret)
subroutine mseipw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mserpw(fid, mname, aname, atype, anc, setype, pname, val, cret)