31 character(64) :: mname
33 character(64) :: finame
35 integer nstep, nvals, lcmesh, fitype
39 integer,
dimension(MED_N_CELL_FIXED_GEO) :: geotps
41 integer mnumdt, mnumit
42 integer csit, numit, numdt, it
44 character(16) :: dtunit
46 character(16),
dimension(:),
allocatable :: cpname
48 character(16),
dimension(:),
allocatable :: cpunit
49 real*8,
dimension(:),
allocatable :: values
51 geotps = med_get_cell_geometry_type
54 call mfiope(fid,
'UsesCase_MEDfield_4.med',med_acc_rdonly, cret)
55 if (cret .ne. 0 )
then 56 print *,
'ERROR : open file' 62 call mfdnfd(fid,nfield,cret)
63 if (cret .ne. 0 )
then 64 print *,
'ERROR : How many fields in the file ...' 67 print *,
'Number of field(s) in the file :', nfield
71 call mfdnfc(fid,i,ncompo,cret)
72 if (cret .ne. 0 )
then 73 print *,
'ERROR : number of field components ...' 76 print *,
'Field number :', nfield
77 print *,
'Number of field(s) component(s) in the file :', ncompo
79 allocate(cpname(ncompo),stat=cret )
81 print *,
'Memory allocation' 85 allocate(cpunit(ncompo),stat=cret )
87 print *,
'Memory allocation' 91 call mfdfdi(fid,i,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
92 if (cret .ne. 0 )
then 93 print *,
'ERROR : Reading field infos ...' 96 print *,
'Field name :', finame
97 print *,
'Mesh name :', mname
98 print *,
'Local mesh :', lcmesh
99 print *,
'Field type :', fitype
100 print *,
'Component name :', cpname
101 print *,
'Component unit :', cpunit
102 print *,
'Dtunit :', dtunit
103 print *,
'Nstep :', nstep
104 deallocate(cpname,cpunit)
108 call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
109 if (cret .ne. 0 )
then 110 print *,
'ERROR : Computing step info ...' 113 print *,
'Computing step :',csit
114 print *,
'Numdt :', numdt
115 print *,
'Numit :', numit
117 print *,
'mnumdt :', mnumdt
118 print *,
'mnumit :', mnumit
121 do it=1,(med_n_cell_fixed_geo)
125 call mfdnva(fid,finame,numdt,numit,med_cell,geotp,nvals,cret)
126 if (cret .ne. 0 )
then 127 print *,
'ERROR : Read number of values ...' 130 print *,
'Number of values of type :', geotp,
' :', nvals
132 if (nvals .gt. 0)
then 133 allocate(values(nvals),stat=cret )
135 print *,
'Memory allocation' 139 call mfdrvr(fid,finame,numdt,numit,med_cell,geotp,&
140 med_full_interlace, med_all_constituent,values,cret)
141 if (cret .ne. 0 )
then 142 print *,
'ERROR : Read fields values for cells ...' 145 print *,
'Fields values for cells :', values
155 if (cret .ne. 0 )
then 156 print *,
'ERROR : close file' subroutine mficlo(fid, cret)
subroutine mfdfdi(fid, it, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
program usescase_medfield_6
subroutine mfdnfc(fid, ind, n, cret)
subroutine mfdnfd(fid, n, cret)
subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)