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' subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mseipw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mserpw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mfiope(fid, name, access, cret)
subroutine msecre(fid, mname, mdim, smname, setype, sgtype, etype, cret)
subroutine mficlo(fid, cret)
subroutine msmcre(fid, maa, sdim, mdim, des, atype, aname, aunit, cret)
subroutine msespw(fid, mname, aname, atype, anc, setype, pname, val, cret)
subroutine mpfprw(fid, pname, psize, profil, cret)
program medstructelement7
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)