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