34 integer ntria3, nquad4
36 character*64 fname, lfname
38 character*64 mname, finame, cpname, cpunit
43 integer mnumdt, mnumit
50 parameter(fname =
"UsesCase_MEDfield_4.med")
51 parameter(lfname =
"./UsesCase_MEDmesh_1.med")
52 parameter(mname =
"2D unstructured mesh")
53 parameter(finame =
"TEMPERATURE_FIELD")
54 parameter(cpname =
"TEMPERATURE", cpunit =
"C")
55 parameter(dtunit =
"ms")
56 parameter(ncompo = 1 )
57 parameter(ntria3 = 8, nquad4 = 4)
59 data t3vs1 / 1000., 2000., 3000., 4000.,
60 & 5000., 6000., 7000., 8000. /
61 data q4vs1 / 10000., 20000., 30000., 4000. /
62 data t3vs2 / 1500., 2500., 3500., 4500.,
63 & 5500., 6500., 7500., 8500. /
64 data q4vs2 / 15000., 25000., 35000., 45000. /
68 call mfiope(fid,fname,med_acc_creat,cret)
69 if (cret .ne. 0 )
then 70 print *,
'ERROR : file creation' 76 call mlnliw(fid,mname,lfname,cret)
77 if (cret .ne. 0 )
then 78 print *,
'ERROR : create mesh link ...' 88 if (cret .ne. 0 )
then 89 print *,
'ERROR : create field ...' 107 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
108 & med_full_interlace,med_all_constituent,
110 if (cret .ne. 0 )
then 111 print *,
'ERROR : write field values on MED_TRIA3' 117 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
118 & med_full_interlace,med_all_constituent,
120 if (cret .ne. 0 )
then 121 print *,
'ERROR : write field values on MED_TRIA3' 132 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_tria3,
133 & med_full_interlace,med_all_constituent,
135 if (cret .ne. 0 )
then 136 print *,
'ERROR : write field values on MED_TRIA3' 142 call mfdrvw(fid,finame,ndt,nit,dt,med_cell,med_quad4,
143 & med_full_interlace,med_all_constituent,
145 if (cret .ne. 0 )
then 146 print *,
'ERROR : write field values on MED_TRIA3' 154 call mfdcmw(fid,finame,ndt,nit,mnumdt,mnumit,cret)
155 if (cret .ne. 0 )
then 156 print *,
'ERROR : write field mesh computation step error ' 163 if (cret .ne. 0 )
then 164 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
program usescase_medfield_4
subroutine mfdcmw(fid, fname, numdt, numit, mnumdt, mnumit, cret)
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)