30 character(64) :: mname
32 character(64) :: finame =
'TEMPERATURE_FIELD' 34 integer nstep, nvals, lcmesh, fitype
36 character(16) :: cpname
38 character(16) :: cpunit
39 character(16) :: dtunit
42 real*8,
dimension(:),
allocatable :: verval
43 real*8,
dimension(:),
allocatable :: tria3v
44 real*8,
dimension(:),
allocatable :: quad4v
47 call mfiope(fid,
'UsesCase_MEDfield_1.med',med_acc_rdonly,cret)
48 if (cret .ne. 0 )
then 49 print *,
'ERROR : opening file' 57 call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
59 if (cret .ne. 0 )
then 60 print *,
'ERROR : field info by name' 63 print *,
'Mesh name :', mname
64 print *,
'Local mesh :', lcmesh
65 print *,
'Field type :', fitype
66 print *,
'Component name :', cpname
67 print *,
'Component unit :', cpunit
68 print *,
'dtunit :', dtunit
69 print *,
'nstep :', nstep
75 call mfdnva(fid,finame,med_no_dt,med_no_it,med_node,med_none,nvals,cret)
76 if (cret .ne. 0 )
then 77 print *,
'ERROR : read number of values ...' 81 print *,
'Node number :', nvals
83 allocate ( verval(nvals),stat=cret )
85 print *,
'Memory allocation' 89 call mfdrvr(fid,finame,med_no_dt,med_no_it,med_node,med_none,med_full_interlace,med_all_constituent,verval,cret)
90 if (cret .ne. 0 )
then 91 print *,
'ERROR : read fields values on vertices ...' 95 print *,
'Fields values on vertices :', verval
100 call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,nvals,cret)
101 if (cret .ne. 0 )
then 102 print *,
'ERROR : read number of values ...' 106 print *,
'Triangulars cells number :', nvals
108 allocate ( tria3v(nvals),stat=cret )
110 print *,
'Memory allocation' 114 call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_tria3,med_full_interlace,med_all_constituent,tria3v,cret)
115 if (cret .ne. 0 )
then 116 print *,
'ERROR : read fields values for MED_TRIA3 cells ...' 120 print *,
'Fiels values for MED_TRIA3 cells :', tria3v
125 call mfdnva(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,nvals,cret)
126 if (cret .ne. 0 )
then 127 print *,
'ERROR : read number of values ...' 131 print *,
'Quadrangulars cells number :', nvals
133 allocate ( quad4v(nvals),stat=cret )
135 print *,
'Memory allocation' 139 call mfdrvr(fid,finame,med_no_dt,med_no_it,med_cell,med_quad4,med_full_interlace,med_all_constituent,quad4v,cret)
140 if (cret .ne. 0 )
then 141 print *,
'ERROR : read fields values for MED_QUAD4 cells ...' 145 print *,
'Fiels values for MED_QUAD4 cells :', quad4v
151 if (cret .ne. 0 )
then 152 print *,
'ERROR : close file' subroutine mfiope(fid, name, access, cret)
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
program usescase_medfield_2
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
subroutine mficlo(fid, cret)