31 parameter(fname =
"Unittest_MEDstructElement_7.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
74 character*64 aval3(2*1)
75 data aval3 /
"VAL1",
"VAL3"/
77 parameter(pname=
"profil name")
85 call mfiope(fid,fname,med_acc_creat,cret)
86 print *,
'Open file',cret
87 if (cret .ne. 0 )
then 88 print *,
'ERROR : file creation' 94 call msmcre(fid,smname2,dim2,dim2,description1,
95 & med_cartesian,nomcoo2d,unicoo2d,cret)
96 print *,
'Support mesh creation : 2D space dimension',cret
97 if (cret .ne. 0 )
then 98 print *,
'ERROR : support mesh creation' 102 call mmhcow(fid,smname2,med_no_dt,med_no_it,
103 & med_undef_dt,med_full_interlace,
106 call mmhcyw(fid,smname2,med_no_dt,med_no_it,
107 & med_undef_dt,med_cell,med_seg2,
108 & med_nodal,med_full_interlace,
113 call msecre(fid,mname2,dim2,smname2,setype2,
114 & sgtype2,mtype2,cret)
115 print *,
'Create struct element',mtype2, cret
116 if ((cret .ne. 0) .or. (mtype2 .lt. 0) )
then 117 print *,
'ERROR : struct element creation' 123 call mpfprw(fid,pname,psize,profil,cret)
124 print *,
'Create a profile : ',pname, cret
125 if (cret .ne. 0)
then 126 print *,
'ERROR : profile creation' 132 call mseipw(fid,mname2,aname1,atype1,anc1,
133 & setype2,pname,aval1,cret)
134 print *,
'Create a constant attribute with profile : ',aname1, cret
135 if (cret .ne. 0)
then 136 print *,
'ERROR : constant attribute with profile creation' 140 call mserpw(fid,mname2,aname2,atype2,anc2,
141 & setype2,pname,aval2,cret)
142 print *,
'Create a constant attribute with profile : ',aname2, cret
143 if (cret .ne. 0)
then 144 print *,
'ERROR : constant attribute with profile creation' 148 call msespw(fid,mname2,aname3,atype3,anc3,
149 & setype2,pname,aval3,cret)
150 print *,
'Create a constant attribute with profile : ',aname3, cret
151 if (cret .ne. 0)
then 152 print *,
'ERROR : constant attribute with profile creation' 159 print *,
'Close file',cret
160 if (cret .ne. 0 )
then 161 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
subroutine mseipw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
subroutine mpfprw(fid, pname, psize, profil, cret)
program medstructelement7
subroutine msespw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mserpw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mfiope(fid, name, access, cret)
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)