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