34 integer ncompo, nnodes
36 integer ntria3, nquad4
38 character*64 fname, finame, lfname
40 character*16 cpname, cpunit
50 parameter(fname =
"./UsesCase_MEDfield_1.med")
51 parameter(lfname=
"./UsesCase_MEDmesh_1.med")
52 parameter(mname =
"2D unstructured mesh")
53 parameter(finame =
"TEMPERATURE_FIELD")
54 parameter(cpname =
"TEMPERATURE")
55 parameter(cpunit =
"C")
56 parameter(dtunit =
" ")
57 parameter(nnodes = 15, ncompo = 1 )
58 parameter(ntria3 = 8, nquad4 = 4)
61 data verval / 0., 100., 200., 300., 400.,
62 & 500., 600., 700., 800., 900,
63 & 1000., 1100, 1200., 1300., 1500. /
64 data tria3v / 1000., 2000., 3000., 4000.,
65 & 5000., 6000., 7000., 8000. /
66 data quad4v / 10000., 20000., 30000., 4000. /
70 call mfiope(fid,fname,med_acc_creat,cret)
71 if (cret .ne. 0 )
then
72 print *,
'ERROR : file creation'
78 call mlnliw(fid,mname,lfname,cret)
79 if (cret .ne. 0 )
then
80 print *,
'ERROR : create mesh link ...'
90 if (cret .ne. 0 )
then
91 print *,
'ERROR : create field ...'
97 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_node,
98 & med_none,med_full_interlace,med_all_constituent,
100 if (cret .ne. 0 )
then
101 print *,
'ERROR : write field values on vertices'
108 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_cell,
109 & med_tria3,med_full_interlace,med_all_constituent,
110 & ntria3,tria3v,cret)
111 if (cret .ne. 0 )
then
112 print *,
'ERROR : write field values on MED_TRIA3'
118 call mfdrvw(fid,finame,med_no_dt,med_no_it,dt,med_cell,
119 & med_quad4,med_full_interlace,med_all_constituent,
120 & nquad4,quad4v,cret)
121 if (cret .ne. 0 )
then
122 print *,
'ERROR : write field values on MED_QUAD4'
129 if (cret .ne. 0 )
then
130 print *,
'ERROR : close file'
program usescase_medfield_1
subroutine mfdrvw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mlnliw(fid, mname, lname, cret)