31 character(64) :: mname
33 character(64) :: finame =
'TEMPERATURE_FIELD' 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) :: cpname
48 character(16) :: 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' 64 call mfdfin(fid,finame,mname,lcmesh,fitype,cpname,cpunit,dtunit,nstep,cret)
65 if (cret .ne. 0 )
then 66 print *,
'ERROR : Field info by name ...' 69 print *,
'Mesh name :', mname
70 print *,
'Local mesh :', lcmesh
71 print *,
'Field type :', fitype
72 print *,
'Component name :', cpname
73 print *,
'Component unit :', cpunit
74 print *,
'Dtunit :', dtunit
75 print *,
'Nstep :', nstep
79 call mfdcmi(fid,finame,csit,numdt,numit,dt,mnumdt,mnumit,cret)
80 if (cret .ne. 0 )
then 81 print *,
'ERROR : Computing step info ...' 84 print *,
'csit :', csit
85 print *,
'numdt :', numdt
86 print *,
'numit :', numit
88 print *,
'mnumdt :', mnumdt
89 print *,
'mnumit :', mnumit
93 do it=1,(med_n_cell_fixed_geo)
97 call mfdnva(fid,finame,numdt,numit,med_cell,geotp,nvals,cret)
98 if (cret .ne. 0 )
then 99 print *,
'ERROR : Read number of values ...' 102 print *,
'Number of values of type :', geotp,
' :', nvals
104 if (nvals .gt. 0)
then 105 allocate(values(nvals),stat=cret )
107 print *,
'Memory allocation' 111 call mfdrvr(fid,finame,numdt,numit,med_cell,geotp,&
112 med_full_interlace, med_all_constituent,values,cret)
113 if (cret .ne. 0 )
then 114 print *,
'ERROR : Read fields values for cells ...' 117 print *,
'Fields values for cells :', values
127 if (cret .ne. 0 )
then 128 print *,
'ERROR : close file' subroutine mfdrvr(fid, fname, numdt, numit, etype, gtype, swm, cs, val, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mfdcmi(fid, fname, it, numdt, numit, dt, mnumdt, mnumit, cret)
subroutine mfdfin(fid, fname, mname, lmesh, type, cname, cunit, dtunit, nc, cret)
subroutine mfdnva(fid, fname, numdt, numit, etype, gtype, n, cret)
program usescase_medfield_5