29 character(64) :: mname
31 character(64) :: finame =
'TEMPERATURE_FIELD' 33 integer nstep, nvals, lcmesh, fitype
35 character(16) :: cpname
37 character(16) :: cpunit
38 character(16) :: dtunit
41 real*8,
dimension(:),
allocatable :: verval
42 real*8,
dimension(:),
allocatable :: tria3v
43 real*8,
dimension(:),
allocatable :: quad4v
46 call mfiope(fid,
'UsesCase_MEDfield_1.med',med_acc_rdonly,cret)
47 if (cret .ne. 0 )
then 48 print *,
'ERROR : opening file' 56 call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
58 if (cret .ne. 0 )
then 59 print *,
'ERROR : field info by name' 62 print *,
'Mesh name :', mname
63 print *,
'Local mesh :', lcmesh
64 print *,
'Field type :', fitype
65 print *,
'Component name :', cpname
66 print *,
'Component unit :', cpunit
67 print *,
'dtunit :', dtunit
68 print *,
'nstep :', nstep
74 call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
75 if (cret .ne. 0 )
then 76 print *,
'ERROR : read number of values ...' 80 print *,
'Node number :', nvals
82 allocate ( verval(nvals),stat=cret )
84 print *,
'Memory allocation' 88 call mfdrvr(fid,finame,med_no_dt,med_no_it,med_node,med_none,med_full_interlace,med_all_constituent,verval,cret)
89 if (cret .ne. 0 )
then 90 print *,
'ERROR : read fields values on vertices ...' 94 print *,
'Fields values on vertices :', verval
99 call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,nvals,cret)
100 if (cret .ne. 0 )
then 101 print *,
'ERROR : read number of values ...' 105 print *,
'Triangulars cells number :', nvals
107 allocate ( tria3v(nvals),stat=cret )
109 print *,
'Memory allocation' 113 call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,med_full_interlace,med_all_constituent,tria3v,cret)
114 if (cret .ne. 0 )
then 115 print *,
'ERROR : read fields values for MED_TRIA3 cells ...' 119 print *,
'Fiels values for MED_TRIA3 cells :', tria3v
124 call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,nvals,cret)
125 if (cret .ne. 0 )
then 126 print *,
'ERROR : read number of values ...' 130 print *,
'Quadrangulars cells number :', nvals
132 allocate ( quad4v(nvals),stat=cret )
134 print *,
'Memory allocation' 138 call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,med_full_interlace,med_all_constituent,quad4v,cret)
139 if (cret .ne. 0 )
then 140 print *,
'ERROR : read fields values for MED_QUAD4 cells ...' 144 print *,
'Fiels values for MED_QUAD4 cells :', quad4v
150 if (cret .ne. 0 )
then 151 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
program usescase_medfield_2
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
subroutine mfiope(fid, name, access, cret)