35 integer ntria3, nquad4
37 character*64 fname, lfname
39 character*64 mname, finame, cpname, cpunit
44 integer mnumdt, mnumit
51 parameter(fname =
"UsesCase_MEDfield_4.med")
52 parameter(lfname =
"./UsesCase_MEDmesh_1.med")
53 parameter(mname =
"2D unstructured mesh")
54 parameter(finame =
"TEMPERATURE_FIELD")
55 parameter(cpname =
"TEMPERATURE", cpunit =
"C")
56 parameter(dtunit =
"ms")
57 parameter(ncompo = 1 )
58 parameter(ntria3 = 8, nquad4 = 4)
60 data t3vs1 / 1000., 2000., 3000., 4000.,
61 & 5000., 6000., 7000., 8000. /
62 data q4vs1 / 10000., 20000., 30000., 4000. /
63 data t3vs2 / 1500., 2500., 3500., 4500.,
64 & 5500., 6500., 7500., 8500. /
65 data q4vs2 / 15000., 25000., 35000., 45000. /
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 ...'
108 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
109 & med_full_interlace,med_all_constituent,
111 if (cret .ne. 0 )
then
112 print *,
'ERROR : write field values on MED_TRIA3'
118 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
119 & med_full_interlace,med_all_constituent,
121 if (cret .ne. 0 )
then
122 print *,
'ERROR : write field values on MED_TRIA3'
133 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
134 & med_full_interlace,med_all_constituent,
136 if (cret .ne. 0 )
then
137 print *,
'ERROR : write field values on MED_TRIA3'
143 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
144 & med_full_interlace,med_all_constituent,
146 if (cret .ne. 0 )
then
147 print *,
'ERROR : write field values on MED_TRIA3'
155 call mfdcmw(fid,finame,ndt,nit,mnumdt,mnumit,cret)
156 if (cret .ne. 0 )
then
157 print *,
'ERROR : write field mesh computation step error '
164 if (cret .ne. 0 )
then
165 print *,
'ERROR : close file'