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'
program usescase_medfield_4
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 mfdcmw(fid, fname, numdt, numit, mnumdt, mnumit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mlnliw(fid, mname, lname, cret)