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' subroutine mlnliw(fid, mname, lname, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mfdcre(fid, fname, ftype, ncomp, cname, cunit, dtunit, mname, cret)
subroutine mfdrvw(fid, fname, numdt, numit, dt, etype, gtype, swm, cs, n, val, cret)
program usescase_medfield_1
subroutine mficlo(fid, cret)